| TBool
deriving (Eq,Ord,Show)
-data Stms =
- Program [Stm]
+data Program =
+ Program [FuncStm]
deriving (Eq,Ord,Show)
data Stm =
| SWhile Exp Stm
| SIf Exp Stm Stm
| SPrint Exp
+ | SReturn Exp
| SNoop
deriving (Eq,Ord,Show)
| ENot Exp
| EReadI
| EReadB
+ | EFunc Ident [Exp]
| BiOpExp Exp Op Exp
| EPost Ident Op
deriving (Eq,Ord,Show)
+data Decl =
+ Decl Type Ident
+ deriving (Eq,Ord,Show)
+
+data Func =
+ Func Type Ident [Decl] [Stm]
+ deriving (Eq,Ord,Show)
+
+data FuncStm =
+ S Stm
+ | F Func
+ deriving (Eq,Ord,Show)
+
data Op =
Lt
| ELt
import Typecheck
import Interpret
import Compile
-import Data.Map as Map hiding (showTree)
import ErrM
myLLexer = myLexer
-
-cHeader = "#include <stdio.h>\nint read(){\nint n;\nscanf(\"%d\",&n);\nreturn n;\n}\nint main(void){\n"
-
-cFooter = "return 0;}"
+splitFunStm :: [FuncStm] -> ([Func],[Stm])
+splitFunStm [] = ([],[])
+splitFunStm ((F f):fss) = let (fs,ss) = splitFunStm fss in (f:fs,ss)
+splitFunStm ((S s):fss) = let (fs,ss) = splitFunStm fss in (fs,s:ss)
putStrV :: Int -> String -> IO ()
putStrV v s = if v > 1 then putStrLn s else return ()
-runFile :: ([Stm] -> IO()) -> ParseFun Stms -> FilePath -> IO ()
+runFile :: ([Func] -> [Stm] -> IO()) -> ParseFun Program -> FilePath -> IO ()
runFile e p f = readFile f >>= run e p
-run :: ([Stm] -> IO()) -> ParseFun Stms -> String -> IO ()
+run :: ([Func] -> [Stm] -> IO()) -> ParseFun Program -> String -> IO ()
run e p s = let ts = myLLexer s in case p ts of
Bad s -> do
putStrLn "\nParse Failed...\n"
putStrLn "Tokens:"
putStrLn $ show ts
putStrLn s
- Ok (Program s) -> do
- typeCheck s
- e s
+ Ok (Program s) -> let (fun,st) = splitFunStm (s) in do
+ typeCheck fun st
+ e fun st
main :: IO ()
main = do
args <- getArgs
case args of
- [] -> hGetContents stdin >>= run interpret pStms
+ [] -> hGetContents stdin >>= run interpret pProgram
"-c":f:[] -> let file = (f++".c") in do
putStrLn $ "Compiling "++f++" to the C99-compatible file:"++file
- runFile (writeFile file . compile) pStms f
- f:[] -> runFile interpret pStms f
+ runFile (\fun st -> writeFile file $ compile fun st) pProgram f
+ f:[] -> runFile interpret pProgram f
_ -> do
putStrLn "Usage: ./CompInt [-c] <file>"
putStrLn "-c : compile <file> to C99-compatible file"
import Abssyntax
import Prelude hiding (lookup)
-cHeader = "#include <stdio.h>\nint read(){\nint n;\nscanf(\"%d\",&n);\nreturn n;\n}\nint main(void){\n"
+cHeader = "#include <stdio.h>\nint read(){\nint n;\nscanf(\"%d\",&n);\nreturn n;\n}\n"
-cFooter = "return 0;}"
+cMiddle = "\nint main(void){\n"
-compile :: [Stm] -> String
-compile s = cHeader++concat (map compileStm s)++cFooter
+cFooter = "return 0;}\n"
+
+compile :: [Func] -> [Stm] -> String
+compile f s = cHeader++concat (map compileFuncDecl f)++concat (map compileFunc f)++cMiddle++concat (map compileStm s)++cFooter
compileExp :: Exp -> String
compileExp (EBool True) = "1";
compileExp (EPost (Ident i) Minus) = i++"--"
compileExp EReadI = "read()"
compileExp EReadB = "read()"
+compileExp (EFunc (Ident i) as) = i++"("++(foldl1 (\a b -> a++","++b) (map compileExp as))++")"
op :: Op -> String
op Eq = "=="
TBool -> EBool False
)
compileStm (SDecl t (Ident i) e) = "int "++i++"="++compileExp e++";\n"
+compileStm (SReturn e) = "return "++compileExp e++";"
+
+compileFunc :: Func -> String
+compileFunc (Func _ (Ident i) d ss) = "\nint "++i++"("++(foldl1 (\a b -> a++","++b) (map (\(Decl _ (Ident i)) -> "int "++i) d))++"){\n"++concat (map compileStm ss)++"\n}\n"
+
+compileFuncDecl :: Func -> String
+compileFuncDecl (Func _ (Ident i) d ss) = "\nint "++i++"("++(foldl1 (\a b -> a++","++b) (map (\(Decl _ (Ident i)) -> "int "++i) d))++");\n"
\begin{tabular}{lll}
{\reserved{bool}} &{\reserved{else}} &{\reserved{false}} \\
{\reserved{if}} &{\reserved{int}} &{\reserved{print}} \\
-{\reserved{readBool}} &{\reserved{readInt}} &{\reserved{true}} \\
-{\reserved{while}} & & \\
+{\reserved{readBool}} &{\reserved{readInt}} &{\reserved{return}} \\
+{\reserved{true}} &{\reserved{while}} & \\
\end{tabular}\\
The symbols used in syntax are the following: \\
{\symb{;}} &{\symb{\{}} &{\symb{\}}} \\
{\symb{{$=$}}} &{\symb{(}} &{\symb{)}} \\
{\symb{{$+$}{$+$}}} &{\symb{{$-$}{$-$}}} &{\symb{{$-$}}} \\
-{\symb{!}} &{\symb{{$<$}}} &{\symb{{$<$}{$=$}}} \\
-{\symb{{$>$}}} &{\symb{{$>$}{$=$}}} &{\symb{{$=$}{$=$}}} \\
-{\symb{!{$=$}}} &{\symb{{$+$}}} &{\symb{*}} \\
-{\symb{/}} & & \\
+{\symb{!}} &{\symb{,}} &{\symb{{$<$}}} \\
+{\symb{{$<$}{$=$}}} &{\symb{{$>$}}} &{\symb{{$>$}{$=$}}} \\
+{\symb{{$=$}{$=$}}} &{\symb{!{$=$}}} &{\symb{{$+$}}} \\
+{\symb{*}} &{\symb{/}} & \\
\end{tabular}\\
\subsection*{Comments}
\end{tabular}\\
\begin{tabular}{lll}
-{\nonterminal{Stms}} & {\arrow} &{\nonterminal{ListStm}} \\
+{\nonterminal{Program}} & {\arrow} &{\nonterminal{ListFuncStm}} \\
\end{tabular}\\
\begin{tabular}{lll}
& {\delimit} &{\terminal{if}} {\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} {\nonterminal{Stm}} {\terminal{else}} {\nonterminal{Stm}} \\
& {\delimit} &{\terminal{if}} {\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} {\nonterminal{Stm}} \\
& {\delimit} &{\terminal{print}} {\nonterminal{Exp}} {\terminal{;}} \\
+ & {\delimit} &{\terminal{return}} {\nonterminal{Exp}} {\terminal{;}} \\
\end{tabular}\\
\begin{tabular}{lll}
& {\delimit} &{\terminal{!}} {\nonterminal{Exp3}} \\
& {\delimit} &{\terminal{readInt}} \\
& {\delimit} &{\terminal{readBool}} \\
+ & {\delimit} &{\nonterminal{Ident}} {\terminal{(}} {\nonterminal{ListExp}} {\terminal{)}} \\
& {\delimit} &{\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} \\
\end{tabular}\\
& {\delimit} &{\nonterminal{Stm}} {\nonterminal{ListStm}} \\
\end{tabular}\\
+\begin{tabular}{lll}
+{\nonterminal{ListExp}} & {\arrow} &{\emptyP} \\
+ & {\delimit} &{\nonterminal{Exp}} \\
+ & {\delimit} &{\nonterminal{Exp}} {\terminal{,}} {\nonterminal{ListExp}} \\
+\end{tabular}\\
+
+\begin{tabular}{lll}
+{\nonterminal{Decl}} & {\arrow} &{\nonterminal{Type}} {\nonterminal{Ident}} \\
+\end{tabular}\\
+
+\begin{tabular}{lll}
+{\nonterminal{ListDecl}} & {\arrow} &{\emptyP} \\
+ & {\delimit} &{\nonterminal{Decl}} \\
+ & {\delimit} &{\nonterminal{Decl}} {\terminal{,}} {\nonterminal{ListDecl}} \\
+\end{tabular}\\
+
+\begin{tabular}{lll}
+{\nonterminal{Func}} & {\arrow} &{\nonterminal{Type}} {\nonterminal{Ident}} {\terminal{(}} {\nonterminal{ListDecl}} {\terminal{)}} {\terminal{\{}} {\nonterminal{ListStm}} {\terminal{\}}} \\
+\end{tabular}\\
+
+\begin{tabular}{lll}
+{\nonterminal{ListFunc}} & {\arrow} &{\emptyP} \\
+ & {\delimit} &{\nonterminal{Func}} {\nonterminal{ListFunc}} \\
+\end{tabular}\\
+
+\begin{tabular}{lll}
+{\nonterminal{FuncStm}} & {\arrow} &{\nonterminal{Stm}} \\
+ & {\delimit} &{\nonterminal{Func}} \\
+\end{tabular}\\
+
+\begin{tabular}{lll}
+{\nonterminal{ListFuncStm}} & {\arrow} &{\emptyP} \\
+ & {\delimit} &{\nonterminal{FuncStm}} {\nonterminal{ListFuncStm}} \\
+\end{tabular}\\
+
\begin{tabular}{lll}
{\nonterminal{Op0}} & {\arrow} &{\terminal{{$<$}}} \\
& {\delimit} &{\terminal{{$<$}{$=$}}} \\
-module Interpret (interpret, eval, execute, Value(VInt, VBool)) where
+module Interpret (interpret, eval, execute,addFunction, emptyState, Value(..), State(..)) where
import Abssyntax
-import Control.Monad.State
+import Control.Monad.State hiding (State)
+import Control.Monad.Error
+import Control.Concurrent.MVar
import Data.Map as Map
import Prelude hiding (lookup)
+emptyState = State{variables=[empty], functions=(empty)}
+
data Value = VInt Integer | VBool Bool deriving Eq
instance Show Value where
show (VBool False) = "0"
type Variables = [Map Ident Value]
+type Function = ([Decl],[Stm])
+
+data State = State {variables::Variables,functions::(Map Ident Function),ret::(MVar Value)}
-interpret :: [Stm] -> IO ()
-interpret s = runStateT (mapM execute s) [empty] >> return ()
+interpret :: [Func] -> [Stm] -> IO ()
+interpret fun st = do
+ mv <- newEmptyMVar
+ runStateT (do mapM Interpret.addFunction fun; mapM execute st) emptyState{ret=mv}
+ return ()
--eval :: (MonadState Variables m) => Exp -> m Value
-eval :: Exp -> StateT Variables IO Value
+eval :: Exp -> StateT State IO Value
eval (EBool b) = return (VBool b)
eval (EInt n) = return (VInt n)
eval (EVar i) = getVariableValue i
eval EReadB = do
s <- lift $ getWord
return $ VBool $ if (read s == 0) then False else True
+eval (EFunc i as) = do
+ vs <- mapM eval as
+ state <- get
+ (ds,ss) <- lookup i $ functions state
+ let m = foldr (\((Decl t i),v) m -> insert i v m) empty $ zip ds vs
+ in modify (\s -> s{variables=[m]})
+ mapM_ execute ss `catchError` (\_ -> return ())
+ v <- lift $ takeMVar $ ret state
+ put state
+ return v
getWord :: IO String
getWord = do
op Gt = \e e' -> VBool $ e > e'
op EGt = \e e' -> VBool $ e >= e'
-getVariableValue :: (MonadState Variables m) => Ident -> m Value
+getVariableValue :: (MonadState State m) => Ident -> m Value
getVariableValue i = do
- ms <- get
- findVariable i ms
+ s <- get
+ findVariable i $ variables s
-findVariable :: (MonadState Variables m) => Ident -> Variables -> m Value
+findVariable :: (MonadState State m) => Ident -> Variables -> m Value
findVariable i [] = fail $ "Variable "++show i++" not found in any scope."
findVariable i (m:ms) = if member i m then lookup i m else findVariable i ms
--setVariableValue :: (MonadState Variables m) => Ident -> Exp -> m Value
--setVariableValue :: (MonadState Variables m) => Ident -> Exp -> m Value
-setVariableValue :: Ident -> Exp -> StateT Variables IO Value
+setVariableValue :: Ident -> Exp -> StateT State IO Value
setVariableValue i e = do
v <- eval e
- ms <- get
- put $ updateVariable i v ms
+ state <- get
+ modify (\s -> s{variables= updateVariable i v $ variables state} )
return v
updateVariable :: Ident -> Value -> Variables -> Variables
updateVariable _ _ [] = []
updateVariable i v (m:ms) = if member i m then insert i v m:ms else m:updateVariable i v ms
-pushAndPop :: (MonadState Variables m) => m a -> m ()
+pushAndPop :: (MonadState State m) => m a -> m ()
pushAndPop s = do
- modify (empty:)
+ modify (\s -> s { variables = empty:variables s})
s
- modify tail
+ modify (\s -> s { variables = tail $ variables s})
-- execute :: (MonadState Variables m) => Stm -> m ()
-execute :: Stm -> StateT Variables IO ()
+execute :: Stm -> StateT State IO ()
execute (SNoop) = return ()
execute (SExp e) = eval e >> return ()
execute (SIf b s s') = do
TBool -> EBool False
execute (SDecl t i e) =do
v <- eval e
- (m:ms) <- get
- put $ (insert i v m):ms
+ state <- get
+ let (m:ms) = variables state in modify (\s -> s{variables=insert i v m:ms })
+execute (SReturn e) = do
+ v <- eval e
+ s <- get
+ lift $ putMVar (ret s) v
+ throwError $ userError "Returning.."
+
+addFunction :: (MonadState State m) => Func -> m ()
+addFunction (Func _ i d ss) = modify (\s -> s{functions=insert i (d,ss) (functions s) })
import Typecheck
import Interpret
-import Control.Monad.State
-import Data.Map as Map hiding (showTree)
import ErrM
type Verbosity = Int
+splitFunStm :: [FuncStm] -> ([Func],[Stm])
+splitFunStm [] = ([],[])
+splitFunStm ((F f):fss) = let (fs,ss) = splitFunStm fss in (f:fs,ss)
+splitFunStm ((S s):fss) = let (fs,ss) = splitFunStm fss in (fs,s:ss)
+
putStrV :: Verbosity -> String -> IO ()
putStrV v s = if v > 1 then putStrLn s else return ()
-runFile :: Verbosity -> ParseFun Stms -> FilePath -> IO ()
+runFile :: Verbosity -> ParseFun Program -> FilePath -> IO ()
runFile v p f = putStrLn f >> readFile f >>= run v p
-run :: Verbosity -> ParseFun Stms -> String -> IO ()
+run :: Verbosity -> ParseFun Program -> 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 (Program s) -> do
- --putStrLn "\nParse Successful!"
- --showTree v (Program s)
- typeCheck s
- --print "The program is type-correct!!"
- --print "Running program:"
- interpret s
- --print "Done running program!"
+ Ok (Program s) -> let (fun,st) = splitFunStm (s) in do
+ putStrLn "\nParse Successful!"
+ showTree v (Program s)
+ typeCheck fun st
+ print "The program is type-correct!!"
+ print "Running program:"
+ interpret fun st
+ print "Done running program!"
showTree :: (Show a, Print a) => Int -> a -> IO ()
showTree v tree
main :: IO ()
main = do args <- getArgs
case args of
- [] -> hGetContents stdin >>= run 2 pStms
- "-s":fs -> mapM_ (runFile 0 pStms) fs
- fs -> mapM_ (runFile 2 pStms) fs
+ [] -> hGetContents stdin >>= run 2 pProgram
+ "-s":fs -> mapM_ (runFile 0 pProgram) fs
+ fs -> mapM_ (runFile 2 pProgram) fs
$u = [\0-\255] -- universal: any character
@rsyms = -- symbols and non-identifier-like reserved words
- \; | \{ | \} | \= | \( | \) | \+ \+ | \- \- | \- | \! | \< | \< \= | \> | \> \= | \= \= | \! \= | \+ | \* | \/
+ \; | \{ | \} | \= | \( | \) | \+ \+ | \- \- | \- | \! | \, | \< | \< \= | \> | \> \= | \= \= | \! \= | \+ | \* | \/
:-
"//" [.]* ; -- Toss single line comments
| s > a = treeFind right
| s == a = t
-resWords = b "print" (b "false" (b "else" (b "bool" N N) N) (b "int" (b "if" N N) N)) (b "true" (b "readInt" (b "readBool" N N) N) (b "while" N N))
+resWords = b "print" (b "false" (b "else" (b "bool" N N) N) (b "int" (b "if" N N) N)) (b "return" (b "readInt" (b "readBool" N N) N) (b "while" (b "true" N N) N))
where b s = B s (TS s)
unescapeInitTail :: String -> String
import ErrM
}
-%name pStms Stms
-%name pExp Exp
+%name pProgram Program
-- no lexer declaration
%monad { Err } { thenM } { returnM }
'--' { PT _ (TS "--") }
'-' { PT _ (TS "-") }
'!' { PT _ (TS "!") }
+ ',' { PT _ (TS ",") }
'<' { PT _ (TS "<") }
'<=' { PT _ (TS "<=") }
'>' { PT _ (TS ">") }
'print' { PT _ (TS "print") }
'readBool' { PT _ (TS "readBool") }
'readInt' { PT _ (TS "readInt") }
+ 'return' { PT _ (TS "return") }
'true' { PT _ (TS "true") }
'while' { PT _ (TS "while") }
| 'bool' { TBool }
-Stms :: { Stms }
-Stms : ListStm { Program (reverse $1) }
+Program :: { Program }
+Program : ListFuncStm { Program (reverse $1) }
Stm :: { Stm }
| 'if' '(' Exp ')' Stm 'else' Stm { SIf $3 $5 $7 }
| 'if' '(' Exp ')' Stm { if_ $3 $5 }
| 'print' Exp ';' { SPrint $2 }
+ | 'return' Exp ';' { SReturn $2 }
Exp :: { Exp }
| '!' Exp3 { ENot $2 }
| 'readInt' { EReadI }
| 'readBool' { EReadB }
+ | Ident '(' ListExp ')' { EFunc $1 $3 }
| '(' Exp ')' { $2 }
| ListStm Stm { flip (:) $1 $2 }
+ListExp :: { [Exp] }
+ListExp : {- empty -} { [] }
+ | Exp { (:[]) $1 }
+ | Exp ',' ListExp { (:) $1 $3 }
+
+
+Decl :: { Decl }
+Decl : Type Ident { Decl $1 $2 }
+
+
+ListDecl :: { [Decl] }
+ListDecl : {- empty -} { [] }
+ | Decl { (:[]) $1 }
+ | Decl ',' ListDecl { (:) $1 $3 }
+
+
+Func :: { Func }
+Func : Type Ident '(' ListDecl ')' '{' ListStm '}' { Func $1 $2 $4 (reverse $7) }
+
+
+ListFunc :: { [Func] }
+ListFunc : {- empty -} { [] }
+ | ListFunc Func { flip (:) $1 $2 }
+
+
+FuncStm :: { FuncStm }
+FuncStm : Stm { S $1 }
+ | Func { F $1 }
+
+
+ListFuncStm :: { [FuncStm] }
+ListFuncStm : {- empty -} { [] }
+ | ListFuncStm FuncStm { flip (:) $1 $2 }
+
+
Op0 :: { Op }
Op0 : '<' { Lt }
| '<=' { ELt }
TBool -> prPrec i 0 (concatD [doc (showString "bool")])
-instance Print Stms where
+instance Print Program where
prt i e = case e of
- Program stms -> prPrec i 0 (concatD [prt 0 stms])
+ Program funcstms -> prPrec i 0 (concatD [prt 0 funcstms])
instance Print Stm where
SWhile exp stm -> prPrec i 0 (concatD [doc (showString "while") , doc (showString "(") , prt 0 exp , doc (showString ")") , prt 0 stm])
SIf exp stm0 stm -> prPrec i 0 (concatD [doc (showString "if") , doc (showString "(") , prt 0 exp , doc (showString ")") , prt 0 stm0 , doc (showString "else") , prt 0 stm])
SPrint exp -> prPrec i 0 (concatD [doc (showString "print") , prt 0 exp , doc (showString ";")])
+ SReturn exp -> prPrec i 0 (concatD [doc (showString "return") , prt 0 exp , doc (showString ";")])
SNoop -> prPrec i 0 (concatD [])
prtList es = case es of
ENot exp -> prPrec i 3 (concatD [doc (showString "!") , prt 3 exp])
EReadI -> prPrec i 3 (concatD [doc (showString "readInt")])
EReadB -> prPrec i 3 (concatD [doc (showString "readBool")])
+ EFunc id exps -> prPrec i 3 (concatD [prt 0 id , doc (showString "(") , prt 0 exps , doc (showString ")")])
BiOpExp exp0 op exp -> prPrec i 0 (concatD [prt 0 exp0 , prt 0 op , prt 0 exp])
EPost id op -> prPrec i 0 (concatD [prt 0 id , prt 1 op])
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print Decl where
+ prt i e = case e of
+ Decl type' id -> prPrec i 0 (concatD [prt 0 type' , prt 0 id])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print Func where
+ prt i e = case e of
+ Func type' id decls stms -> prPrec i 0 (concatD [prt 0 type' , prt 0 id , doc (showString "(") , prt 0 decls , doc (showString ")") , doc (showString "{") , prt 0 stms , doc (showString "}")])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print FuncStm where
+ prt i e = case e of
+ S stm -> prPrec i 0 (concatD [prt 0 stm])
+ F func -> prPrec i 0 (concatD [prt 0 func])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print Op where
prt i e = case e of
TBool -> failure x
-transStms :: Stms -> Result
-transStms x = case x of
- Program stms -> failure x
+transProgram :: Program -> Result
+transProgram x = case x of
+ Program funcstms -> failure x
transStm :: Stm -> Result
SWhile exp stm -> failure x
SIf exp stm0 stm -> failure x
SPrint exp -> failure x
+ SReturn exp -> failure x
SNoop -> failure x
ENot exp -> failure x
EReadI -> failure x
EReadB -> failure x
+ EFunc id exps -> failure x
BiOpExp exp0 op exp -> failure x
EPost id op -> failure x
+transDecl :: Decl -> Result
+transDecl x = case x of
+ Decl type' id -> failure x
+
+
+transFunc :: Func -> Result
+transFunc x = case x of
+ Func type' id decls stms -> failure x
+
+
+transFuncStm :: FuncStm -> Result
+transFuncStm x = case x of
+ S stm -> failure x
+ F func -> failure x
+
+
transOp :: Op -> Result
transOp x = case x of
Lt -> failure x
main :: IO ()
main = do args <- getArgs
case args of
- [] -> hGetContents stdin >>= run 2 pStms
- "-s":fs -> mapM_ (runFile 0 pStms) fs
- fs -> mapM_ (runFile 2 pStms) fs
+ [] -> hGetContents stdin >>= run 2 pProgram
+ "-s":fs -> mapM_ (runFile 0 pProgram) fs
+ fs -> mapM_ (runFile 2 pProgram) fs
-module Typecheck (typeCheck,typeCheckExp, typeCheckStm, typeCheckVar) where
+module Typecheck (typeCheck, typeCheckExp, typeCheckStm, typeCheckVar, typeCheckFunction, addFunction, emptyState, State(..)) where
import Abssyntax
-import Control.Monad.State
-import Data.Map as Map
+import Control.Monad.State hiding (State)
+import Data.Map as Map hiding (map)
import Prelude hiding (lookup)
type Types = [Map Ident Type]
+type Function = (Type, [Type])
-inList :: Eq a => a -> [a] -> Bool
-inList _ [] = False
-inList a (x:xs) = if a == x then True else inList a xs
+data State = State {variables::Types,functions::(Map Ident Function),function::Ident}
+
+emptyState = State{variables=[empty], functions=(empty), function=(Ident "")}
assert :: Monad m => Bool -> String -> m ()
assert True _ = return ()
assert False s = fail s
-typeCheck :: [Stm] -> IO ()
-typeCheck s = runStateT (mapM typeCheckStm s) [empty] >> return ()
+typeCheck :: [Func] -> [Stm] -> IO ()
+typeCheck fun st = do
+ runStateT (do mapM addFunction fun; mapM typeCheckFunction fun; mapM typeCheckStm st) emptyState
+ return ()
-typeCheckExp :: (MonadState Types m) => Exp -> m Type
+typeCheckExp :: (MonadState State m) => Exp -> m Type
typeCheckExp (BiOpExp e o e') = do
t1 <- typeCheckExp e
t2 <- typeCheckExp e'
assert (t1 == t2) "The parameters for the binary operator aren't equal"
- if inList o [Eq,NEq] then return TBool
+ if elem o [Eq,NEq] then return TBool
else do
assert (t1 == TInt) "The parameters need to be of type int"
- if inList o [Plus,Minus,Times,Div]
+ if elem o [Plus,Minus,Times,Div]
then return TInt
else return TBool
typeCheckExp (EVar i) = typeCheckVar i
typeCheckExp (ENot e) = do
TBool <- typeCheckExp e
return TBool
+typeCheckExp (EFunc i as) = do
+ state <- get
+ (t,ts) <- lookup i $ functions state
+ checkParams as ts
+ return t
+
+checkParams :: (MonadState State m) => [Exp] -> [Type] -> m ()
+checkParams [] [] = return ()
+checkParams [] _ = fail "Too for arguments when calling function"
+checkParams _ [] = fail "Too many arguments when calling function"
+checkParams (e:es) (t:ts) = do
+ t2 <- typeCheckExp e
+ assert (t == t2) "Arugments does not match"
+ checkParams es ts
-typeCheckVar :: (MonadState Types m) => Ident -> m Type
+typeCheckVar :: (MonadState State m) => Ident -> m Type
typeCheckVar i = do
- ms <- get
- findVariable i ms
+ s <- get
+ findVariable i $ variables s
-findVariable :: (MonadState Types m) => Ident -> Types -> m Type
+findVariable :: (MonadState State m) => Ident -> Types -> m Type
findVariable i [] = fail $ "Variable "++show i++" not found in any scope."
findVariable i (m:ms) = if member i m then lookup i m else findVariable i ms
-pushAndPop :: (MonadState Types m) => m a -> m ()
+pushAndPop :: (MonadState State m) => m a -> m ()
pushAndPop s = do
- modify (empty:)
+ modify (\s -> s { variables = empty:variables s})
s
- modify tail
+ modify (\s -> s { variables = tail $ variables s})
-typeCheckStm :: (MonadState Types m) => Stm -> m ()
+typeCheckStm :: (MonadState State m) => Stm -> m ()
typeCheckStm SNoop = return ()
typeCheckStm (SExp e) = do
typeCheckExp e
typeCheckStm (SPrint e) = do
typeCheckExp e
return ()
+typeCheckStm (SReturn e) = do
+ t <- typeCheckExp e
+ state <- get
+ (t2,_) <- lookup (function state) $ functions state
+ assert (t == t2) $ "Illegal to return "++show t++" in function "++show (function state)++" which returns "++show t2
-addVariable :: (MonadState Types m) => Ident -> Type -> m ()
+
+addVariable :: (MonadState State m) => Ident -> Type -> m ()
addVariable i t = do
- (m:ms) <- get
- case insertLookupWithKey (\k a1 a2 -> a1) i t m of
- (Nothing,m') -> put (m':ms)
+ s <- get
+ let (m:ms) = variables s in case insertLookupWithKey (\k a1 a2 -> a1) i t m of
+ (Nothing,m') -> modify (\s -> s{ variables = m':ms})
+ _ -> fail $ "Duplicate variable declaration: "++show i
+
+typeCheckFunction :: (MonadState State m) => Func -> m ()
+typeCheckFunction (Func t i d s) = do
+ state <- get
+ modify (\s -> s{variables=[empty], function=i})
+ mapM (\(Decl t i) -> addVariable i t) d
+ case last s of
+ (SReturn _) -> return ()
+ _ -> fail $ "Function "++show i++" doesn't end with return statement"
+ mapM typeCheckStm s
+ put state
+
+addFunction :: (MonadState State m) => Func -> m ()
+addFunction (Func t i d _) = do
+ s <- get
+ let m = functions s in case insertLookupWithKey (\k a1 a2 -> a1) i (t, map (\(Decl t i) -> t) d) m of
+ (Nothing,m') -> modify (\s -> s{ functions = m'})
_ -> fail $ "Duplicate variable declaration: "++show i
import Printsyntax
import Abssyntax
-import Typecheck
-import Control.Monad.State
+import Control.Monad.State hiding (State)
import Data.Map as Map hiding (showTree)
+import Typecheck
import ErrM
type Verbosity = Int
+
+splitFunStm :: [FuncStm] -> ([Func],[Stm])
+splitFunStm [] = ([],[])
+splitFunStm ((F f):fss) = let (fs,ss) = splitFunStm fss in (f:fs,ss)
+splitFunStm ((S s):fss) = let (fs,ss) = splitFunStm fss in (fs,s:ss)
+
putStrV :: Verbosity -> String -> IO ()
putStrV v s = if v > 1 then putStrLn s else return ()
-runFile :: Verbosity -> ParseFun Stms -> FilePath -> IO ()
+runFile :: Verbosity -> ParseFun Program -> FilePath -> IO ()
runFile v p f = putStrLn f >> readFile f >>= run v p
-run :: Verbosity -> ParseFun Stms -> String -> IO ()
+run :: Verbosity -> ParseFun Program -> 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 (Program s) -> do
+ Ok (Program s) -> let (fun,st) = splitFunStm (s) in do
putStrLn "\nParse Successful!"
showTree v (Program s)
- runStateT (mapM typeCheckStm s) [empty]
+ runStateT (do mapM addFunction fun; mapM typeCheckFunction fun; mapM typeCheckStm st) emptyState
print "The program is type-correct!!"
return ()
main :: IO ()
main = do args <- getArgs
case args of
- [] -> hGetContents stdin >>= run 2 pStms
- "-s":fs -> mapM_ (runFile 0 pStms) fs
- fs -> mapM_ (runFile 2 pStms) fs
+ [] -> hGetContents stdin >>= run 2 pProgram
+ "-s":fs -> mapM_ (runFile 0 pProgram) fs
+ fs -> mapM_ (runFile 2 pProgram) fs
Abssyntax.hs, Parsyntax.y, Lexsyntax.x,ErrM.hs,Printsyntax.hs,Skelsyntax.hs: The files generated by bnfc, only modification is the removal of the Bool type in Abssyntx.hs so haskell's internal type can be used.
-semantic rules
+typing rules
++++++++++++
--- /dev/null
+int a = fac(3);
+int b = fib(2);
+int c = func(a,b);
+
+print a;
+print b;
+print c;
+
+if (boolfunc(b,c)) print true;
+
+int fac(int n){
+ n++;
+ int sum = 1;
+ while (n-- > 1) sum = sum * n;
+ return sum;
+}
+
+int fib(int n){
+ if (n < 2) return 1;
+
+ return (fib(n-1)+fib(n-2));
+}
+
+int func(int a, int b){
+ return (a+b);
+}
+
+bool boolfunc(int a, int b){
+ return (a == b);
+}
--- /dev/null
+int a(){
+ int a;
+}
TInt. Type ::= "int" ;
TBool. Type ::= "bool" ;
-Program. Stms ::= [Stm] ;
+Program. Program ::= [FuncStm] ;
SExp. Stm ::= Exp ";" ;
-- SFor. Stm ::= "for" "(" Stm Exp ";" Exp ")" Stm ;
SPrint. Stm ::= "print" Exp ";" ;
+SReturn. Stm ::= "return" Exp ";" ;
+
EAss. Exp ::= Ident "=" Exp;
EReadI. Exp3 ::= "readInt" ;
EReadB. Exp3 ::= "readBool" ;
+EFunc. Exp3 ::= Ident "(" [Exp] ")" ;
+
+
coercions Exp 3 ;
terminator Stm "" ;
+separator Exp "," ;
+
+Decl. Decl ::= Type Ident ;
+
+separator Decl "," ;
+
+Func. Func ::= Type Ident "(" [Decl] ")" "{" [Stm] "}" ;
+
+separator Func "" ;
+
+S. FuncStm ::= Stm ;
+F. FuncStm ::= Func ;
+
+separator FuncStm "" ;
+
+-- E1. Exps ::= Exp ;
+-- E2. Exps ::= Exp "," Exps ;
Lt. Op0 ::= "<" ;
ELt. Op0 ::= "<=" ;
comment "/*" "*/" ;
comment "//" ;
-entrypoints Stms, Exp ;
+entrypoints Program;
projects / proglang.git / commitdiff