(* Back to the process of de-meta-izing our interpreter.... Let's not use ML's functions to implement our functions. *) type xvar = string (* Now, a function is a bytecode-environment pair: *) type xval = Num of int | Fun of cxpr * xenv and xenv = Empty | Extend of xval * xenv and 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 and cxpr = CConst of int | CMinus of cxpr * cxpr | CTimes of cxpr * cxpr | CLam of cxpr | CVar of int | CApp of cxpr * cxpr | CIfZero of cxpr * cxpr * cxpr 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 is unchanged *) let rec comp = function (Const(v), e) -> CConst(v) | (Minus(m1, m2), e) -> CMinus(comp(m1, e), comp(m2, e)) | (Times(m1, m2), e) -> CTimes(comp(m1, e), comp(m2, e)) | (Lam(var, m), e) -> CLam(comp(m, CExtend(var, e))) | (App(m1, m2), e) -> CApp(comp(m1, e), comp(m2, e)) | (IfZero(m1, m2, m3), e) -> CIfZero(comp(m1, e), comp(m2, e), comp(m3, e)) | (Var(var), e) -> CVar(offset(var, e)) and offset = fun (var, CExtend(var2, e)) -> if (var = var2) then 0 else (1 + offset(var, e)) ;; (* The interpreter handles CLam and CApp differently, showing explicitly how closures are created and applied. *) let rec eval = function (CConst(v), e) -> Num(v) | (CMinus(m1, m2), e) -> let Num(n1) = eval(m1, e) and Num(n2) = eval(m2, e) in Num(n1 - n2) | (CTimes(m1, m2), e) -> let Num(n1) = eval(m1, e) and Num(n2) = eval(m2, e) in Num(n1 * n2) | (CLam(m), e) -> Fun(m, e) | (CApp(m1, m2), e) -> let Fun(fm, fe) = eval(m1, e) in eval(fm, Extend(eval(m2, e), fe)) | (CIfZero(m1, m2, m3), e) -> let Num(n) = eval(m1, e) in eval((if (n=0) then m2 else m3), e) | (CVar(n), e) -> lookup(n, e) and lookup = function (0, Extend(v, e)) -> v | (n, Extend(v, e)) -> lookup(n-1, e) ;; eval(comp(onetwenty,CEmpty), Empty) ;;