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

-val optimization

Browse Source
This commit is contained in:
aarne
2005-01-11 15:06:12 +00:00
parent bb3d2e1d42
commit 87b55df10f
32 changed files with 825 additions and 581 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
src/GF/Canon/TestGFC.hs
View File

@@ -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 pCanon
[f] -> runFile pCanon f
_ -> do progName <- getProgName
putStrLn $ progName ++ ": excess arguments."
[] -> hGetContents stdin >>= run 2 pCanon
"-s":fs -> mapM_ (runFile 0 pCanon) fs
fs -> mapM_ (runFile 2 pCanon) fs