diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-05-21 09:26:44 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-05-21 09:26:44 +0000 |
| commit | 055c0d0d5a5bb0dc75904fe53df7f2e4f5732a8f (patch) | |
| tree | 0e63fb68c69c8f6ad0f78893c63420f0a3600e1c /src-3.0/Transfer/Syntax/Test.hs | |
| parent | 915a1de71783ab8446b1af9e72c7ba7dfbc12d3f (diff) | |
GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3
Diffstat (limited to 'src-3.0/Transfer/Syntax/Test.hs')
| -rw-r--r-- | src-3.0/Transfer/Syntax/Test.hs | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/src-3.0/Transfer/Syntax/Test.hs b/src-3.0/Transfer/Syntax/Test.hs new file mode 100644 index 000000000..3f5fab7ad --- /dev/null +++ b/src-3.0/Transfer/Syntax/Test.hs @@ -0,0 +1,58 @@ +-- automatically generated by BNF Converter +module Main where + + +import IO ( stdin, hGetContents ) +import System ( getArgs, getProgName ) + +import Transfer.Syntax.Lex +import Transfer.Syntax.Par +import Transfer.Syntax.Skel +import Transfer.Syntax.Print +import Transfer.Syntax.Abs +import Transfer.Syntax.Layout + + + +import Transfer.ErrM + +type ParseFun a = [Token] -> Err a + +myLLexer = resolveLayout True . myLexer + +type Verbosity = Int + +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!" + showTree v tree + + + +showTree :: (Show a, Print a) => Int -> a -> IO () +showTree v tree + = do + 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 2 pModule + "-s":fs -> mapM_ (runFile 0 pModule) fs + fs -> mapM_ (runFile 2 pModule) fs + + + + + |
