Upgrade is finished. Everything should be working now.

Commit d2b398ec authored by Tadej Borovšak's avatar Tadej Borovšak
Browse files

Finish adding unittest

parent 5288de39
...@@ -3,6 +3,9 @@ module Imp_Evaluator where ...@@ -3,6 +3,9 @@ module Imp_Evaluator where
import Imp_AbsSyntax import Imp_AbsSyntax
import Imp_State import Imp_State
-- Arithmetic expression evaluator
-- NOTE: We evaluate both e1 and e1 using the same state s, since
-- expressions are pure and do not modify state of the program.
evalAExp :: State -> AExp -> Integer evalAExp :: State -> AExp -> Integer
evalAExp _ (Num n) = n evalAExp _ (Num n) = n
evalAExp s (Loc l) = valof s l evalAExp s (Loc l) = valof s l
...@@ -13,8 +16,9 @@ evalAExp s (AOp (opName, e1, e2)) = op v1 v2 ...@@ -13,8 +16,9 @@ evalAExp s (AOp (opName, e1, e2)) = op v1 v2
"+" -> (+) "+" -> (+)
"-" -> (-) "-" -> (-)
"*" -> (*) "*" -> (*)
_ -> error $ "Runtime error: unknow arithmetic op - " ++ opName _ -> error $ "Runtime error: unknown arithmetic op - " ++ opName
-- Boolean expression evaluator
evalBExp :: State -> BExp -> Bool evalBExp :: State -> BExp -> Bool
evalBExp _ (Boolean b) = b evalBExp _ (Boolean b) = b
evalBExp s (BOp (opName, e1, e2)) = op v1 v2 evalBExp s (BOp (opName, e1, e2)) = op v1 v2
...@@ -25,12 +29,11 @@ evalBExp s (BOp (opName, e1, e2)) = op v1 v2 ...@@ -25,12 +29,11 @@ evalBExp s (BOp (opName, e1, e2)) = op v1 v2
"<" -> (<) "<" -> (<)
_ -> error $ "Runtime error: unknown boolean op - " ++ opName _ -> error $ "Runtime error: unknown boolean op - " ++ opName
-- Command evaluator
evalCom :: State -> Com -> State evalCom :: State -> Com -> State
evalCom s (Assign (l, e)) = update s l $ evalAExp s e evalCom s (Assign (l, e)) = update s l $ evalAExp s e
evalCom s (Cond (e, c1, c2)) = evalCom s $ if evalBExp s e then c1 else c2 evalCom s (Cond (e, c1, c2)) = evalCom s $ if evalBExp s e then c1 else c2
evalCom s (Seq (c1, c2)) = evalCom (evalCom s c1) c2 evalCom s (Seq (c1, c2)) = evalCom (evalCom s c1) c2
evalCom s Skip = s evalCom s Skip = s
evalCom s loop@(While (e, c)) = evalCom s loop@(While (e, c)) =
if evalBExp s e if evalBExp s e then evalCom (evalCom s c) loop else s
then evalCom (evalCom s c) loop
else s
-- vim: set syntax=alex autoindent ts=4 sts=4 sw=4 expandtab : -- vim: set syntax=alex autoindent ts=4 sts=4 sw=4 expandtab :
{ {
-- Make newer version of GHC happy when compiling alex output
{-# OPTIONS_GHC -fno-warn-tabs #-}
-- Exports that we need in parser
module Imp_Lex module Imp_Lex
( Token(..) ( Token(..)
, AlexPosn(AlexPn) , AlexPosn(AlexPn)
...@@ -9,37 +13,41 @@ module Imp_Lex ...@@ -9,37 +13,41 @@ module Imp_Lex
) where ) where
} }
-- Use alex's position wrapper in order to produce a bit more informative
-- error messages
%wrapper "posn" %wrapper "posn"
-- Common character classes
$digit = [0-9] $digit = [0-9]
$alpha = [A-Za-z] $alpha = [A-Za-z]
@number = $digit+ -- Regular expressions for complex tokens (to avoid cluttering rules below)
@ident = [$alpha _] [$alpha $digit _]* @number = $digit+
@keywords = if | then | else | while | do | skip @ident = [$alpha _] [$alpha $digit _]*
@keywords = if | then | else | while | do | skip
@operations = \+ | \- | \* | \=\= | \< @operations = \+ | \- | \* | \=\= | \<
@booleans = True | False @booleans = True | False
-- Token rules (function type is a bit different, since we use posn wrapper)
tokens :- tokens :-
$white+ ; -- whitespace $white+ ; -- whitespace
\( { \p _ -> LPAREN p } -- scope start \( { \p _ -> LPAREN p } -- scope start
\) { \p _ -> RPAREN p } -- scope end \) { \p _ -> RPAREN p } -- scope end
\; { \p _ -> DELIM p } -- command delimiter \; { \p _ -> DELIM p } -- command delimiter
\:\= { \p _ -> ASSIGN p } -- assignment \:\= { \p _ -> ASSIGN p } -- assignment
@operations { \p s -> BINOP p s } -- binary operations @operations { \p s -> BINOP p s } -- binary operations
@keywords { \p s -> KEYWORD p s } -- keywords @keywords { \p s -> KEYWORD p s } -- keywords
@number { \p s -> NUM p $ read s } -- integer literals @number { \p s -> NUM p $ read s } -- integer literals
@booleans { \p s -> BOOL p $ read s } -- Boolean literals @booleans { \p s -> BOOL p $ read s } -- Boolean literals
@ident { \p s -> LOC p s } -- locations (variables) @ident { \p s -> LOC p s } -- locations (variables)
. { \p s -> INVALID p s } -- invalid char . { \p s -> INVALID p s } -- invalid char
{ {
-- The Token type - the action for each lexical class has type String -> Token -- The Token type that contains position information
data Token = LPAREN AlexPosn data Token = LPAREN AlexPosn
| RPAREN AlexPosn | RPAREN AlexPosn
| DELIM AlexPosn | DELIM AlexPosn
...@@ -50,7 +58,7 @@ data Token = LPAREN AlexPosn ...@@ -50,7 +58,7 @@ data Token = LPAREN AlexPosn
| BOOL AlexPosn Bool | BOOL AlexPosn Bool
| LOC AlexPosn String | LOC AlexPosn String
| INVALID AlexPosn String | INVALID AlexPosn String
deriving Show deriving (Show, Eq)
-- Position accessor -- Position accessor
pos :: Token -> AlexPosn pos :: Token -> AlexPosn
......
...@@ -11,43 +11,53 @@ import Imp_AbsSyntax ...@@ -11,43 +11,53 @@ import Imp_AbsSyntax
%tokentype { Token } %tokentype { Token }
%error { parseError } %error { parseError }
-- tokens -- Tokens (we ignore position information here)
%token '(' { LPAREN _ } %token '(' { LPAREN _ }
')' { RPAREN _ } ')' { RPAREN _ }
';' { DELIM _ } ';' { DELIM _ }
assign { ASSIGN _ } assign { ASSIGN _ }
-- We need to spit arithmetic operations for precedence rules
'+' { BINOP _ "+" } '+' { BINOP _ "+" }
'-' { BINOP _ "-" } '-' { BINOP _ "-" }
'*' { BINOP _ "*" } '*' { BINOP _ "*" }
'<' { BINOP _ "<" } -- Boolean operations can be lumped together
'~' { BINOP _ "==" } bop { BINOP _ $$ }
if { KEYWORD _ "if" } if { KEYWORD _ "if" }
then { KEYWORD _ "then" } then { KEYWORD _ "then" }
else { KEYWORD _ "else" } else { KEYWORD _ "else" }
while { KEYWORD _ "while" } while { KEYWORD _ "while" }
do { KEYWORD _ "do" } do { KEYWORD _ "do" }
skip { KEYWORD _ "skip" } skip { KEYWORD _ "skip" }
num { NUM _ $$ } num { NUM _ $$ }
bool { BOOL _ $$ } bool { BOOL _ $$ }
loc { LOC _ $$ } loc { LOC _ $$ }
-- precedence and associativity declarations, lowest precedence first -- These two rules are needed to break shift/reduce conflicts in while/if
-- statements (we want ; to bind stronger). Associativity of ; doesn't make
-- these are needed to break shift/reduce conflict in while/if statements -- any difference, but I find it easier to read ASTs that are "right-heavy".
%nonassoc do then else %nonassoc do then else
%right ';' %right ';'
%nonassoc assign -- Operator precedence - nothing interesting here
%nonassoc '~' '<' %nonassoc bop
%left '+' '-' %left '+' '-'
%left '*' %left '*'
%% %%
-- Programs are either empty, in which case we simply emit skip command,
-- or contain a single command.
Prog : {- empty -} { Skip } Prog : {- empty -} { Skip }
| Command { $1 } | Command { $1 }
-- Command productions are simple transcripts of abstract syntax rules, with
-- exception of the last rule that has been added to support command grouping
-- (needed to limit the scope of if and while commands).
-- commands).
Command : skip { Skip } Command : skip { Skip }
| loc assign AExpr { Assign ($1, $3) } | loc assign AExpr { Assign ($1, $3) }
| if BExpr then Command else Command { Cond ($2, $4, $6) } | if BExpr then Command else Command { Cond ($2, $4, $6) }
...@@ -55,24 +65,27 @@ Command : skip { Skip } ...@@ -55,24 +65,27 @@ Command : skip { Skip }
| Command ';' Command { Seq ($1, $3) } | Command ';' Command { Seq ($1, $3) }
| '(' Command ')' { $2 } | '(' Command ')' { $2 }
-- Arithmetic expressions (nothing excaptional here).
AExpr : loc { Loc $1 } AExpr : loc { Loc $1 }
| num { Num $1 } | num { Num $1 }
| AExpr '+' AExpr { AOp ("+", $1, $3) } | AExpr '+' AExpr { AOp ("+", $1, $3) }
| AExpr '-' AExpr { AOp ("-", $1, $3) } | AExpr '-' AExpr { AOp ("-", $1, $3) }
| AExpr '*' AExpr { AOp ("*", $1, $3) } | AExpr '*' AExpr { AOp ("*", $1, $3) }
-- Boolean expressions (again, boring stuff).
BExpr : bool { Boolean $1 } BExpr : bool { Boolean $1 }
| AExpr '<' AExpr { BOp ("<", $1, $3) } | AExpr bop AExpr { BOp ($2, $1, $3) }
| AExpr '~' AExpr { BOp ("==", $1, $3) }
{ {
-- Error reporting function. This is where we actually use position
-- information that alex kindly provided us with.
parseError :: [Token] -> a parseError :: [Token] -> a
parseError ts = error ("Parse error at " ++ location ++ "\n") parseError ts = error ("Parse error at " ++ location ++ "\n")
where where
location = case ts of location = case ts of
[] -> "end of file" [] -> "end of file"
(t:_) -> "line " ++ show l ++ ", column " ++ show c (t:_) -> show l ++ ": " ++ show c
where AlexPn _ l c = pos t where AlexPn _ l c = pos t
} }
......
...@@ -5,95 +5,333 @@ import Imp_Parse ...@@ -5,95 +5,333 @@ import Imp_Parse
import Imp_State import Imp_State
import Imp_Evaluator import Imp_Evaluator
gen_ast = imp_parse . imp_lex -- Initial position (usefull for single token tests and more)
ip = AlexPn 0 1 1
-- Default state that we use in tests (x = 3, y = 6)
state = update (update emp "x" 3) "y" 6
-- Helpers for command evaluation testing
eval = eval_s emp eval = eval_s emp
eval_s s t = valof (evalCom s t) "x" eval_s s t = valof (evalCom s t) "x"
-- Parser's unit tests
main :: IO () main :: IO ()
main = hspec $ do main = hspec $ do
describe "imp_lex" $ do
it "ignores white space" $ do
[] `shouldBe` (imp_lex " ")
it "lexes left parenthesis" $ do
[LPAREN ip] `shouldBe` (imp_lex "(")
it "lexes right parenthesis" $ do
[RPAREN (AlexPn 1 1 2)] `shouldBe` (imp_lex " )")
it "lexes command separator" $ do
[DELIM ip] `shouldBe` (imp_lex ";")
it "lexes assignment operator" $ do
[ASSIGN ip] `shouldBe` (imp_lex ":=")
it "lexes +" $ do
[BINOP ip "+"] `shouldBe` (imp_lex "+")
it "lexes -" $ do
[BINOP ip "-"] `shouldBe` (imp_lex "-")
it "lexes *" $ do
[BINOP ip "*"] `shouldBe` (imp_lex "*")
it "lexes <" $ do
[BINOP ip "<"] `shouldBe` (imp_lex "<")
it "lexes ==" $ do
[BINOP ip "=="] `shouldBe` (imp_lex "==")
it "lexes if" $ do
[KEYWORD ip "if"] `shouldBe` (imp_lex "if")
it "lexes then" $ do
[KEYWORD ip "then"] `shouldBe` (imp_lex "then")
it "lexes else" $ do
[KEYWORD ip "else"] `shouldBe` (imp_lex "else")
it "lexes while" $ do
[KEYWORD ip "while"] `shouldBe` (imp_lex "while")
it "lexes do" $ do
[KEYWORD ip "do"] `shouldBe` (imp_lex "do")
it "lexes skip" $ do
[KEYWORD ip "skip"] `shouldBe` (imp_lex "skip")
it "lexes numbers" $ do
[NUM ip 453] `shouldBe` (imp_lex "453")
it "lexes boolean literals" $ do
[BOOL ip False, BOOL (AlexPn 6 1 7) True] `shouldBe`
(imp_lex "False True")
it "lexes location identifiers" $ do
[LOC (AlexPn 0 1 1 ) "_N_aM3"] `shouldBe` (imp_lex "_N_aM3")
it "lexes just about anything" $ do
[INVALID ip "="] `shouldBe` (imp_lex "=")
it "does not confuse keywords with locations" $ do
[LOC ip "Then", KEYWORD (AlexPn 5 1 6) "then"] `shouldBe`
(imp_lex "Then then")
describe "imp_parse" $ do describe "imp_parse" $ do
it "parses empty program as nop" $ do it "parses empty program as nop" $ do
gen_ast "" `shouldBe` imp_parse [] `shouldBe` Skip
Skip
it "parses skip" $ do it "parses skip" $ do
gen_ast "skip" `shouldBe` imp_parse [KEYWORD ip "skip"] `shouldBe` Skip
Skip
it "parses assignment and location" $ do it "parses assignment and location" $ do
gen_ast "x := x" `shouldBe` imp_parse [LOC ip "x", ASSIGN ip, LOC ip "x"] `shouldBe`
(Assign ("x", Loc "x")) (Assign ("x", Loc "x"))
it "parses numeric literal" $ do it "parses numeric literal" $ do
gen_ast "y := 4" `shouldBe` imp_parse [LOC ip "y", ASSIGN ip, NUM ip 4] `shouldBe`
(Assign ("y", Num 4)) (Assign ("y", Num 4))
it "parses addition" $ do it "parses addition" $ do
gen_ast "y := 3 + 2" `shouldBe` imp_parse [ LOC ip "y"
, ASSIGN ip
, NUM ip 3
, BINOP ip "+"
, NUM ip 2
] `shouldBe`
(Assign ("y", AOp ("+", Num 3, Num 2))) (Assign ("y", AOp ("+", Num 3, Num 2)))
it "parses sub" $ do it "parses sub" $ do
gen_ast "y := 3 - 2" `shouldBe` imp_parse [ LOC ip "y"
, ASSIGN ip
, NUM ip 3
, BINOP ip "-"
, NUM ip 2
] `shouldBe`
(Assign ("y", AOp ("-", Num 3, Num 2))) (Assign ("y", AOp ("-", Num 3, Num 2)))
it "parses addition" $ do it "parses multiplication" $ do
gen_ast "y := 3 * 2" `shouldBe` imp_parse [ LOC ip "y"
, ASSIGN ip
, NUM ip 3
, BINOP ip "*"
, NUM ip 2
] `shouldBe`
(Assign ("y", AOp ("*", Num 3, Num 2))) (Assign ("y", AOp ("*", Num 3, Num 2)))
it "parses while statement" $ do it "parses while statement" $ do
gen_ast "while True do skip" `shouldBe` imp_parse [ KEYWORD ip "while"
, BOOL ip True
, KEYWORD ip "do"
, KEYWORD ip "skip"
] `shouldBe`
(While (Boolean True, Skip)) (While (Boolean True, Skip))
it "parses boolean literals" $ do it "parses boolean literals" $ do
gen_ast "while True do while False do skip" `shouldBe` imp_parse [ KEYWORD ip "while"
, BOOL ip True
, KEYWORD ip "do"
, KEYWORD ip "while"
, BOOL ip False
, KEYWORD ip "do"
, KEYWORD ip "skip"
] `shouldBe`
(While (Boolean True, While (Boolean False, Skip))) (While (Boolean True, While (Boolean False, Skip)))
it "parses boolean expressions" $ do it "parses boolean expression <" $ do
gen_ast "while 3 < x do skip" `shouldBe` imp_parse [ KEYWORD ip "while"
, NUM ip 3
, BINOP ip "<"
, LOC ip "x"
, KEYWORD ip "do"
, KEYWORD ip "skip"
] `shouldBe`
(While (BOp ("<", Num 3, Loc "x"), Skip)) (While (BOp ("<", Num 3, Loc "x"), Skip))
it "parses boolean expression ==" $ do
imp_parse [ KEYWORD ip "while"
, NUM ip 3
, BINOP ip "=="
, LOC ip "x"
, KEYWORD ip "do"
, KEYWORD ip "skip"
] `shouldBe`
(While (BOp ("==", Num 3, Loc "x"), Skip))
it "parses nested expressions" $ do it "parses nested expressions" $ do
gen_ast "while 2 + x * 4 == 5 do skip" `shouldBe` imp_parse [ KEYWORD ip "while"
, NUM ip 2
, BINOP ip "+"
, LOC ip "x"
, BINOP ip "*"
, NUM ip 4
, BINOP ip "=="
, NUM ip 5
, KEYWORD ip "do"
, KEYWORD ip "skip"
] `shouldBe`
(While (BOp ("==", (While (BOp ("==",
AOp ("+", Num 2, AOp ("*", Loc "x", Num 4)), AOp ("+", Num 2, AOp ("*", Loc "x", Num 4)),
Num 5), Num 5),
Skip)) Skip))
it "parses nested expressions in assignment" $ do
imp_parse [ LOC ip "x"
, ASSIGN ip
, NUM ip 2
, BINOP ip "+"
, LOC ip "x"
, BINOP ip "*"
, NUM ip 4
, BINOP ip "-"
, NUM ip 3
, BINOP ip "*"
, NUM ip 2
, BINOP ip "-"
, NUM ip 3
, BINOP ip "*"
, LOC ip "a"
] `shouldBe`
(Assign ("x",
AOp ("-",
AOp ("-",
AOp ("+",
Num 2,
AOp ("*", Loc "x", Num 4)),
AOp ("*", Num 3, Num 2)),
AOp ("*", Num 3, Loc "a"))))
it "makes multiplication left associative" $ do it "makes multiplication left associative" $ do
gen_ast "x := 3 * 4 * 5" `shouldBe` imp_parse [ LOC ip "x"
, ASSIGN ip
, NUM ip 3
, BINOP ip "*"
, NUM ip 4
, BINOP ip "*"
, NUM ip 5
] `shouldBe`
(Assign ("x", AOp ("*", AOp ("*", Num 3, Num 4), Num 5))) (Assign ("x", AOp ("*", AOp ("*", Num 3, Num 4), Num 5)))
it "makes addition and subtraction left associative" $ do it "makes addition and subtraction left associative" $ do
gen_ast "x := 3 - 4 + 5" `shouldBe` imp_parse [ LOC ip "x"
, ASSIGN ip
, NUM ip 3
, BINOP ip "-"
, NUM ip 4
, BINOP ip "+"
, NUM ip 5
] `shouldBe`
(Assign ("x", AOp ("+", AOp ("-", Num 3, Num 4), Num 5))) (Assign ("x", AOp ("+", AOp ("-", Num 3, Num 4), Num 5)))
it "parses if statement" $ do it "parses if statement" $ do
gen_ast "if False then skip else skip" `shouldBe` imp_parse [ KEYWORD ip "if"
, BOOL ip False
, KEYWORD ip "then"
, KEYWORD ip "skip"
, KEYWORD ip "else"
, KEYWORD ip "skip"
] `shouldBe`
(Cond (Boolean False, Skip, Skip)) (Cond (Boolean False, Skip, Skip))
it "parses sequences" $ do it "parses sequences" $ do
gen_ast "skip ; skip" `shouldBe` imp_parse [ KEYWORD ip "skip"
, DELIM ip
, KEYWORD ip "skip"
] `shouldBe`
(Seq (Skip, Skip)) (Seq (Skip, Skip))
it "makes while eat as much as possible" $ do it "makes while eat as much as possible" $ do
gen_ast "skip ; while True do skip ; skip" `shouldBe` imp_parse [ KEYWORD ip "skip"
, DELIM ip
, KEYWORD ip "while"
, BOOL ip True
, KEYWORD ip "do"
, KEYWORD ip "skip"
, DELIM ip
, KEYWORD ip "skip"
] `shouldBe`
(Seq (Skip, While (Boolean True, Seq (Skip, Skip)))) (Seq (Skip, While (Boolean True, Seq (Skip, Skip))))
it "makes if eat as much commands as possible" $ do it "makes if eat as much commands as possible" $ do
gen_ast "if False then skip ; skip else skip ; skip" `shouldBe` imp_parse [ KEYWORD ip "if"
, BOOL ip False
, KEYWORD ip "then"
, KEYWORD ip "skip"
, DELIM ip
, KEYWORD ip "skip"
, KEYWORD ip "else"
, KEYWORD ip "skip"
, DELIM ip
, KEYWORD ip "skip"
] `shouldBe`
(Cond (Boolean False, (Cond (Boolean False,
Seq (Skip, Skip), Seq (Skip, Skip),
Seq (Skip, Skip))) Seq (Skip, Skip)))
it "makes inner while take over" $ do it "makes inner while take over" $ do
gen_ast "skip ; while True do skip ; while False do skip ; skip" imp_parse [ KEYWORD ip "skip"
`shouldBe` (Seq (Skip, , DELIM ip
While (Boolean True, , KEYWORD ip "while"
Seq (Skip, , BOOL ip True
While (Boolean False, , KEYWORD ip "do"
Seq (Skip, Skip)))))) , KEYWORD ip "skip"
, DELIM ip
, KEYWORD ip "while"
, BOOL ip False
, KEYWORD ip "do"
, KEYWORD ip "skip"
, DELIM ip
, KEYWORD ip "skip"
] `shouldBe`
(Seq (Skip,
While (Boolean True,
Seq (Skip,
While (Boolean False,
Seq (Skip, Skip))))))
it "properly handles nesting with parentheses" $ do it "properly handles nesting with parentheses" $ do
gen_ast "skip; (while True do skip) ; skip" `shouldBe` imp_parse [ KEYWORD ip "skip"
, DELIM ip
, LPAREN ip
, KEYWORD ip "while"
, BOOL ip True
, KEYWORD ip "do"
, KEYWORD ip "skip"
, RPAREN ip
, DELIM ip
, KEYWORD ip "skip"
] `shouldBe`
(Seq (Skip, (Seq (Skip,
Seq (While (Boolean True, Skip), Seq (While (Boolean True, Skip),
Skip))) Skip)))
it "properly handles nesting" $ do it "properly handles nesting" $ do
gen_ast ( imp_parse [ LPAREN ip
unlines [ "(if False " , KEYWORD ip "if"
, "then while False do skip ; skip " , BOOL ip False
, "else (while True do skip) ; skip);" , KEYWORD ip "then"
, "skip" , KEYWORD ip "while"
]