From: Michael Andreen Date: Tue, 14 Mar 2006 20:23:09 +0000 (+0000) Subject: compiler seems to be working X-Git-Url: https://ruin.nu/git/?p=proglang.git;a=commitdiff_plain;h=cdcd3b92ee3145e646634d428b02118238d47f33;hp=4ab526ea4f2ad39b6797adbc9df0fd26ac571456 compiler seems to be working --- diff --git a/Abssyntax.hs b/Abssyntax.hs index d9fc344..881c172 100644 --- a/Abssyntax.hs +++ b/Abssyntax.hs @@ -9,8 +9,8 @@ data Type = | TBool deriving (Eq,Ord,Show) -data Stms = - Program [Stm] +data Program = + Program [FuncStm] deriving (Eq,Ord,Show) data Stm = @@ -21,6 +21,7 @@ data Stm = | SWhile Exp Stm | SIf Exp Stm Stm | SPrint Exp + | SReturn Exp | SNoop deriving (Eq,Ord,Show) @@ -33,10 +34,24 @@ data Exp = | 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 diff --git a/CompInt.hs b/CompInt.hs index 298c9f4..1934447 100644 --- a/CompInt.hs +++ b/CompInt.hs @@ -14,7 +14,6 @@ import Abssyntax import Typecheck import Interpret import Compile -import Data.Map as Map hiding (showTree) import ErrM @@ -22,37 +21,37 @@ type ParseFun a = [Token] -> Err a myLLexer = myLexer - -cHeader = "#include \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] " putStrLn "-c : compile to C99-compatible file" diff --git a/Compile.hs b/Compile.hs index 2252fc5..f2de7ec 100644 --- a/Compile.hs +++ b/Compile.hs @@ -3,12 +3,14 @@ module Compile (compile,compileExp, compileStm) where import Abssyntax import Prelude hiding (lookup) -cHeader = "#include \nint read(){\nint n;\nscanf(\"%d\",&n);\nreturn n;\n}\nint main(void){\n" +cHeader = "#include \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"; @@ -23,6 +25,7 @@ compileExp (EPost (Ident i) Plus) = i++"++" 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 = "==" @@ -48,3 +51,10 @@ compileStm (SDeclD t i) = compileStm (SDecl t i $ case t of 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" diff --git a/Docsyntax.tex b/Docsyntax.tex index d978641..f8ad812 100644 --- a/Docsyntax.tex +++ b/Docsyntax.tex @@ -42,8 +42,8 @@ The reserved words used in syntax are the following: \\ \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: \\ @@ -52,10 +52,10 @@ 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} @@ -78,7 +78,7 @@ All other symbols are terminals.\\ \end{tabular}\\ \begin{tabular}{lll} -{\nonterminal{Stms}} & {\arrow} &{\nonterminal{ListStm}} \\ +{\nonterminal{Program}} & {\arrow} &{\nonterminal{ListFuncStm}} \\ \end{tabular}\\ \begin{tabular}{lll} @@ -90,6 +90,7 @@ All other symbols are terminals.\\ & {\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} @@ -118,6 +119,7 @@ All other symbols are terminals.\\ & {\delimit} &{\terminal{!}} {\nonterminal{Exp3}} \\ & {\delimit} &{\terminal{readInt}} \\ & {\delimit} &{\terminal{readBool}} \\ + & {\delimit} &{\nonterminal{Ident}} {\terminal{(}} {\nonterminal{ListExp}} {\terminal{)}} \\ & {\delimit} &{\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} \\ \end{tabular}\\ @@ -126,6 +128,41 @@ All other symbols are terminals.\\ & {\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{{$<$}{$=$}}} \\ diff --git a/Interpret.hs b/Interpret.hs index 0728d51..5afcefb 100644 --- a/Interpret.hs +++ b/Interpret.hs @@ -1,10 +1,14 @@ -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 @@ -13,12 +17,18 @@ 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 @@ -44,6 +54,16 @@ eval EReadI = do 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 @@ -66,37 +86,37 @@ op ELt = \e e' -> VBool $ e <= e' 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 @@ -114,5 +134,13 @@ execute (SDeclD t i) = execute $ SDecl t i $ case t of 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) }) diff --git a/Interpreter.hs b/Interpreter.hs index 694ce23..ae73abb 100644 --- a/Interpreter.hs +++ b/Interpreter.hs @@ -13,8 +13,6 @@ import Abssyntax import Typecheck import Interpret -import Control.Monad.State -import Data.Map as Map hiding (showTree) import ErrM @@ -24,27 +22,32 @@ myLLexer = myLexer 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 @@ -55,9 +58,9 @@ 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 diff --git a/Lexsyntax.x b/Lexsyntax.x index 88f0e2d..db7f77e 100644 --- a/Lexsyntax.x +++ b/Lexsyntax.x @@ -16,7 +16,7 @@ $i = [$l $d _ '] -- identifier character $u = [\0-\255] -- universal: any character @rsyms = -- symbols and non-identifier-like reserved words - \; | \{ | \} | \= | \( | \) | \+ \+ | \- \- | \- | \! | \< | \< \= | \> | \> \= | \= \= | \! \= | \+ | \* | \/ + \; | \{ | \} | \= | \( | \) | \+ \+ | \- \- | \- | \! | \, | \< | \< \= | \> | \> \= | \= \= | \! \= | \+ | \* | \/ :- "//" [.]* ; -- Toss single line comments @@ -79,7 +79,7 @@ eitherResIdent tv s = treeFind resWords | 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 diff --git a/Parsyntax.y b/Parsyntax.y index 6613fa3..d7b5f7d 100644 --- a/Parsyntax.y +++ b/Parsyntax.y @@ -6,8 +6,7 @@ import Lexsyntax import ErrM } -%name pStms Stms -%name pExp Exp +%name pProgram Program -- no lexer declaration %monad { Err } { thenM } { returnM } @@ -24,6 +23,7 @@ import ErrM '--' { PT _ (TS "--") } '-' { PT _ (TS "-") } '!' { PT _ (TS "!") } + ',' { PT _ (TS ",") } '<' { PT _ (TS "<") } '<=' { PT _ (TS "<=") } '>' { PT _ (TS ">") } @@ -41,6 +41,7 @@ import ErrM 'print' { PT _ (TS "print") } 'readBool' { PT _ (TS "readBool") } 'readInt' { PT _ (TS "readInt") } + 'return' { PT _ (TS "return") } 'true' { PT _ (TS "true") } 'while' { PT _ (TS "while") } @@ -64,8 +65,8 @@ Type : 'int' { TInt } | 'bool' { TBool } -Stms :: { Stms } -Stms : ListStm { Program (reverse $1) } +Program :: { Program } +Program : ListFuncStm { Program (reverse $1) } Stm :: { Stm } @@ -77,6 +78,7 @@ Stm : Exp ';' { SExp $1 } | '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 } @@ -105,6 +107,7 @@ Exp3 : Ident '++' { postIncr_ $1 } | '!' Exp3 { ENot $2 } | 'readInt' { EReadI } | 'readBool' { EReadB } + | Ident '(' ListExp ')' { EFunc $1 $3 } | '(' Exp ')' { $2 } @@ -113,6 +116,41 @@ ListStm : {- empty -} { [] } | 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 } diff --git a/Printsyntax.hs b/Printsyntax.hs index d1b4c49..287fbae 100644 --- a/Printsyntax.hs +++ b/Printsyntax.hs @@ -93,9 +93,9 @@ instance Print Type where 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 @@ -107,6 +107,7 @@ 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 @@ -123,9 +124,40 @@ instance Print Exp where 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 diff --git a/Skelsyntax.hs b/Skelsyntax.hs index 9f3feab..7efec85 100644 --- a/Skelsyntax.hs +++ b/Skelsyntax.hs @@ -26,9 +26,9 @@ transType x = case x 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 @@ -40,6 +40,7 @@ transStm x = case x of SWhile exp stm -> failure x SIf exp stm0 stm -> failure x SPrint exp -> failure x + SReturn exp -> failure x SNoop -> failure x @@ -53,10 +54,27 @@ transExp x = case x of 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 diff --git a/Testsyntax.hs b/Testsyntax.hs index 45f35b9..c5c57c5 100644 --- a/Testsyntax.hs +++ b/Testsyntax.hs @@ -48,9 +48,9 @@ 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 diff --git a/Typecheck.hs b/Typecheck.hs index 1b0baa0..a8c10e5 100644 --- a/Typecheck.hs +++ b/Typecheck.hs @@ -1,33 +1,36 @@ -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 @@ -49,23 +52,37 @@ typeCheckExp (ENeg e) = do 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 @@ -86,10 +103,34 @@ typeCheckStm (SDecl t i e) = do 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 diff --git a/Typechecker.hs b/Typechecker.hs index d9b1e10..19f5a66 100644 --- a/Typechecker.hs +++ b/Typechecker.hs @@ -11,9 +11,9 @@ import Skelsyntax 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 @@ -23,23 +23,29 @@ myLLexer = myLexer 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 () @@ -52,9 +58,9 @@ 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 diff --git a/documentation b/documentation index fd4664d..c3ac4e0 100644 --- a/documentation +++ b/documentation @@ -9,7 +9,7 @@ Typecheck.hs: Contains the type-checking functions typeCheckExp, typeCheckVar an 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 ++++++++++++ diff --git a/examples/func b/examples/func new file mode 100644 index 0000000..ad56e85 --- /dev/null +++ b/examples/func @@ -0,0 +1,30 @@ +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); +} diff --git a/examples/typeerror-funcnoreturn b/examples/typeerror-funcnoreturn new file mode 100644 index 0000000..1fb75eb --- /dev/null +++ b/examples/typeerror-funcnoreturn @@ -0,0 +1,3 @@ +int a(){ + int a; +} diff --git a/syntax.cf b/syntax.cf index 0347ce5..44a6cb4 100644 --- a/syntax.cf +++ b/syntax.cf @@ -8,7 +8,7 @@ False. Bool ::= "false" ; TInt. Type ::= "int" ; TBool. Type ::= "bool" ; -Program. Stms ::= [Stm] ; +Program. Program ::= [FuncStm] ; SExp. Stm ::= Exp ";" ; @@ -25,6 +25,8 @@ define if e s = SIf e s SNoop ; -- SFor. Stm ::= "for" "(" Stm Exp ";" Exp ")" Stm ; SPrint. Stm ::= "print" Exp ";" ; +SReturn. Stm ::= "return" Exp ";" ; + EAss. Exp ::= Ident "=" Exp; @@ -54,6 +56,9 @@ ENot. Exp3 ::= "!" Exp3 ; EReadI. Exp3 ::= "readInt" ; EReadB. Exp3 ::= "readBool" ; +EFunc. Exp3 ::= Ident "(" [Exp] ")" ; + + coercions Exp 3 ; @@ -63,6 +68,23 @@ 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 ::= "<=" ; @@ -94,4 +116,4 @@ internal SNoop. Stm ::= ; comment "/*" "*/" ; comment "//" ; -entrypoints Stms, Exp ; +entrypoints Program;