(* Microporcessors don't generally provide a collection of stuctures to be used by our interpreter. So now we want to get rid of all of the structures used by our interpreter. Instead, we assume that our target machine supports integers and cons cells. (In the next step, we go all the way to a flat memory model, but it's helpful to simplify to a Lisp-like memory model first.) *) type xvar = string 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 (* After compilation, everything is either a number or a cons cell. We implement the following variants by assigning a number to each one, and them implement the variant records as cons-based lists. and cxpr = CConst of int 1 | CMinus of cxpr * cxpr 2 | CTimes of cxpr * cxpr 3 | CLam of cxpr 4 | CApp of cxpr * cxpr 5 | CIfZero of cxpr * cxpr * cxpr 6 | CVar of int 7 and kont = Done 0 | KSubArg of cxpr * xenv * kont 1 | KMultArg of cxpr * xenv * kont 2 | KSub of xval * kont 3 | KMult of xval * kont 4 | KAppArg of cxpr * xenv * kont 5 | KApp of xval * kont 6 | KIfZero of cxpr * cxpr * xenv * kont 7 Our xenv has also gone away: it's just a list. *) type any = Int of int | Cons of any * any 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 now produces integer-tagged lists, instead of ML values: *) let rec comp = function (Const(v), e) -> Cons(Int(1), Int(v)) | (Minus(m1, m2), e) -> Cons(Int(2), Cons(comp(m1, e), comp(m2, e))) | (Times(m1, m2), e) -> Cons(Int(3), Cons(comp(m1, e), comp(m2, e))) | (Lam(var, m), e) -> Cons(Int(4), comp(m, CExtend(var, e))) | (App(m1, m2), e) -> Cons(Int(5), Cons(comp(m1, e), comp(m2, e))) | (IfZero(m1, m2, m3), e) -> Cons(Int(6), Cons(comp(m1, e), Cons(comp(m2, e), comp(m3, e)))) | (Var(var), e) -> Cons(Int(7), Int(offset(var, e))) and offset = fun (var, CExtend(var2, e)) -> if (var = var2) then 0 else (1 + offset(var, e)) ;; (* We have the same set of registers, but now they all contain a Int or Cons. *) let mReg = ref (Int 0) and eReg = ref (Int 0) and kReg = ref (Int 0) and vReg = ref (Int 0) ;; (* The `eval' part of the interpreter looks at the integer tag of the list in the `m' register to decide what to do. *) let rec eval = function unit -> let e = !eReg and k = !kReg in match (!mReg) with Cons(Int(1), v) -> vReg := v; kontinue() | Cons(Int(2), Cons(m1, m2)) -> mReg := m1; kReg := Cons(Int(1), Cons(m2, Cons(e, k))); eval() | Cons(Int(3), Cons(m1, m2)) -> mReg := m1; kReg := Cons(Int(2), Cons(m2, Cons(e, k))); eval() | Cons(Int(4), m) -> vReg := Cons(m, e); kontinue() | Cons(Int(5), Cons(m1, m2)) -> mReg := m1; kReg := Cons(Int(5), Cons(m2, Cons(e, k))); eval() | Cons(Int(6), Cons(m1, Cons(m2, m3))) -> mReg := m1; kReg := Cons(Int(7), Cons(m2, Cons(m3, Cons(e, k)))); eval() | Cons(Int(7), Int(n)) -> vReg := lookup(n, e); kontinue() (* The `kontinue' part of the interpreter looks at the integer tag of the list in the `k' register to decide what to do. *) and kontinue = function unit -> match (!vReg, !kReg) with (v, Cons(Int(1), Cons(m, Cons(e, k)))) -> mReg := m; eReg := e; kReg := Cons(Int(3), Cons(v, k)); eval() | (v, Cons(Int(2), Cons(m, Cons(e, k)))) -> mReg := m; eReg := e; kReg := Cons(Int(4), Cons(v, k)); eval() | (Int(n2), Cons(Int(3), Cons(Int(n1), k))) -> vReg := Int(n1 - n2); kReg := k; kontinue() | (Int(n2), Cons(Int(4), Cons(Int(n1), k))) -> vReg := Int(n1 * n2); kReg := k; kontinue() | (v, Cons(Int(5), Cons(m, Cons(e, k)))) -> mReg := m; eReg := e; kReg := Cons(Int(6), Cons(v, k)); eval() | (v, Cons(Int(6), Cons(Cons(m, e), k))) -> mReg := m; eReg := Cons(v, e); kReg := k; eval() | (Int(n), Cons(Int(7), Cons(m2, Cons(m3, Cons(e, k))))) -> mReg := (if (n=0) then m2 else m3); eReg := e; kReg := k; eval() | (v, Int(0)) -> v and lookup = function (0, Cons(v, e)) -> v | (n, Cons(v, e)) -> lookup(n-1, e) ;; mReg := comp(onetwenty,CEmpty); eval() ;;