2

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)

2 Answers 2

6

It's a little difficult to answer your question, because you didn't actually ask one. Let me just pick out a few of the things that you've said, in order to give you a few clues.

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)

evalS (Expr e) s = ... Not sure what to do, here.

What does it mean to execute a statement which consists of an expression? If it has something to do with evaluating the expression, then the fact that you have an expression evaluator available might help with "what to do, here".

Next, compare the code you've been given for "while" (which contains a fine example of a sensible thing to do with an expression, by the way)...

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 compare it with your code for "if"

evalS (If e s1 s2) s     = do
   x <- evalE e
   case x of
      BoolVal True -> evalS s1
      BoolVal False -> evalS s2

Your code is in a rather different style — the "monadic" style. Where are you getting that from? It would make sense if the types of the evaluators were something like

evalE :: Expression -> State Store Value
evalS :: Statement  -> State Store ()

The monadic style is a very nice way to thread the mutating store through the evaluation process without talking about it too much. E.g., your x <- evalE e means "let x be the result of evaluating e (quietly receiving the initial store and passing along the resulting store)". It's a good way to work which I expect you'll explore in due course.

But those aren't the types you've been given, and the monadic style is not appropriate. You have

evalE :: Expression -> Store -> (Value, Store)
evalS :: Statement  -> Store ->         Store

and the example code threads the store explicitly. Look again

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"

See? evalS receives its initial store, s, explicitly, and uses it explicitly in evalE e s. The resulting new store is called s' in both case branches. If the loop is over, then s' is given back as the final store. Otherwise, s' is used as the store for one pass through the loop body, s1, and the store s'' resulting from that is used for the next time around the loop, w.

Your code will need to be similarly explicit in the way it names and uses the store at each stage of evaluation. Let's walk through.

evalS Skip s             = show s -- I am assuming that since Skip returns an empty String, I just need to return an empty String.

You assume incorrectly. The evalS function does not return a String, empty or otherwise: it returns a Store. Now, which Store? Your initial store is s: how will the store after "skip" relate to s?

evalS (Sequence s1 s2) s = evalS s1 >> evalS s2 -- sequence1 then sequence2. I am not quite sure what to do with the s.

Again, that's a monadic approach which does not fit with this question. You need to thread the store, intially s, through the process of evaluating statements s1 and s2 in sequence. The "while" case has a good example of how to do something like that.

evalS (Expr e) s         = ... Not sure what to do, here.

Again, the "while" example shows you one way to extract a value and an updated store by evaluating an expression. Food for thought, isn't it?

evalS (If e s1 s2) s     = ...

Now "if" starts out by evaluating a condition, rather a lot like "while", no?

So, my advice amounts to this:

  • drop the monadic style code for now, but come back to it later when it's appropriate;
  • read the example implementation of "while" and understand how it treats expressions and sequences of statements, passing the store explicitly;
  • deploy the similar techniques to implement the other constructs.

The person who set the question has been kind enough to give you code which gives an example of everything you will need. Please reciprocate that kindness by comprehending and then taking the hint!

Sign up to request clarification or add additional context in comments.

Comments

0

Since this looks as homework I'll just provide a few small hints, leaving the real work for you.

I am not sure if I need to use evalE in this problem or not.

Yes, you'll have to. In your language, an expression e modifies the store and returns a value: you can tell that from evalE returning a pair (Value,Store) By comparison, the statement Expr e modifies the store without returning a value. To obtain the latter (statement evaluation) from the former (expression) all you need to do is to throw away what you do not need.

About your attempt:

evalS Skip s             = show s -- I am assuming that since Skip returns an empty String, I just need to return an empty String.

Why a string? Does evalS return strings? If not, what it returns? You are doing far more work than you have to, here.

evalS (Sequence s1 s2) s = evalS s1 >> evalS s2 -- sequence1 then sequence2. I am not quite sure what to do with the s.

OK, the idea is right but the code is not. Forget about monads and >>, just think about the stores. You make two recursive calls evalS s1 and evalS s2: these look wrong because evalS expects two arguments (statement and store), and you only provide one.

And -- before you try it -- no, passing s to both of them would still be wrong. In which store is the first statement evaluated? What about the second?

evalS (Expr e) s         = ... Not sure what to do, here.

See the discussion above.

evalS (If e s1 s2) s     = do
   x <- evalE e
   case x of
      BoolVal True -> evalS s1
      BoolVal False -> evalS s2

Avoid monad-related operations, do and <-. There might be a way to use those to solve this task, but I'd not recommend to try that path to a beginner. You can use let if you want to name intermediate results.

evalE takes two arguments, not one. Mind that it returns a pair, not a value. evalS takes two arguments.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.