From 87b55df10f00fd23d89a89bfb7c4354ff455d83d Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 11 Jan 2005 15:06:12 +0000 Subject: -val optimization --- src/GF/Source/TestGF.hs | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) (limited to 'src/GF/Source/TestGF.hs') diff --git a/src/GF/Source/TestGF.hs b/src/GF/Source/TestGF.hs index d6c026487..f72e69b31 100644 --- a/src/GF/Source/TestGF.hs +++ b/src/GF/Source/TestGF.hs @@ -18,22 +18,28 @@ type ParseFun a = [Token] -> Err a myLLexer = myLexer -runFile :: (Print a, Show a) => ParseFun a -> FilePath -> IO () -runFile p f = readFile f >>= run p +type Verbosity = Int -run :: (Print a, Show a) => ParseFun a -> String -> IO () -run p s = case (p (myLLexer s)) of - Bad s -> do putStrLn "\nParse Failed...\n" +putStrV :: Verbosity -> String -> IO () +putStrV v s = if v > 1 then putStrLn s else return () + +runFile :: (Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO () +runFile v p f = putStrLn f >> readFile f >>= run v p + +run :: (Print a, Show a) => Verbosity -> ParseFun a -> String -> IO () +run v p s = let ts = myLLexer s in case p ts of + Bad s -> do putStrLn "\nParse Failed...\n" + putStrV v "Tokens:" + putStrV v $ show ts putStrLn s Ok tree -> do putStrLn "\nParse Successful!" - putStrLn $ "\n[Abstract Syntax]\n\n" ++ show tree - putStrLn $ "\n[Linearized tree]\n\n" ++ printTree tree + putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree + putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree main :: IO () main = do args <- getArgs case args of - [] -> hGetContents stdin >>= run pGrammar - [f] -> runFile pGrammar f - _ -> do progName <- getProgName - putStrLn $ progName ++ ": excess arguments." + [] -> hGetContents stdin >>= run 2 pGrammar + "-s":fs -> mapM_ (runFile 0 pGrammar) fs + fs -> mapM_ (runFile 2 pGrammar) fs -- cgit v1.2.3