structure DefInt = struct

    type var = string

   datatype const = INT of int
		  | BOOL of bool

   datatype exp = CONST of const
		| VAR of var
		| APPL of { opr: exp, opnd: exp }
		| LAMBDA of lambda
		| COND of { prem: exp, conc: exp, altr: exp }
		| LETREC of { dvar: var, dexp: lambda, body: exp }

   withtype lambda = { fp: var, body: exp }

   datatype value = INTv of int
		  | BOOLv of bool
		  | FUNv of value -> value

   type env = var -> value
   fun ext (z, a, e) = fn x => if x = z then a else e x

   fun vINT (INTv i) = i | vINT _ = raise Fail "integer expected"
   fun vBOOL (BOOLv b) = b | vBOOL _ = raise Fail "boolean expected"
   fun vFUN (FUNv f) = f | vFUN _ = raise Fail "function expected"

   fun equal (INTv i, INTv j) = BOOLv (i = j)
     | equal (BOOLv x, BOOLv y) = BOOLv (x = y)
     | equal _ = raise Fail "illegal arguments to equal"

   fun evcon (INT i) = INTv i
     | evcon (BOOL b) = BOOLv b

   fun eval (r, e) =
       case r of
	   CONST c => evcon c
	 | VAR v => e v
	 | APPL { opr, opnd } => vFUN (eval (opr, e)) (eval (opnd, e))
	 | LAMBDA l => evlam (l, e)
	 | COND { prem, conc, altr } => if vBOOL (eval (prem, e))
					then eval (conc, e)
					else eval (altr, e)
	 | LETREC { dvar, dexp, body } =>
	     let fun e' x = if x = dvar then evlam (dexp, e') else e x
	     in eval (body, e')
	     end

   and evlam ({ fp, body }, e) =
       FUNv (fn a => eval (body, ext (fp, a, e)))

   fun initenv "succ" = FUNv (fn x => INTv (vINT x + 1))
     | initenv "equal" = FUNv (fn x => FUNv (fn y => equal (x, y)))
     | initenv x = raise Fail ("unbound variable: " ^ x)

   fun interpret r = eval (r, initenv)
end