(*

 A slight detour: In the same way that we're using ML's numbers to
 implement the numbers in our language, and ML's functions to implement
 the functions in our language, we *could* implement our compiler by
 relying on ML's compiler!

 This is called a closure compiler, because every source expression
 gets compiled into an ML closure (which is in turn compiled by the ML
 compiler).

*)

type xvar = string

type xval = Num of int
          | Fun of (xval -> xval)

type xenv = Empty
          | Extend of xval * xenv

type xpr = Const of int
         | Minus of xpr * xpr
         | Times of xpr * xpr
         | Lam of xvar * xpr
         | Var of xvar
         | App of xpr * xpr
         | IfZero of xpr * xpr * xpr

type cenv = CEmpty
          | CExtend of xvar * cenv

;;

(* The examples are unchanged *)

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

;;

(* The compiler compiles sub-expressions, and then returns a closure
   corresponding to the input expression: *)

let rec
comp = function (Const(v), e) -> (fun e -> Num(v))
              | (Minus(m1, m2), e) -> let cm1 = comp(m1, e)
                                      and cm2 = comp(m2, e)
                                       in (fun e -> let Num(n1) = (cm1 e)
                                                    and Num(n2) = (cm2 e)
                                                     in Num(n1 - n2))
              | (Times(m1, m2), e) -> let cm1 = comp(m1, e)
                                      and cm2 = comp(m2, e)
                                       in (fun e -> let Num(n1) = (cm1 e)
                                                    and Num(n2) = (cm2 e)
                                                     in Num(n1 * n2))
              | (Lam(var, m), e) -> let cm = comp(m, CExtend(var, e))
                                     in (fun e -> Fun(fun v -> (cm (Extend(v, e)))))
              | (App(m1, m2), e) -> let cm1 = comp(m1, e)
                                    and cm2 = comp(m2, e)
                                     in (fun e -> let Fun(f) = (cm1 e)
                                                   in (f (cm2 e)))
              | (IfZero(m1, m2, m3), e) -> let cm1 = comp(m1, e)
                                           and cm2 = comp(m2, e)
                                           and cm3 = comp(m3, e)
                                            in (fun e -> let Num(n) = (cm1 e)
                                                          in ((if (n=0) then cm2 else cm3) e))
              | (Var(var), e) -> let n = offset(var, e)
                                  in (fun e -> lookup(n, e))

and
offset = function (var, CExtend(var2, e)) -> 
                   if (var = var2) then 0 else (1 + offset(var, e))

and
lookup = function (0, Extend(v, e)) -> v
                | (n, Extend(v, e)) -> lookup(n-1, e)

;;

(* The interpreter now just runs the code, which has been compiled
   into an ML function: *)

let
eval = function (cm, e) -> (cm e)

;;

eval(comp(onetwenty,CEmpty), Empty)

;;