(*

An interpreter for the following little lambda language:

  M = N                           built-in numbers
    | M - M | M * M               built-in numeric ops
    | ifzero M then M else M      branch on zero
    | lam X.M                     function
    | X                           variable
    | (M M)                       function application

  N = <integer>
  X = <variable>

  Numbers can closed functions are values:

  V = N
    | lam X.M     where M's only free variable is X

  Values cannot be evaluated any further. Other expressions are reduced
  by re-writing:

    N1 - N2  ->  <the difference of N2 from N1>
    N1 * N2  ->  <the product N1 times N2>
    ifzero 0 then M1 else M2 ->   M1
    ifzero N then M1 else M2 ->   M2   if N is not 0
    ((lam X.M) V)  -> M with V replacing free Xs

  Also allow subexpression reductions, left to right:

    M1 - M2 -> M1' - M2   if M1 -> M1'
    V - M2 -> V - M2'     if M2 -> M2'
    (M1 M2) -> (M1' M2)   if M1 -> M1'
    (V M2) -> (V M2')     if M2 -> M2'
    ifzero M1 then M2 else M3 -> ifzero M1' then M2 else M3
                          if M1 -> M1'

*)

(*********** Datatypes ***********)

(* Values; we implement numbers with ML's numbers and
   functions with ML's functions: *)
type xval = Num of int
          | Fun of (xval -> xval)

(* Variables: *)
type xvar = string

(* Expressions: *)
type xpr = Value of xval
         | Minus of xpr * xpr
         | Times of xpr * xpr
         | Lam of xvar * xpr
         | Var of xvar
         | App of xpr * xpr
         | IfZero of xpr * xpr * xpr
;;

(*********** Examples ***********)

let five = Value(Num(5))
let protofac = Lam("f",
		   Lam("n",
		       IfZero(Var("n"),
			      Value(Num(1)),
			      Times(Var("n"),
				    App(App(Var("f"), Var("f")),
				        Minus(Var("n"),
					      Value(Num(1))))))))
let fac = App(protofac, protofac)
let onetwenty = App(fac, five)

;;

(*********** Evaluator ***********)

let rec
eval = function Value(v) -> v
              | Minus(m1, m2) -> let Num(n1) = eval(m1)
                                 and Num(n2) = eval(m2)
                                  in Num(n1 - n2)
              | Times(m1, m2) -> let Num(n1) = eval(m1)
                                 and Num(n2) = eval(m2)
                                  in Num(n1 * n2)
              | Lam(var, m) -> Fun(fun v -> eval(replace (var, v) m))
              | App(m1, m2) -> let Fun(f) = eval(m1)
                                in f(eval(m2))
              | IfZero(m1, m2, m3) -> let Num(n) = eval(m1)
                                       in eval(if (n=0)
						  then m2 
						  else m3)

and replace = fun (var, v) ->
 let rec
 r = function Value(v) -> Value(v)
            | Minus(m1, m2) -> Minus(r m1, r m2)
            | Times(m1, m2) -> Times(r m1, r m2)
            | Lam(fvar, m) -> Lam(fvar,
                                  if (fvar = var)
		  		     then m
				     else (r m))
            | App(m1, m2) -> App(r m1, r m2)
            | IfZero(m1, m2, m3) -> IfZero(r m1, r m2, r m3)
            | Var(var2) -> if (var = var2) then Value(v) else Var(var2)
 in r

;;

(*********** Example Evaluation ***********)

eval(onetwenty)

;;