newtype Ident = Ident String deriving (Eq,Ord,Show)
+data Type =
+ TInt
+ | TBool
+ deriving (Eq,Ord,Show)
+
+data Stms =
+ Program [Stm]
+ deriving (Eq,Ord,Show)
+
data Stm =
- SDecl Type Ident Exp
- | SExp Exp
+ SExp Exp
| SBlock [Stm]
- | SIf Exp Stm Stm
| SWhile Exp Stm
+ | SIf Exp Stm Stm
| SPrint Exp
| SNoop
+ | SDecl Type Ident Exp
deriving (Eq,Ord,Show)
data Exp =
EAss Ident Exp
| EVar Ident
| EInt Integer
+ | EBool Bool
| ENeg Exp
| ENot Exp
- | EBool Bool
| EReadI
| EReadB
- | ExpT Type Exp
- | EDefault
| BiOpExp Exp Op Exp
| EPost Ident Op
deriving (Eq,Ord,Show)
-data Stms =
- Program [Stm]
- deriving (Eq,Ord,Show)
-
data Op =
Lt
| ELt
| Div
deriving (Eq,Ord,Show)
-data Type =
- TInt
- | TBool
- | NoType
- deriving (Eq,Ord,Show)
-
compileExp (EInt n) = show n
compileExp (EVar (Ident i)) = i
compileExp (EAss (Ident i) e) = i++"="++compileExp e
-compileExp EDefault = error "EDefault called from an illegal place"
compileExp (BiOpExp e o e') = "("++compileExp e++")"++op o++"("++compileExp e'++")"
compileExp (ENeg e) = "-("++compileExp e++")"
compileExp (ENot e) ="!("++compileExp e++")"
compileStm (SPrint e) = "printf(\"%d\\n\","++compileExp e++");\n"
compileStm (SBlock ss) = "{\n"++concat (map (("\t"++).compileStm) ss)++"\n}\n"
compileStm (SWhile e s) = "while("++compileExp e++")"++compileStm s
-compileStm (SDecl t (Ident i) EDefault) = "int "++i++"=0;\n"
compileStm (SDecl t (Ident i) e) = "int "++i++"="++compileExp e++";\n"
The symbols used in syntax are the following: \\
\begin{tabular}{lll}
-{\symb{{$=$}}} &{\symb{;}} &{\symb{\{}} \\
-{\symb{\}}} &{\symb{(}} &{\symb{)}} \\
+{\symb{;}} &{\symb{\{}} &{\symb{\}}} \\
+{\symb{{$=$}}} &{\symb{(}} &{\symb{)}} \\
{\symb{{$+$}{$+$}}} &{\symb{{$-$}{$-$}}} &{\symb{{$-$}}} \\
{\symb{!}} &{\symb{{$<$}}} &{\symb{{$<$}{$=$}}} \\
{\symb{{$>$}}} &{\symb{{$>$}{$=$}}} &{\symb{{$=$}{$=$}}} \\
\end{tabular}\\
\begin{tabular}{lll}
-{\nonterminal{Stm}} & {\arrow} &{\nonterminal{Type}} {\nonterminal{Ident}} {\terminal{{$=$}}} {\nonterminal{Exp}} {\terminal{;}} \\
- & {\delimit} &{\nonterminal{Type}} {\nonterminal{Ident}} {\terminal{;}} \\
- & {\delimit} &{\nonterminal{Exp}} {\terminal{;}} \\
+{\nonterminal{Type}} & {\arrow} &{\terminal{int}} \\
+ & {\delimit} &{\terminal{bool}} \\
+\end{tabular}\\
+
+\begin{tabular}{lll}
+{\nonterminal{Stms}} & {\arrow} &{\nonterminal{ListStm}} \\
+\end{tabular}\\
+
+\begin{tabular}{lll}
+{\nonterminal{Stm}} & {\arrow} &{\nonterminal{Exp}} {\terminal{;}} \\
& {\delimit} &{\terminal{\{}} {\nonterminal{ListStm}} {\terminal{\}}} \\
- & {\delimit} &{\terminal{if}} {\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} {\nonterminal{Stm}} \\
- & {\delimit} &{\terminal{if}} {\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} {\nonterminal{Stm}} {\terminal{else}} {\nonterminal{Stm}} \\
+ & {\delimit} &{\terminal{int}} {\nonterminal{Ident}} {\terminal{{$=$}}} {\nonterminal{Exp}} {\terminal{;}} \\
+ & {\delimit} &{\terminal{bool}} {\nonterminal{Ident}} {\terminal{{$=$}}} {\nonterminal{Exp}} {\terminal{;}} \\
+ & {\delimit} &{\terminal{int}} {\nonterminal{Ident}} {\terminal{;}} \\
+ & {\delimit} &{\terminal{bool}} {\nonterminal{Ident}} {\terminal{;}} \\
& {\delimit} &{\terminal{while}} {\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} {\nonterminal{Stm}} \\
+ & {\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{;}} \\
\end{tabular}\\
& {\delimit} &{\nonterminal{Ident}} {\terminal{{$-$}{$-$}}} \\
& {\delimit} &{\nonterminal{Ident}} \\
& {\delimit} &{\nonterminal{Integer}} \\
+ & {\delimit} &{\nonterminal{Bool}} \\
& {\delimit} &{\terminal{{$-$}}} {\nonterminal{Exp3}} \\
& {\delimit} &{\terminal{!}} {\nonterminal{Exp3}} \\
- & {\delimit} &{\nonterminal{Bool}} \\
& {\delimit} &{\terminal{readInt}} \\
& {\delimit} &{\terminal{readBool}} \\
& {\delimit} &{\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} \\
& {\delimit} &{\nonterminal{Stm}} {\nonterminal{ListStm}} \\
\end{tabular}\\
-\begin{tabular}{lll}
-{\nonterminal{Stms}} & {\arrow} &{\nonterminal{ListStm}} \\
-\end{tabular}\\
-
\begin{tabular}{lll}
{\nonterminal{Op0}} & {\arrow} &{\terminal{{$<$}}} \\
& {\delimit} &{\terminal{{$<$}{$=$}}} \\
& {\delimit} &{\nonterminal{Op0}} \\
\end{tabular}\\
-\begin{tabular}{lll}
-{\nonterminal{Type}} & {\arrow} &{\terminal{int}} \\
- & {\delimit} &{\terminal{bool}} \\
-\end{tabular}\\
-
\end{document}
eval (EInt n) = return (VInt n)
eval (EVar i) = getVariableValue i
eval (EAss i e) = setVariableValue i e
-eval EDefault = error "EDefault called from an illegal place"
eval (BiOpExp e o e') = do
v <- eval e
v'<- eval e'
--setVariableValue :: (MonadState Variables m) => Ident -> Exp -> m Value
--setVariableValue :: (MonadState Variables m) => Ident -> Exp -> m Value
-addVariable :: Ident -> Exp -> StateT Variables IO ()
-addVariable i e = do
- e' <- eval e
- (m:ms) <- get
- put $ (insert i e' m):ms
setVariableValue :: Ident -> Exp -> StateT Variables IO Value
setVariableValue i e = do
execute (SWhile e s) = do
(VBool b) <- eval e
if b then execute s >> execute (SWhile e s) else return ()
-execute (SDecl t i EDefault) = do
- case t of
- TInt -> addVariable i (EInt 0)
- TBool -> addVariable i (EBool False)
- return ()
-execute (SDecl t i e) = addVariable i e >> return ()
+execute (SDecl t i e) =do
+ e' <- eval e
+ (m:ms) <- get
+ put $ (insert i e' m):ms
$u = [\0-\255] -- universal: any character
@rsyms = -- symbols and non-identifier-like reserved words
- \= | \; | \{ | \} | \( | \) | \+ \+ | \- \- | \- | \! | \< | \< \= | \> | \> \= | \= \= | \! \= | \+ | \* | \/
+ \; | \{ | \} | \= | \( | \) | \+ \+ | \- \- | \- | \! | \< | \< \= | \> | \> \= | \= \= | \! \= | \+ | \* | \/
:-
"//" [.]* ; -- Toss single line comments
%tokentype { Token }
%token
- '=' { PT _ (TS "=") }
';' { PT _ (TS ";") }
'{' { PT _ (TS "{") }
'}' { PT _ (TS "}") }
+ '=' { PT _ (TS "=") }
'(' { PT _ (TS "(") }
')' { PT _ (TS ")") }
'++' { PT _ (TS "++") }
| 'false' { False }
+Type :: { Type }
+Type : 'int' { TInt }
+ | 'bool' { TBool }
+
+
+Stms :: { Stms }
+Stms : ListStm { Program (reverse $1) }
+
+
Stm :: { Stm }
-Stm : Type Ident '=' Exp ';' { SDecl $1 $2 $4 }
- | Type Ident ';' { decl_ $1 $2 }
- | Exp ';' { SExp $1 }
+Stm : Exp ';' { SExp $1 }
| '{' ListStm '}' { SBlock (reverse $2) }
- | 'if' '(' Exp ')' Stm { if_ $3 $5 }
- | 'if' '(' Exp ')' Stm 'else' Stm { SIf $3 $5 $7 }
+ | 'int' Ident '=' Exp ';' { declIntE_ $2 $4 }
+ | 'bool' Ident '=' Exp ';' { declBoolE_ $2 $4 }
+ | 'int' Ident ';' { declInt_ $2 }
+ | 'bool' Ident ';' { declBool_ $2 }
| 'while' '(' Exp ')' Stm { SWhile $3 $5 }
+ | 'if' '(' Exp ')' Stm 'else' Stm { SIf $3 $5 $7 }
+ | 'if' '(' Exp ')' Stm { if_ $3 $5 }
| 'print' Exp ';' { SPrint $2 }
| Ident '--' { postDecr_ $1 }
| Ident { EVar $1 }
| Integer { EInt $1 }
+ | Bool { EBool $1 }
| '-' Exp3 { ENeg $2 }
| '!' Exp3 { ENot $2 }
- | Bool { EBool $1 }
| 'readInt' { EReadI }
| 'readBool' { EReadB }
| '(' Exp ')' { $2 }
| ListStm Stm { flip (:) $1 $2 }
-Stms :: { Stms }
-Stms : ListStm { Program (reverse $1) }
-
-
Op0 :: { Op }
Op0 : '<' { Lt }
| '<=' { ELt }
| Op0 { $1 }
-Type :: { Type }
-Type : 'int' { TInt }
- | 'bool' { TBool }
-
-
{
Bad $ "syntax error at " ++ tokenPos ts ++ if null ts then [] else (" before " ++ unwords (map prToken (take 4 ts)))
myLexer = tokens
-decl_ t_ v_ = SDecl t_ v_ EDefault
+declIntE_ x_ e_ = SDecl TInt x_ e_
+declBoolE_ x_ e_ = SDecl TBool x_ e_
+declInt_ x_ = SDecl TInt x_ (EInt 0)
+declBool_ x_ = SDecl TBool x_ (EBool False)
if_ e_ s_ = SIf e_ s_ SNoop
compExp_ e1_ o_ e2_ = BiOpExp e1_ o_ e2_
op1_ e1_ o_ e2_ = BiOpExp e1_ o_ e2_
False -> prPrec i 0 (concatD [doc (showString "false")])
+instance Print Type where
+ prt i e = case e of
+ TInt -> prPrec i 0 (concatD [doc (showString "int")])
+ TBool -> prPrec i 0 (concatD [doc (showString "bool")])
+
+
+instance Print Stms where
+ prt i e = case e of
+ Program stms -> prPrec i 0 (concatD [prt 0 stms])
+
+
instance Print Stm where
prt i e = case e of
- SDecl type' id exp -> prPrec i 0 (concatD [prt 0 type' , prt 0 id , doc (showString "=") , prt 0 exp , doc (showString ";")])
SExp exp -> prPrec i 0 (concatD [prt 0 exp , doc (showString ";")])
SBlock stms -> prPrec i 0 (concatD [doc (showString "{") , prt 0 stms , doc (showString "}")])
- 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])
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 ";")])
SNoop -> prPrec i 0 (concatD [])
+ SDecl type' id exp -> prPrec i 0 (concatD [prt 0 type' , prt 0 id , doc (showString "=") , prt 0 exp , doc (showString ";")])
prtList es = case es of
[] -> (concatD [])
EAss id exp -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 exp])
EVar id -> prPrec i 3 (concatD [prt 0 id])
EInt n -> prPrec i 3 (concatD [prt 0 n])
+ EBool bool -> prPrec i 3 (concatD [prt 0 bool])
ENeg exp -> prPrec i 3 (concatD [doc (showString "-") , prt 3 exp])
ENot exp -> prPrec i 3 (concatD [doc (showString "!") , prt 3 exp])
- EBool bool -> prPrec i 3 (concatD [prt 0 bool])
EReadI -> prPrec i 3 (concatD [doc (showString "readInt")])
EReadB -> prPrec i 3 (concatD [doc (showString "readBool")])
- ExpT type' exp -> prPrec i 0 (concatD [prt 0 type' , prt 0 exp])
- EDefault -> prPrec i 0 (concatD [])
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])
-instance Print Stms where
- prt i e = case e of
- Program stms -> prPrec i 0 (concatD [prt 0 stms])
-
-
instance Print Op where
prt i e = case e of
Lt -> prPrec i 0 (concatD [doc (showString "<")])
Div -> prPrec i 2 (concatD [doc (showString "/")])
-instance Print Type where
- prt i e = case e of
- TInt -> prPrec i 0 (concatD [doc (showString "int")])
- TBool -> prPrec i 0 (concatD [doc (showString "bool")])
- NoType -> prPrec i 0 (concatD [])
-
-
False -> failure x
+transType :: Type -> Result
+transType x = case x of
+ TInt -> failure x
+ TBool -> failure x
+
+
+transStms :: Stms -> Result
+transStms x = case x of
+ Program stms -> failure x
+
+
transStm :: Stm -> Result
transStm x = case x of
- SDecl type' id exp -> failure x
SExp exp -> failure x
SBlock stms -> failure x
- SIf exp stm0 stm -> failure x
SWhile exp stm -> failure x
+ SIf exp stm0 stm -> failure x
SPrint exp -> failure x
SNoop -> failure x
+ SDecl type' id exp -> failure x
transExp :: Exp -> Result
EAss id exp -> failure x
EVar id -> failure x
EInt n -> failure x
+ EBool bool -> failure x
ENeg exp -> failure x
ENot exp -> failure x
- EBool bool -> failure x
EReadI -> failure x
EReadB -> failure x
- ExpT type' exp -> failure x
- EDefault -> failure x
BiOpExp exp0 op exp -> failure x
EPost id op -> failure x
-transStms :: Stms -> Result
-transStms x = case x of
- Program stms -> failure x
-
-
transOp :: Op -> Result
transOp x = case x of
Lt -> failure x
Div -> failure x
-transType :: Type -> Result
-transType x = case x of
- TInt -> failure x
- TBool -> failure x
- NoType -> failure x
-
-
inList _ [] = False
inList a (x:xs) = if a == x then True else inList a xs
+assert :: Monad m => Bool -> String -> m ()
+assert True _ = return ()
+assert False s = fail s
+
typeCheckExp :: (MonadState Types m) => Exp -> m Type
typeCheckExp (BiOpExp e o e') = do
t1 <- typeCheckExp e
t2 <- typeCheckExp e'
- if not(t1 == t2) then fail "The parameters for the binary operator aren't equal"
- else if inList o [Eq,NEq] then return TBool
- else if not(t1 == TInt) then fail "The parameters need to be of type int"
- else if inList o [Plus,Minus,Times,Div]
- then return TInt
- else return TBool
+ assert (t1 == t2) "The parameters for the binary operator aren't equal"
+ if inList 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]
+ then return TInt
+ else return TBool
typeCheckExp (EVar i) = typeCheckVar i
typeCheckExp (EAss i e) = do
t <- typeCheckVar i
t2 <- typeCheckExp e
- if t == t2 then return t else fail $ "Illegal to assign an expression of type "++show t2++" to variable "++show i++" of type "++show t
+ assert (t == t2) $ "Illegal to assign an expression of type "++show t2++" to variable "++show i++" of type "++show t
+ return t
typeCheckExp (EInt i) = return TInt
typeCheckExp (EBool b) = return TBool
typeCheckExp EReadI = return TInt
typeCheckExp EReadB = return TBool
-typeCheckExp (ExpT t e) = do
- t2 <- typeCheckExp e
- if t == t2 then return t else fail "Something went wrong ExpT is created with the wrong type"
-typeCheckExp EDefault = return NoType
typeCheckExp (EPost i op) = do
TInt <- typeCheckVar i
return TInt
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
-typeCheckStm :: (MonadState Types m) => Stm -> m Type
-typeCheckStm SNoop = return NoType
+typeCheckStm :: (MonadState Types m) => Stm -> m ()
+typeCheckStm SNoop = return ()
typeCheckStm (SExp e) = do
typeCheckExp e
- return NoType
+ return ()
typeCheckStm (SBlock ss) = do
modify (empty:)
mapM typeCheckStm ss
modify tail
- return NoType
typeCheckStm (SIf e s s') = do
TBool <- typeCheckExp e
- NoType <- typeCheckStm s
- NoType <- typeCheckStm s
- return NoType
+ modify (empty:)
+ typeCheckStm s
+ modify (\s -> empty:tail s)
+ typeCheckStm s'
+ modify tail
typeCheckStm (SWhile e s) = do
TBool <- typeCheckExp e
- NoType <- typeCheckStm s
- return NoType
+ modify (empty:)
+ typeCheckStm s
+ modify tail
typeCheckStm (SDecl t i e) = do
t2 <- typeCheckExp e
- if t == t2 || t2 == NoType then do
- (m:ms) <- get
- case insertLookupWithKey (\k a1 a2 -> a1) i t m of
- (Nothing,m') -> put (m':ms)
- _ -> fail $ "Duplicate variable declaration: "++show i
- return NoType
- else fail $ "Illegal to assign an expression of type "++show t2++" to variable "++show i++" of type "++show t
+ assert (t == t2) $ "Illegal to assign an expression of type "++show t2++" to variable "++show i++" of type "++show t
+ (m:ms) <- get
+ case insertLookupWithKey (\k a1 a2 -> a1) i t m of
+ (Nothing,m') -> put (m':ms)
+ _ -> fail $ "Duplicate variable declaration: "++show i
typeCheckStm (SPrint e) = do
typeCheckExp e
- return NoType
+ return ()
-- ordinary rules
+
+True. Bool ::= "true" ;
+False. Bool ::= "false" ;
+
+TInt. Type ::= "int" ;
+TBool. Type ::= "bool" ;
+
Program. Stms ::= [Stm] ;
-SExp. Stm ::= Exp ";" ;
-SBlock. Stm ::= "{" [Stm] "}" ;
-SDecl. Stm ::= Type Ident "=" Exp ";" ;
-decl. Stm ::= Type Ident ";" ;
-define decl t v = SDecl t v EDefault ;
+SExp. Stm ::= Exp ";" ;
+SBlock. Stm ::= "{" [Stm] "}" ;
+declIntE. Stm ::= "int" Ident "=" Exp ";" ;
+declBoolE. Stm ::= "bool" Ident "=" Exp ";" ;
+define declIntE x e = SDecl TInt x e;
+define declBoolE x e = SDecl TBool x e;
+declInt. Stm ::= "int" Ident ";" ;
+declBool. Stm ::= "bool" Ident ";" ;
+define declInt x = SDecl TInt x (EInt 0);
+define declBool x = SDecl TBool x (EBool False);
+
SWhile. Stm ::= "while" "(" Exp ")" Stm ;
SIf. Stm ::= "if" "(" Exp ")" Stm "else" Stm ;
_. Op ::= Op0;
-True. Bool ::= "true" ;
-False. Bool ::= "false" ;
-
-TInt. Type ::= "int" ;
-TBool. Type ::= "bool" ;
-
-- pragmas
-internal ExpT. Exp ::= Type Exp ;
-internal SNoop. Stm ::= ;
-internal EDefault. Exp ::= ;
+-- internal ExpT. Exp ::= Type Exp ;
+-- internal EDefault. Exp ::= ;
internal BiOpExp. Exp ::= Exp Op Exp ;
-internal NoType. Type ::= ;
+-- internal NoType. Type ::= ;
internal EPost. Exp ::= Ident Op1 ;
+internal SNoop. Stm ::= ;
+internal SDecl. Stm ::= Type Ident "=" Exp ";" ;
+
comment "/*" "*/" ;
comment "//" ;