(* Although we're no longer using ML functions to implement our functions, th interpreter still relies on the ML evaluator to handle nested and recursive calls for us. We make the control stack explicit, so that all interesting function calls in the interpreter could be implemented with `goto'. A `goto' is the level of support we could expect from a microprocessor. *) type xvar = string 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 (* A `kont' record is roughly like an activation frame. It remembers the work we need to do (i.e., how to "kontinue") once we finally get to a value. *) and kont = Done | KSubArg of cxpr * xenv * kont | KMultArg of cxpr * xenv * kont | KSub of xval * kont | KMult of xval * kont | KAppArg of cxpr * xenv * kont | KApp of xval * kont | KIfZero of cxpr * cxpr * xenv * kont 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)) ;; (* All of the recursive calls in the interpreter can be implemented with `goto'. The control stack has been reified as the `k' argument that is passed around. *) let rec eval = function (CConst(v), e, k) -> kontinue(Num(v), k) | (CMinus(m1, m2), e, k) -> eval(m1, e, KSubArg(m2, e, k)) | (CTimes(m1, m2), e, k) -> eval(m1, e, KMultArg(m2, e, k)) | (CLam(m), e, k) -> kontinue(Fun(m, e), k) | (CApp(m1, m2), e, k) -> eval(m1, e, KAppArg(m2, e, k)) | (CIfZero(m1, m2, m3), e, k) -> eval(m1, e, KIfZero(m2, m3, e, k)) | (CVar(n), e, k) -> kontinue(lookup(n, e), k) and kontinue = function (v, KSubArg(m, e, k)) -> eval(m, e, KSub(v, k)) | (v, KMultArg(m, e, k)) -> eval(m, e, KMult(v, k)) | (Num(n2), KSub(Num(n1), k)) -> kontinue(Num(n1 - n2), k) | (Num(n2), KMult(Num(n1), k)) -> kontinue(Num(n1 * n2), k) | (v, KAppArg(m, e, k)) -> eval(m, e, KApp(v, k)) | (v, KApp(Fun(m, e), k)) -> eval(m, Extend(v, e), k) | (Num(n), KIfZero(m2, m3, e, k)) -> eval((if (n=0) then m2 else m3), e, k) | (v, Done) -> v (* Well, there's a recursive call in `lookup', but with a machine-based value stack we'd expect to perform pointer arithmetic to access values directly. *) and lookup = function (0, Extend(v, e)) -> v | (n, Extend(v, e)) -> lookup(n-1, e) ;; eval(comp(onetwenty,CEmpty), Empty, Done) ;;