data Stm =
SExp Exp
| SBlock [Stm]
+ | SDecl Type Ident Exp
+ | SDeclD Type Ident
| SWhile Exp Stm
| SIf Exp Stm Stm
| SPrint Exp
| SNoop
- | SDecl Type Ident Exp
deriving (Eq,Ord,Show)
data Exp =
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 (SDeclD t i) = compileStm (SDecl t i $ case t of
+ TInt -> EInt 0
+ TBool -> EBool False
+ )
compileStm (SDecl t (Ident i) e) = "int "++i++"="++compileExp e++";\n"
\begin{tabular}{lll}
{\nonterminal{Stm}} & {\arrow} &{\nonterminal{Exp}} {\terminal{;}} \\
& {\delimit} &{\terminal{\{}} {\nonterminal{ListStm}} {\terminal{\}}} \\
- & {\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} &{\nonterminal{Type}} {\nonterminal{Ident}} {\terminal{{$=$}}} {\nonterminal{Exp}} {\terminal{;}} \\
+ & {\delimit} &{\nonterminal{Type}} {\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}} \\
instance Show Value where
show (VInt n) = show n
- show (VBool b) = show b
+ show (VBool True) = "1"
+ show (VBool False) = "0"
type Variables = [Map Ident Value]
eval (EBool b) = return (VBool b)
eval (EInt n) = return (VInt n)
eval (EVar i) = getVariableValue i
-eval (EAss i e) = setVariableValue i e
+eval (EAss i e) = setVariableValue i e
eval (BiOpExp e o e') = do
v <- eval e
v'<- eval e'
return $ VInt $ read s
eval EReadB = do
s <- lift $ getWord
- return $ VBool $ read s
+ return $ VBool $ if (read s == 0) then False else True
getWord :: IO String
getWord = do
c <- getChar
- if inList c ['\n','\r',' ', '\t']
+ if inList c [' ', '\n', '\t', '\r']
then return ""
else do
l <- getWord
- return (c:l)
+ return (c:l)
-- op :: Op -> (a -> a -> Value)
opE Eq = \e e' -> VBool $ e == e'
opE NEq = \e e' -> VBool $ not (e == e')
op Plus = \e e' -> VInt $ e + e'
-op Minus = \e e' -> VInt $ e - e'
-op Times = \e e' -> VInt $ e * e'
-op Div = \e e' -> VInt $ e `div` e'
+op Minus = \e e' -> VInt $ e - e'
+op Times = \e e' -> VInt $ e * e'
+op Div = \e e' -> VInt $ e `div` e'
op Lt = \e e' -> VBool $ e < e'
op ELt = \e e' -> VBool $ e <= e'
op Gt = \e e' -> VBool $ e > e'
execute (SWhile e s) = do
(VBool b) <- eval e
if b then pushAndPop (execute s) >> execute (SWhile e s) else return ()
+execute (SDeclD t i) = execute $ SDecl t i $ case t of
+ TInt -> EInt 0
+ TBool -> EBool False
execute (SDecl t i e) =do
- e' <- eval e
+ v <- eval e
(m:ms) <- get
- put $ (insert i e' m):ms
+ put $ (insert i v m):ms
Stm :: { Stm }
Stm : Exp ';' { SExp $1 }
| '{' ListStm '}' { SBlock (reverse $2) }
- | 'int' Ident '=' Exp ';' { declIntE_ $2 $4 }
- | 'bool' Ident '=' Exp ';' { declBoolE_ $2 $4 }
- | 'int' Ident ';' { declInt_ $2 }
- | 'bool' Ident ';' { declBool_ $2 }
+ | Type Ident '=' Exp ';' { SDecl $1 $2 $4 }
+ | Type Ident ';' { SDeclD $1 $2 }
| 'while' '(' Exp ')' Stm { SWhile $3 $5 }
| 'if' '(' Exp ')' Stm 'else' Stm { SIf $3 $5 $7 }
| 'if' '(' Exp ')' Stm { if_ $3 $5 }
Bad $ "syntax error at " ++ tokenPos ts ++ if null ts then [] else (" before " ++ unwords (map prToken (take 4 ts)))
myLexer = tokens
-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_
prt i e = case e of
SExp exp -> prPrec i 0 (concatD [prt 0 exp , doc (showString ";")])
SBlock stms -> prPrec i 0 (concatD [doc (showString "{") , prt 0 stms , doc (showString "}")])
+ SDecl type' id exp -> prPrec i 0 (concatD [prt 0 type' , prt 0 id , doc (showString "=") , prt 0 exp , doc (showString ";")])
+ SDeclD type' id -> prPrec i 0 (concatD [prt 0 type' , prt 0 id , doc (showString ";")])
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 [])
transStm x = case x of
SExp exp -> failure x
SBlock stms -> failure x
+ SDecl type' id exp -> failure x
+ SDeclD type' id -> 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
typeCheckStm (SWhile e s) = do
TBool <- typeCheckExp e
pushAndPop $ typeCheckStm s
+typeCheckStm (SDeclD t i) = addVariable i t
typeCheckStm (SDecl t i e) = do
t2 <- typeCheckExp e
assert (t == t2) $ "Illegal to assign an expression of type "++show t2++" to variable "++show i++" of type "++show t
+ addVariable i t
+typeCheckStm (SPrint e) = do
+ typeCheckExp e
+ return ()
+
+addVariable :: (MonadState Types 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)
_ -> fail $ "Duplicate variable declaration: "++show i
-typeCheckStm (SPrint e) = do
- typeCheckExp e
- return ()
++++++++++++
-(t is little tau, T is large tau, E is 'in', and + is that other symbol)
+(t is used for types, T is the context, and + is used for in)
-[Eq, Neq]
+[Eq, NEq]
-e:bool <= e1:t & e2:t
-where e is e1 Eq e2.
+T+ e1 Eq e2:bool <= T+ e1:t & T+ e2:t
+
+If e1 and e2 are of the same type, then Eq or NEq return bool
[Plus, Minus, Times, Div]
-e:int <= e1:int & e2:int
-where e is e1 Plus e2.
+T+ e1 Plus e2:int <= T+ e1:int & T+ e2:int
+The operators Plus/Minus/Times/Div return int if both operands are ints
-[Lt, ELt, Gt, EGt]
-e:bool <= e1:int & e2:int
-where e is e1 Lt e2.
+[Lt, ELt, Gt, EGt]
+T+ e1 Lt e2:bool <= T+ e1:int & T+ e2:int
-[Assignment]
+The operators Lt/ELt/Gt/EGt return bool if both operands are ints
-T+ i := e:t <= i:t E T & T+ e:t
-where the assignment is identifier i = expression e.
+[Assignment]
-[ExpT]
+T+ i := e:t <= i:t in T & T+ e:t
-u,e:t <= e:t & u:t
-where the expression is type u expression e.
+The assignemnt of e to i returns type t if both i and e have type t.
[ENeg]
-e:int <= e:int
+T+ ENeg e:int <= T+ e:int
+ENeg e returns int if e is of type int
[ENot]
-e:bool <= e:bool
+T+ ENot e:bool <= e:bool
+
+ENot e returns bool if e is of type bool
+
+[EVar]
+
+T+ i:t <= i:t in T
+
+i has type t if i is defined in the context with type t.
+
+[EInt]
+
+T+ n:int
+
+n has type int
+
+[EBool]
+
+T+ b:bool
+
+b has type bool
+
+[EReadI]
+T+ n:int
-[SExp, SBlock]
+EReadI returns an int
-S:NoType <= e:t
+[EReadB]
+
+T+ b:bool
+
+EReadB returns a bool
+
+[EPost]
+
+T+ EPost i:int <= i:int in T
+
+EPost i is of type int if i is defined in T with type int.
+
+[SExp]
+
+T+ e <= T+ e:t
+
+[SBlock]
+
+T+ s;SBlock ss <= T+ s => T' , T'+ ss => T''
+
+the first statment s, in the block, is typechecked in the context T and returns the context T', the rest of the block is then recursively typeckecked in the context T'
[SIf]
T+ if e then s1 else s2 <= T+ e:bool & T+ s1 & T+ s2
+if e is of type bool and s1 and and s2 typechecks in the context T, then the same context is returned
+
[SWhile]
T+ while e do s <= T+ e:bool & T+ s
+If e is of type bool and s typechecks in context T then the same context is returned
+
+
[SDecl]
-T+ i:t => T', i:t <= i!ET & e:t & u:t
+T+ t i = e => T,i:t <= i not in T & e:t
+
+if i and e are of the same type and i is not declared in the current scope then i is added with type t to the context.
+
+[SDeclD]
-(Type u Ident i = Exp e)
+T+ t i => T,i:t <= i not in T
+if i is not declared in the current scope, then i is added to the context with type t
+[SNoop]
+T+ s
+SNoops does nothing so the same context is returned
+[SPrint]
+T+ e <= T+ e:t
+if e has type t then SPrint returns the same context
--- /dev/null
+if (true)
+int x = 1;
+else
+print x;
--- /dev/null
+while (false)
+int x = 1;
+print x;
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);
+SDecl. Stm ::= Type Ident "=" Exp ";" ;
+SDeclD. Stm ::= Type Ident ";" ;
SWhile. Stm ::= "while" "(" Exp ")" Stm ;
internal EPost. Exp ::= Ident Op1 ;
internal SNoop. Stm ::= ;
-internal SDecl. Stm ::= Type Ident "=" Exp ";" ;
comment "/*" "*/" ;
comment "//" ;
projects / proglang.git / commitdiff