(* Does you microprocessor have a `cons' operation? Mine doesn't. Here, we assume only a flat, integer-addressed memory. Everything is a number, but sometimes we choose to interpreter a number as a memory address, and sometimes we use it as a number for arithmetic. We define our own memory manager. It always allocates two machine words at a time (each word contains a single number). We only have `malloc' --- no `free', yet. *) 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 (* Same encoding as before: 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 *) 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) ;; (* Here's our memory manager. We have 10000 words in the `memory' array. The compiler produces a program that resides in this memory. *) let memory = Array.create 10000 0 let allocpos = ref 0 (* Allocates two words and returns the address of the first one: *) let malloc = function (a, d) -> let p = !allocpos in Array.set memory p a; Array.set memory (p+1) d; allocpos := (!allocpos + 2); p (* Gets the value at a memory location: *) let read = Array.get memory ;; (* The compiler produces the same lists as before, except instead of having Int and Cons, everything is just a number (which will be understood either as a number of as a memory address of a cons cell). The compiler's result is essentially the starting address of the compiled program in memory. *) let rec comp = function (Const(v), e) -> malloc(1, v) | (Minus(m1, m2), e) -> malloc(2, malloc(comp(m1, e), comp(m2, e))) | (Times(m1, m2), e) -> malloc(3, malloc(comp(m1, e), comp(m2, e))) | (Lam(var, m), e) -> malloc(4, comp(m, CExtend(var, e))) | (App(m1, m2), e) -> malloc(5, malloc(comp(m1, e), comp(m2, e))) | (IfZero(m1, m2, m3), e) -> malloc(6, malloc(comp(m1, e), malloc(comp(m2, e), comp(m3, e)))) | (Var(var), e) -> malloc(7, offset(var, e)) and offset = fun (var, CExtend(var2, e)) -> if (var = var2) then 0 else (1 + offset(var, e)) ;; (* All of the registers will contain numbers, now: *) let mReg = ref 0 and eReg = ref 0 and kReg = ref 0 and vReg = ref 0 ;; (* The `eval' part of interpreter looks at the `m' register, which is really a program pointer. It looks at the opcode at that address to decide what to do. We're not using ML's pattern matching at all. To get more information about an operation, we use `read' calls to manually walk through memory. *) let rec eval = function unit -> let e = !eReg and k = !kReg and p = !mReg in match (read p) with 1 -> vReg := read(p+1); kontinue() | 2 -> mReg := read(read(p+1)); kReg := malloc(1, malloc(read(read(p+1)+1), malloc(e, k))); eval() | 3 -> mReg := read(read(p+1)); kReg := malloc(2, malloc(read(read(p+1)+1), malloc(e, k))); eval() | 4 -> vReg := malloc(read(p+1), e); kontinue() | 5 -> mReg := read(read(p+1)); kReg := malloc(5, malloc(read(read(p+1)+1), malloc(e, k))); eval() | 6 -> mReg := read(read(p+1)); kReg := malloc(7, malloc(read(read(read(p+1)+1)), malloc(read(read(read(p+1)+1)+1), malloc(e, k)))); eval() | 7 -> vReg := lookup(read(p+1), e); kontinue() (* The `kontinue' looks at the `k' register, again an address that provides and opcode... *) and kontinue = function unit -> let p = !kReg and v = !vReg in match (read p) with 1 -> mReg := read(read(p+1)); eReg := read(read(read(p+1)+1)); kReg := malloc(3, malloc(v, read(read(read(p+1)+1)+1))); eval() | 2 -> mReg := read(read(p+1)); eReg := read(read(read(p+1)+1)); kReg := malloc(4, malloc(v, read(read(read(p+1)+1)+1))); eval() | 3 -> vReg := read(read(p+1)) - v; kReg := read(read(p+1)+1); kontinue() | 4 -> vReg := read(read(p+1)) * v; kReg := read(read(p+1)+1); kontinue() | 5 -> mReg := read(read(p+1)); eReg := read(read(read(p+1)+1)); kReg := malloc(6, malloc(v, read(read(read(p+1)+1)+1))); eval() | 6 -> mReg := read(read(read(p+1))); eReg := malloc(v, read(read(read(p+1))+1)); kReg := read(read(p+1)+1); eval() | 7 -> mReg := (if (v=0) then read(read(p+1)) else read(read(read(p+1)+1))); eReg := read(read(read(read(p+1)+1)+1)); kReg := read(read(read(read(p+1)+1)+1)+1); eval() | 0 -> v and lookup = function (0, p) -> read(p) | (n, p) -> lookup(n-1, read(p+1)) ;; mReg := comp(onetwenty,CEmpty); kReg := malloc(0, 0); eval() ;;