diff --git a/src-3.0/GF/Compile.hs b/src-3.0/GF/Compile.hs index 72b13998e..067e8743d 100644 --- a/src-3.0/GF/Compile.hs +++ b/src-3.0/GF/Compile.hs @@ -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 diff --git a/src-3.0/GF/Compile/Optimize.hs b/src-3.0/GF/Compile/Optimize.hs index 6dd4c9af6..9263dcdd9 100644 --- a/src-3.0/GF/Compile/Optimize.hs +++ b/src-3.0/GF/Compile/Optimize.hs @@ -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 diff --git a/src-3.0/GF/Infra/Option.hs b/src-3.0/GF/Infra/Option.hs index dc795e597..a17613f7f 100644 --- a/src-3.0/GF/Infra/Option.hs +++ b/src-3.0/GF/Infra/Option.hs @@ -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 \ No newline at end of file diff --git a/src-3.0/GF/Infra/UseIO.hs b/src-3.0/GF/Infra/UseIO.hs index dcc0c62ca..f7563ed2c 100644 --- a/src-3.0/GF/Infra/UseIO.hs +++ b/src-3.0/GF/Infra/UseIO.hs @@ -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)