-val optimization

1 files changed, 17 insertions, 11 deletions

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