mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-21 17:12:50 -06:00
Test.hs
This commit is contained in:
@@ -655,7 +655,7 @@ happyError ts =
|
|||||||
|
|
||||||
myLexer = tokens
|
myLexer = tokens
|
||||||
{-# LINE 1 "GenericTemplate.hs" #-}
|
{-# LINE 1 "GenericTemplate.hs" #-}
|
||||||
-- $Id: ParImperC.hs,v 1.1 2004/11/08 10:22:38 aarne Exp $
|
-- $Id: ParImperC.hs,v 1.2 2004/11/09 19:12:51 aarne Exp $
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
46
examples/gfcc/compiler/TestImperC.hs
Normal file
46
examples/gfcc/compiler/TestImperC.hs
Normal file
@@ -0,0 +1,46 @@
|
|||||||
|
-- automatically generated by BNF Converter
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
|
||||||
|
import Trees
|
||||||
|
import Profile
|
||||||
|
import IO ( stdin, hGetContents )
|
||||||
|
import System ( getArgs, getProgName )
|
||||||
|
|
||||||
|
import LexImperC
|
||||||
|
import ParImperC
|
||||||
|
import ErrM
|
||||||
|
|
||||||
|
type ParseFun = [Token] -> Err CFTree
|
||||||
|
|
||||||
|
myLLexer = myLexer
|
||||||
|
|
||||||
|
runFile :: ParseFun -> FilePath -> IO ()
|
||||||
|
runFile p f = readFile f >>= run p
|
||||||
|
|
||||||
|
run :: ParseFun -> String -> IO ()
|
||||||
|
run p s = do
|
||||||
|
let ts = myLLexer s
|
||||||
|
let etree = p ts
|
||||||
|
case etree of
|
||||||
|
Ok tree -> do
|
||||||
|
case postParse tree of
|
||||||
|
Bad s -> do
|
||||||
|
putStrLn "\nParse Failed... CFTree:\n"
|
||||||
|
putStrLn $ prCFTree tree
|
||||||
|
putStrLn s
|
||||||
|
Ok tree -> do
|
||||||
|
putStrLn "\nParse Successful!"
|
||||||
|
putStrLn $ "\n[Abstract Syntax]\n\n" ++ prt tree
|
||||||
|
Bad s -> do
|
||||||
|
putStrLn s
|
||||||
|
putStrLn "\nParse failed... tokenization:"
|
||||||
|
print ts
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do args <- getArgs
|
||||||
|
case args of
|
||||||
|
[] -> hGetContents stdin >>= run pProgram
|
||||||
|
[f] -> runFile pProgram f
|
||||||
|
_ -> do progName <- getProgName
|
||||||
|
putStrLn $ progName ++ ": excess arguments."
|
||||||
Reference in New Issue
Block a user