Typechecker.hs

   1 -- automatically generated by BNF Converter
   2 module Main where
   3
   4
   5 import IO ( stdin, hGetContents )
   6 import System ( getArgs, getProgName )
   7
   8 import Lexsyntax
   9 import Parsyntax
  10 import Skelsyntax
  11 import Printsyntax
  12 import Abssyntax
  13
  14 import Control.Monad.State hiding (State)
  15 import Data.Map as Map hiding (showTree)
  16 import Typecheck
  17
  18 import ErrM
  19
  20 type ParseFun a = [Token] -> Err a
  21
  22 myLLexer = myLexer
  23
  24 type Verbosity = Int
  25
  26
  27 splitFunStm :: [FuncStm] -> ([Func],[Stm])
  28 splitFunStm [] = ([],[])
  29 splitFunStm ((F f):fss) = let (fs,ss) = splitFunStm fss in (f:fs,ss)
  30 splitFunStm ((S s):fss) = let (fs,ss) = splitFunStm fss in (fs,s:ss)
  31
  32 putStrV :: Verbosity -> String -> IO ()
  33 putStrV v s = if v > 1 then putStrLn s else return ()
  34
  35 runFile :: Verbosity -> ParseFun Program -> FilePath -> IO ()
  36 runFile v p f = putStrLn f >> readFile f >>= run v p
  37
  38 run :: Verbosity -> ParseFun Program -> String -> IO ()
  39 run v p s = let ts = myLLexer s in case p ts of
  40         Bad s    -> do
  41                 putStrLn "\nParse              Failed...\n"
  42                 putStrV v "Tokens:"
  43                 putStrV v $ show ts
  44                 putStrLn s
  45         Ok (Program s) -> let (fun,st) = splitFunStm (s) in do
  46                 putStrLn "\nParse Successful!"
  47                 showTree v (Program s)
  48                 runStateT (do mapM addFunction fun; mapM typeCheckFunction fun; mapM typeCheckStm st) emptyState
  49                 print "The program is type-correct!!"
  50                 return ()
  51
  52 showTree :: (Show a, Print a) => Int -> a -> IO ()
  53 showTree v tree
  54  = do
  55       putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
  56       putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree
  57
  58 main :: IO ()
  59 main = do args <- getArgs
  60           case args of
  61             [] -> hGetContents stdin >>= run 2 pProgram
  62             "-s":fs -> mapM_ (runFile 0 pProgram) fs
  63             fs -> mapM_ (runFile 2 pProgram) fs
  64
  65
  66
  67
  68