Evaluator Code

Here is the sketch code of the evaluator that was written during the lecture. The point of the exercise is to show what is special about the C-machine: its steps match closely to the steps of a "reasonable" implementation of MinHS. By comparison, the steps of the M-machine are steps of an inefficient implementation, one that repeatedly performs syntactic substitutions.



-- Firstly, the syntax of MinHS taken from the week 4 demo code.

data BinOp = Plus | Minus | Times | Equals
  deriving (Show, Eq)

data Type = Bool | IntType | FunType Type Type
  deriving (Show, Eq)

data MinHS =
    Num Int
  | Lit Bool
  | If MinHS MinHS MinHS
  | BinOp BinOp MinHS MinHS
  | Apply MinHS MinHS
  -- For now we comment out the HOAS features so that we can derive
  -- a printer for MinHS syntax

  -- | RecFun Type Type (MinHS -> MinHS -> MinHS)
    -- Added as a bit of a hack to make the pretty-printer work
  -- | NameTag String
    -- Added as a bit of a hack to make the type-checker work
  -- | TypeTag Type
  deriving Show

-- Type for values being returned.
data Value =
    IntVal Int
  | BoolVal Bool
  -- | FunVal Type Type (MinHS -> MinHS -> MinHS)
  deriving Show

-- Type for "frames", partially-evaluated expressions.
data Frame =
    -- BinOp bop □ e2
    BinOp1 BinOp () MinHS
    -- BinOp bop e1 □
  | BinOp2 BinOp Value ()
    -- If □ e2 e3
  | If1 () MinHS MinHS
  deriving Show

-- Type of configuration of the C-machine.
data MachineConfig =
    EvalExpression MinHS [Frame]
  | ReturnValue Value [Frame]
  deriving Show

evalBinOp :: BinOp -> Value -> Value -> Value
evalBinOp Plus (IntVal n) (IntVal m) = IntVal (n + m)
evalBinOp bop v1 v2 = error ("evalBinOp: unimplemented: " ++ show bop)

-- The evaluator for the C-machine.
-- Note that this function doesn't recurse, and each step can be
-- performed in O(1) in principle.
evalMachine :: MachineConfig -> MachineConfig
evalMachine (ReturnValue v []) = error ("evalMachine: finished")
evalMachine (EvalExpression (Num n) st) = ReturnValue (IntVal n) st
-- Need to put BinOp bop □ e2 on the stack.
evalMachine (EvalExpression (BinOp bop e1 e2) st) =
    EvalExpression e1 (BinOp1 bop () e2 : st)
evalMachine (ReturnValue v1 (BinOp1 bop () e2 : st)) =
    EvalExpression e2 (BinOp2 bop v1 () : st)
evalMachine (ReturnValue v2 (BinOp2 bop v1 () : st)) =
    ReturnValue (evalBinOp bop v1 v2) st

-- Repeat evalMachine until a final state is found and
-- produce the whole trace of execution steps.
evalSteps :: MachineConfig -> [MachineConfig]
evalSteps (ReturnValue v []) = [ReturnValue v []]
evalSteps config = config : evalSteps (evalMachine config)


-- Roughly the example syntax from the slides.
example :: MinHS
example = BinOp Plus (BinOp Plus (Num 3) (Num 4)) (Num 5)

example_init = EvalExpression example []