So, I need to write a function evalS :: Statement -> Store -> Store that takes as input a statement and a store and returns a possibly modified store.
The following case has been given to me:
evalS w@(While e s1) s = case (evalE e s) of
(BoolVal True,s') -> let s'' = evalS s1 s' in evalS w s''
(BoolVal False,s') -> s'
_ -> error "Condition must be a BoolVal
And I need to write:
evalS Skip s = ...
evalS (Expr e) s = ...
evalS (Sequence s1 s2) s = ...
evalS (If e s1 s2) s = ...
In the If case, if e evaluates to a non-boolean value, I need to throw an error using the error function.
Sample input/output:
> run stmtParser "x=1+1" evalS
fromList [("x",2)]
> run stmtParser "x = 2; x = x + 3" evalS
fromList [("x",5)]
> run stmtParser "if true then x = 1 else x = 2 end" evalS
fromList [("x",1)]
> run stmtParser "x=2; y=x + 3; if y < 4 then z = true else z = false end" evalS
fromList [("x",2),("y",5),("z",false)]
> run stmtParser "x = 1; while x < 3 do x = x + 1 end" evalS
fromList [("x",3)]
> run stmtParser "x = 1 ; y = 1; while x < 5 do x = x + 1 ; y = y * x end" evalS
fromList [("x",5),("y",120)]
Code for stmtParser:
-- Sequence of statements
stmtParser :: Parser Statement
stmtParser = stmtParser1 `chainl1` (P.semi lexer >> return Sequence)
-- Single statements
stmtParser1 :: Parser Statement
stmtParser1 = (Expr <$> exprParser)
<|> do
P.reserved lexer "if"
cond <- exprParser
P.reserved lexer "then"
the <- stmtParser
P.reserved lexer "else"
els <- stmtParser
P.reserved lexer "end"
return (If cond the els)
<|> do
P.reserved lexer "while"
cond <- exprParser
P.reserved lexer "do"
body <- stmtParser
P.reserved lexer "end"
return (While cond body)
WHAT I'VE TRIED:
I am not sure if I need to use evalE in this problem or not. I have written it in a previous problem. The signature for evalE is evalE :: Expression -> Store -> (Value, Store) and asked me to write:
evalE (Var x) s = ...
evalE (Val v) s = ...
evalE (Assignment x e) s = ...
I have done the above, already.
ATTEMPT:
evalS Skip s = show s -- I am assuming that since Skip returns an empty String, I just need to return an empty String.
evalS (Sequence s1 s2) s = evalS s1 >> evalS s2 -- sequence1 then sequence2. I am not quite sure what to do with the s.
evalS (Expr e) s = ... Not sure what to do, here.
evalS (If e s1 s2) s = do
x <- evalE e
case x of
BoolVal True -> evalS s1
BoolVal False -> evalS s2
I am having trouble writing the above statements.
For reference, here is the entire skeleton that was given to me to work with:
-- Necessary imports
import Control.Applicative ((<$>),liftA,liftA2)
import Data.Map
import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.Language (emptyDef)
import Text.Parsec.String (Parser)
import qualified Text.Parsec.Token as P
--------- AST Nodes ---------
-- Variables are identified by their name as string
type Variable = String
-- Values are either integers or booleans
data Value = IntVal Int -- Integer value
| BoolVal Bool -- Boolean value
-- Expressions are variables, literal values, unary and binary operations
data Expression = Var Variable -- e.g. x
| Val Value -- e.g. 2
| BinOp Op Expression Expression -- e.g. x + 3
| Assignment Variable Expression -- e.g. x = 3
-- Statements are expressions, conditionals, while loops and sequences
data Statement = Expr Expression -- e.g. x = 23
| If Expression Statement Statement -- if e then s1 else s2 end
| While Expression Statement -- while e do s end
| Sequence Statement Statement -- s1; s2
| Skip -- no-op
-- All binary operations
data Op = Plus -- + :: Int -> Int -> Int
| Minus -- - :: Int -> Int -> Int
| Times -- * :: Int -> Int -> Int
| GreaterThan -- > :: Int -> Int -> Bool
| Equals -- == :: Int -> Int -> Bool
| LessThan -- < :: Int -> Int -> Bool
-- The `Store` is an associative map from `Variable` to `Value` representing the memory
type Store = Map Variable Value
--------- Parser ---------
-- The Lexer
lexer = P.makeTokenParser (emptyDef {
P.identStart = letter,
P.identLetter = alphaNum,
P.reservedOpNames = ["+", "-", "*", "!", ">", "=", "==", "<"],
P.reservedNames = ["true", "false", "if", "in", "then", "else", "while", "end", "to", "do", "for"]
})
-- The Parser
-- Number literals
numberParser :: Parser Value
numberParser = (IntVal . fromIntegral) <$> P.natural lexer
-- Boolean literals
boolParser :: Parser Value
boolParser = (P.reserved lexer "true" >> return (BoolVal True))
<|> (P.reserved lexer "false" >> return (BoolVal False))
-- Literals and Variables
valueParser :: Parser Expression
valueParser = Val <$> (numberParser <|> boolParser)
<|> Var <$> P.identifier lexer
-- -- Expressions
exprParser :: Parser Expression
exprParser = liftA2 Assignment
(try (P.identifier lexer >>= (\v ->
P.reservedOp lexer "=" >> return v)))
exprParser
<|> buildExpressionParser table valueParser
where table = [[Infix (op "*" (BinOp Times)) AssocLeft]
,[Infix (op "+" (BinOp Plus)) AssocLeft]
,[Infix (op "-" (BinOp Minus)) AssocLeft]
,[Infix (op ">" (BinOp GreaterThan)) AssocLeft]
,[Infix (op "==" (BinOp Equals)) AssocLeft]
,[Infix (op "<" (BinOp LessThan)) AssocLeft]]
op name node = (P.reservedOp lexer name) >> return node
-- Sequence of statements
stmtParser :: Parser Statement
stmtParser = stmtParser1 `chainl1` (P.semi lexer >> return Sequence)
-- Single statements
stmtParser1 :: Parser Statement
stmtParser1 = (Expr <$> exprParser)
<|> do
P.reserved lexer "if"
cond <- exprParser
P.reserved lexer "then"
the <- stmtParser
P.reserved lexer "else"
els <- stmtParser
P.reserved lexer "end"
return (If cond the els)
<|> do
P.reserved lexer "while"
cond <- exprParser
P.reserved lexer "do"
body <- stmtParser
P.reserved lexer "end"
return (While cond body)
-------- Helper functions --------
-- Lift primitive operations on IntVal and BoolVal values
liftIII :: (Int -> Int -> Int) -> Value -> Value -> Value
liftIII f (IntVal x) (IntVal y) = IntVal $ f x y
liftIIB :: (Int -> Int -> Bool) -> Value -> Value -> Value
liftIIB f (IntVal x) (IntVal y) = BoolVal $ f x y
-- Apply the correct primitive operator for the given Op value
applyOp :: Op -> Value -> Value -> Value
applyOp Plus = liftIII (+)
applyOp Minus = liftIII (-)
applyOp Times = liftIII (*)
applyOp GreaterThan = liftIIB (>)
applyOp Equals = liftIIB (==)
applyOp LessThan = liftIIB (<)
-- Parse and print (pp) the given WHILE programs
pp :: String -> IO ()
pp input = case (parse stmtParser "" input) of
Left err -> print err
Right x -> print x
-- Parse and run the given WHILE programs
run :: (Show v) => (Parser n) -> String -> (n -> Store -> v) -> IO ()
run parser input eval = case (parse parser "" input) of
Left err -> print err
Right x -> print (eval x empty)