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 funval

	and funval = CLOSR of { lam: lambda, en: env }
		   | SC
		   | EQ1
		   | EQ2 of value

	and env = INIT
		| SIMP of { bvar: var, bval: value, old: env }
		| REC of { dvar: var, dexp: lambda, old: env }

	and cont = FIN
		 | EVOPN of { opnd: exp, en: env, next: cont }
		 | APFUN of { func: value, next: cont }
		 | BRANCH of { conc: exp, altr: exp, en: env, next: cont }

   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 get (INIT, "succ") = FUNv SC
     | get (INIT, "equal") = FUNv EQ1
     | get (INIT, x) = raise Fail ("unbound variable: " ^ x)
     | get (SIMP { bvar, bval, old }, x) =
         if x = bvar then bval else get (old, x)
     | get (e as REC { dvar, dexp, old }, x) =
         if x = dvar then FUNv (CLOSR { lam = dexp, en = e })
	 else get (old, x)

   fun eval (r, e, k) =
       case r of
	   CONST c => cont (k, evcon c)
	 | VAR v => cont (k, get (e, v))
	 | APPL { opr, opnd } =>
	     eval (opr, e, EVOPN { opnd = opnd, en = e, next = k })
	 | LAMBDA l => cont (k, FUNv (CLOSR { lam = l, en = e }))
	 | COND { prem, conc, altr } =>
	     eval (prem, e, BRANCH { conc = conc, altr = altr,
				     en = e, next = k })
	 | LETREC { dvar, dexp, body } =>
	     eval (body, REC { dvar = dvar, dexp = dexp, old = e }, k)

   and apply (CLOSR { lam = { fp, body }, en }, a, k) =
         eval (body, SIMP { bvar = fp, bval = a, old = en }, k)
     | apply (SC, x, k) = cont (k, INTv (vINT x + 1))
     | apply (EQ1, x, k) = cont (k, FUNv (EQ2 x))
     | apply (EQ2 x, y, k) = cont (k, equal (x, y))

    and cont (FIN, a) = a
      | cont (EVOPN { opnd, en, next }, a) =
	  eval (opnd, en, APFUN { func = a, next = next })
      | cont (APFUN { func, next }, a) = apply (vFUN func, a, next)
      | cont (BRANCH { conc, altr, en, next }, a) =
	  if vBOOL a then eval (conc, en, next) else eval (altr, en, next)

   val initenv = INIT

   fun interpret r = eval (r, initenv, FIN)
end