Note: this is the stubbed version of module TransExercise. You should download the lhs version of this module and replace all parts marked undefined. Eventually, the complete version will be made available.

In class exercise: TransExercise

> {-# LANGUAGE FlexibleContexts #-}
> {-# OPTIONS -Wincomplete-patterns #-}
> module TransExercise where

This exercise involves using monad transformers to extend your interpreter for the simple imperative While programming language.

You'll need a few additional modules for this exercise, which you will need to make sure that you also have available.

For simplicity, we define the syntax of this extended language in a separate file.
The test case try.imp demonstrates the syntax for exceptions in the extended language.
You'll also need Parser and ParserCombinator from your past homework assignment.

> import WhileExn

> import Data.Map (Map)
> import qualified Data.Map as Map

> import Control.Applicative
> import Control.Monad (liftM, liftM2)

This exercise will give you practice with the MonadState and MonadError type classes and the StateT and ExceptT monad transformers that were introduced in the Transformers lecture. These definitions come from the mtl library.

> import Control.Monad.State (MonadState(..), StateT, State, runState, runStateT)
> import Control.Monad.Except (MonadError(..), ExceptT, runExceptT)

> import Test.HUnit hiding (State)

Expression Evaluator

First, make sure that you understand how the expression evaluator works. Then, look at the inferred type of evalE in ghci.

> type Store = Map Variable Value

> evalE (Var x)      = do
>   m <- get
>   case (Map.lookup x m) of
>     Just v ->  return v
>     Nothing -> return (IntVal 0)
> evalE (Val v)      = return v
> evalE (Op e1 o e2) = evalOp o <$> evalE e1 <*> evalE e2

> evalOp :: Bop -> Value -> Value -> Value
> evalOp Plus   (IntVal i1) (IntVal i2) = IntVal (i1 + i2)
> evalOp Minus  (IntVal i1) (IntVal i2) = IntVal (i1 - i2)
> evalOp Times  (IntVal i1) (IntVal i2) = IntVal (i1 * i2)
> evalOp Divide (IntVal _ ) (IntVal 0)  = IntVal 0
> evalOp Divide (IntVal i1) (IntVal i2) = IntVal (i1 `div` i2)
> evalOp Gt     (IntVal i1) (IntVal i2) = BoolVal (i1 > i2)
> evalOp Ge     (IntVal i1) (IntVal i2) = BoolVal (i1 >= i2)
> evalOp Lt     (IntVal i1) (IntVal i2) = BoolVal (i1 < i2)
> evalOp Le     (IntVal i1) (IntVal i2) = BoolVal (i1 <= i2)
> evalOp _ _ _ = IntVal 0

Next, modify evalOp and evalE so that it uses throwError (from the MonadError class) for runtime errors
- in the case of divide by zero, use IntVal 1 as the error code
- in the case of invalid args to the operator, use IntVal 2
- use code IntVal 0 for undefined variables.

Running and Testing the expression evaluator

To test the expression evaluator we have to pick a specific monad to use; one that satisfies both MonadState and MonadError constraints.

We can construct this monad easily by layering the exception monad on top of the usual State monad.

> type M = ExceptT Value (State Store)

Now we can run expressions that may throw errors!

> executeE :: Expression -> Store -> (Either Value Value, Store)
> executeE e st = runState (runExceptT comp) st where
>     comp :: M Value
>     comp = evalE e

We can display the errors nicely for experimentation in ghci with this function. (The display function is defined at the end of the file).

> runE :: Expression -> IO ()
> runE e = putStrLn $ display (fst (executeE e Map.empty))

For example, try these out:

  ghci> runE (Op  (Val (IntVal 1)) Divide (Val (IntVal 0)))
  Uncaught exception: Divide by zero

  ghci> runE (Op  (Val (IntVal 1)) Divide (Val (IntVal 1)))
  Result: IntVal 1

We can also write tests that expect a particular execution to raise a particular error.

> raisesE :: Expression -> Value -> Test
> s `raisesE` v = case (executeE s Map.empty) of
>    (Left v',_) -> v ~?= v'
>    _            -> TestCase $ assertFailure "Error in raises"

Make sure that your implementation above passes these tests.

> test_undefined :: Test
> test_undefined = "undefined variable" ~:
>   ((Var "Y") `raisesE` IntVal 0)

> test_divByZero :: Test
> test_divByZero = "divide by zero" ~:
>   ((Op  (Val (IntVal 1)) Divide (Val (IntVal 0))) `raisesE` IntVal 1)

> test_badPlus :: Test
> test_badPlus = "bad arg to plus" ~:
>   (Op (Val (IntVal 1)) Plus (Val (BoolVal True))) `raisesE` IntVal 2

> test_expErrors :: Test
> test_expErrors = "undefined variable & division by zero" ~:
>   TestList [ test_undefined, test_divByZero, test_badPlus ]

Statement Evaluator

Now modify the statement evaluator so that it throws errors Use code (IntVal 3) for integer conditions in While and (IntVal 4) for integer conditions in If statements. (Ignore the cases for Try and Throw for now.)

> evalS :: (MonadError Value m, MonadState Store m) => Statement -> m ()
> evalS w@(While e (Block ss))    = do
>   v <- evalE e
>   case v of
>     BoolVal True  -> evalB (Block (ss ++ [w]))
>     BoolVal False -> return ()
>     IntVal  _     -> return ()
> evalS (Assign x e)     = do
>     v <- evalE e
>     m <- get
>     put (Map.insert x v m)
> evalS (If e b1 b2)      = do
>     v <- evalE e
>     case v of
>       BoolVal True  -> evalB b1
>       BoolVal False -> evalB b2
>       IntVal  _     -> return ()
> evalS (Try _ _ _)   = error "evalS: unimplemented"
> evalS (Throw _)     = error "evalS: unimplemented"

> 
> evalB (Block ss) = mapM_ evalS ss

Statement Execution, finish this

> execute :: Block -> Store -> (Either Value (), Store)
> execute b st = undefined

Try out your execute with this operation:

> run :: Block -> IO ()
> run block = do let (r, s) = execute block Map.empty
>                putStrLn (display r)
>                putStr "Output Store: "
>                putStrLn (show s)

For example:

         ghci> run $ Block [While (Val (IntVal 0)) (Block [])]
         Uncaught exception: Invalid condition in while statement
         Output Store: fromList []

Test your functions with this helper

> raises :: Block -> Value -> Test
> s `raises` v = case (execute s Map.empty) of
>    (Left v',_) -> v ~?= v'
>    _            -> TestCase $ assertFailure "Error in raises"

and these tests:

> test_badWhile :: Test
> test_badWhile = Block [While (Val (IntVal 0)) (Block [])] `raises` IntVal 3

> test_badIf :: Test
> test_badIf = Block [If (Val (IntVal 0)) (Block []) (Block [])] `raises` IntVal 4

Add user-level exceptions.

There are two new statement forms in this language. Extend the evaluator above so that it can handle them.

Throw e should evaluate the expression e and an exception carrying the value of e
Try s x h should execute the statement s and if, in the course of execution, an exception is thrown, then the exception value should be assigned to the variable x after which the handler statement h is executed.

Note: the catchError function in Control.Monad.Except will be necessary for Try statements.

For example, this code

> test1 = do
>   mb  <- parse "try.imp"
>   case mb of
>     Right b -> run b
>     Left _  -> putStrLn "parse error"

Should print

   Result: Right ()
   Output Store: fromList [("a",IntVal 100),("e",IntVal 1),("x",IntVal 0),("y",IntVal 1),("z",IntVal 101)]

Displaying the results

> display :: Show a => (Either Value a) -> String
> display (Left v)  = "Uncaught exception: " ++ displayExn v
> display (Right v) = "Result: " ++ show v

> displayExn :: Value -> String
> displayExn (IntVal 0) = "Undefined variable"
> displayExn (IntVal 1) = "Divide by zero"
> displayExn (IntVal 2) = "Invalid arguments to operator"
> displayExn (IntVal 3) = "Invalid condition in while statement"
> displayExn (IntVal 4) = "Invalid condition in if statement"
> displayExn v          = "Error code: " ++ show v

CIS 552: Advanced Programming

Fall 2019

In class exercise: TransExercise

Expression Evaluator

Running and Testing the expression evaluator

Statement Evaluator

Displaying the results