msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Some printing / verbosity fixes.

Browse Source
This commit is contained in:
bjorn
2008-05-28 15:56:37 +00:00
parent a5cf2afccf
commit 2fcc77a884
4 changed files with 55 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
src-3.0/GF/Compile.hs
View File

@@ -48,7 +48,7 @@ compileToGFCC opts fs =
link :: Options -> String -> SourceGrammar -> IOE GFCC
link opts cnc gr =
do gc1 <- putPointE opts "linking ... " $
do gc1 <- putPointE Normal opts "linking ... " $
let (abs,gc0) = mkCanon2gfcc opts cnc gr
in ioeIO $ checkGFCCio gc0
return $ buildParser opts $ optimize opts gc1
@@ -103,12 +103,10 @@ compileModule opts1 env file = do
compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
compileOne opts env@(_,srcgr,_) file = do
let putp s = putPointE opts s
let putpp = putPointEsil opts
let putpOpt v m act
| beVerbose opts = putp v act
| beSilent opts = putpp v act
| otherwise = ioeIO (putStrFlush m) >> act
| verbAtLeast opts Verbose = putPointE Normal opts v act
| verbAtLeast opts Normal = ioeIO (putStrFlush m) >> act
| otherwise = putPointE Verbose opts v act
let gf = takeExtensions file
let path = dropFileName file
@@ -120,9 +118,9 @@ compileOne opts env@(_,srcgr,_) file = do
-- for compiled gf, read the file and update environment
-- also undo common subexp optimization, to enable normal computations
".gfo" -> do
sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
sm0 <- putPointE Normal opts ("+ reading" +++ file) $ getSourceModule opts file
let sm1 = unsubexpModule sm0
sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1
sm <- {- putPointE Normal opts "creating indirections" $ -} ioeErr $ extendModule mos sm1
extendCompileEnv env file sm
@@ -139,7 +137,7 @@ compileOne opts env@(_,srcgr,_) file = do
getSourceModule opts file
(k',sm) <- compileSourceModule opts env sm0
let sm1 = if isConcr sm then shareModule sm else sm -- cannot expand Str
cm <- putpp " generating code... " $ generateModuleCode opts gfo sm1
cm <- putPointE Verbose opts " generating code... " $ generateModuleCode opts gfo sm1
-- sm is optimized before generation, but not in the env
extendCompileEnvInt env k' gfo sm1
where
@@ -152,8 +150,8 @@ compileSourceModule :: Options -> CompileEnv ->
SourceModule -> IOE (Int,SourceModule)
compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do
let putp = putPointE opts
putpp = putPointEsil opts
let putp = putPointE Normal opts
putpp = putPointE Verbose opts
mos = modules gr
mo1 <- ioeErr $ rebuildModule mos mo
@@ -190,12 +188,8 @@ generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule
generateModuleCode opts file minfo = do
let minfo1 = subexpModule minfo
out = prGrammar (MGrammar [minfo1])
putp (" wrote file" +++ file) $ ioeIO $ writeFile file $ out
putPointE Normal opts (" wrote file" +++ file) $ ioeIO $ writeFile file $ out
return minfo1
where
putp = putPointE opts
putpp = putPointEsil opts
-- auxiliaries

2
src-3.0/GF/Compile/Optimize.hs
View File

@@ -110,7 +110,7 @@ evalCncInfo ::
Options -> SourceGrammar -> Ident -> Ident -> (Ident,Info) -> Err (Ident,Info)
evalCncInfo opts gr cnc abs (c,info) = do
seq (prtIf (beVerbose opts) c) $ return ()
seq (prtIf (verbAtLeast opts Verbose) c) $ return ()
errIn ("optimizing" +++ prt c) $ case info of

62
src-3.0/GF/Infra/Option.hs
View File

@@ -3,7 +3,7 @@ module GF.Infra.Option
-- * Option types
Options, ModuleOptions,
Flags(..), ModuleFlags(..),
Mode(..), Phase(..), Encoding(..), OutputFormat(..), Optimization(..),
Mode(..), Phase(..), Verbosity(..), Encoding(..), OutputFormat(..), Optimization(..),
Dump(..), Printer(..), Recomp(..),
-- * Option parsing
parseOptions, parseModuleOptions,
@@ -17,8 +17,7 @@ module GF.Infra.Option
-- * Checking options
flag, moduleFlag,
-- * Convenience methods for checking options
beVerbose, beSilent,
dump
verbAtLeast, dump
) where
import Control.Monad
@@ -65,6 +64,9 @@ errors = fail . unlines
data Mode = ModeVersion | ModeHelp | ModeInteractive | ModeCompiler
deriving (Show,Eq,Ord)
data Verbosity = Quiet | Normal | Verbose | Debug
deriving (Show,Eq,Ord,Enum,Bounded)
data Phase = Preproc | Convert | Compile | Link
deriving (Show,Eq,Ord)
@@ -112,7 +114,7 @@ data ModuleFlags = ModuleFlags {
data Flags = Flags {
optMode :: Mode,
optStopAfterPhase :: Phase,
optVerbosity :: Int,
optVerbosity :: Verbosity,
optShowCPUTime :: Bool,
optEmitGFO :: Bool,
optGFODir :: FilePath,
@@ -245,7 +247,7 @@ defaultFlags :: Flags
defaultFlags = Flags {
optMode = ModeInteractive,
optStopAfterPhase = Compile,
optVerbosity = 1,
optVerbosity = Normal,
optShowCPUTime = False,
optEmitGFO = True,
optGFODir = ".",
@@ -334,7 +336,7 @@ optDescr =
[
Option ['?','h'] ["help"] (NoArg (mode ModeHelp)) "Show help message.",
Option ['V'] ["version"] (NoArg (mode ModeVersion)) "Display GF version number.",
Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 3.",
Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 2.",
Option ['q','s'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.",
Option [] ["batch"] (NoArg (mode ModeCompiler)) "Run in batch compiler mode.",
Option [] ["interactive"] (NoArg (mode ModeInteractive)) "Run in interactive mode (default).",
@@ -370,10 +372,10 @@ optDescr =
where phase x = set $ \o -> o { optStopAfterPhase = x }
mode x = set $ \o -> o { optMode = x }
verbosity mv = case mv of
Nothing -> set $ \o -> o { optVerbosity = 3 }
Just v -> case reads v of
[(i,"")] | i >= 0 -> set $ \o -> o { optVerbosity = i }
_ -> fail $ "Bad verbosity: " ++ show v
Nothing -> set $ \o -> o { optVerbosity = Verbose }
Just v -> case readMaybe v >>= toEnumBounded of
Just i -> set $ \o -> o { optVerbosity = i }
Nothing -> fail $ "Bad verbosity: " ++ show v
cpu x = set $ \o -> o { optShowCPUTime = x }
emitGFO x = set $ \o -> o { optEmitGFO = x }
gfoDir x = set $ \o -> o { optGFODir = x }
@@ -387,14 +389,6 @@ optDescr =
set = return . Options
instance Functor OptDescr where
fmap f (Option cs ss d s) = Option cs ss (fmap f d) s
instance Functor ArgDescr where
fmap f (NoArg x) = NoArg (f x)
fmap f (ReqArg g s) = ReqArg (f . g) s
fmap f (OptArg g s) = OptArg (f . g) s
outputFormats :: [(String,OutputFormat)]
outputFormats =
[("gfcc", FmtGFCC),
@@ -453,12 +447,34 @@ splitInModuleSearchPath s = case break isPathSep s of
-- * Convenience functions for checking options
--
beVerbose :: Options -> Bool
beVerbose = flag ((>= 3) . optVerbosity)
beSilent :: Options -> Bool
beSilent = flag ((<= 0) . optVerbosity)
verbAtLeast :: Options -> Verbosity -> Bool
verbAtLeast opts v = flag optVerbosity opts >= v
dump :: Options -> Dump -> Bool
dump opts d = moduleFlag ((d `elem`) . optDump) opts
--
-- * General utilities
--
readMaybe :: Read a => String -> Maybe a
readMaybe s = case reads s of
[(x,"")] -> Just x
_ -> Nothing
toEnumBounded :: (Bounded a, Enum a, Ord a) => Int -> Maybe a
toEnumBounded i = let mi = minBound
ma = maxBound `asTypeOf` mi
in if i >= fromEnum mi && i <= fromEnum ma
then Just (toEnum i `asTypeOf` mi)
else Nothing
instance Functor OptDescr where
fmap f (Option cs ss d s) = Option cs ss (fmap f d) s
instance Functor ArgDescr where
fmap f (NoArg x) = NoArg (f x)
fmap f (ReqArg g s) = ReqArg (f . g) s
fmap f (OptArg g s) = OptArg (f . g) s

26
src-3.0/GF/Infra/UseIO.hs
View File

@@ -40,15 +40,11 @@ putShow' f = putStrLn . show . length . show . f
putIfVerb :: Options -> String -> IO ()
putIfVerb opts msg =
if beVerbose opts
then putStrLn msg
else return ()
when (verbAtLeast opts Verbose) $ putStrLn msg
putIfVerbW :: Options -> String -> IO ()
putIfVerbW opts msg =
if beVerbose opts
then putStr (' ' : msg)
else return ()
when (verbAtLeast opts Verbose) $ putStr (' ' : msg)
errOptIO :: Options -> a -> Err a -> IO a
errOptIO os e m = case m of
@@ -245,17 +241,9 @@ putStrLnE = ioeIO . putStrLnFlush
putStrE :: String -> IOE ()
putStrE = ioeIO . putStrFlush
-- this is more verbose
putPointE :: Options -> String -> IOE a -> IOE a
putPointE = putPointEgen beSilent
-- this is less verbose
putPointEsil :: Options -> String -> IOE a -> IOE a
putPointEsil = putPointEgen (not . beVerbose)
putPointEgen :: (Options -> Bool) -> Options -> String -> IOE a -> IOE a
putPointEgen cond opts msg act = do
when (cond opts) $ ioeIO $ putStrFlush msg
putPointE :: Verbosity -> Options -> String -> IOE a -> IOE a
putPointE v opts msg act = do
when (verbAtLeast opts v) $ ioeIO $ putStrFlush msg
t1 <- ioeIO $ getCPUTime
a <- act >>= ioeIO . evaluate
@@ -265,10 +253,6 @@ putPointEgen cond opts msg act = do
return a
-- | forces verbosity
putPointEVerb :: Options -> String -> IOE a -> IOE a
putPointEVerb = putPointEgen (const False)
-- ((do {s <- readFile f; return (return s)}) )
readFileIOE :: FilePath -> IOE BS.ByteString
readFileIOE f = ioe $ catch (BS.readFile f >>= return . return)