« Simplifying, Serializing and Lifting | Main | Gripes with SLinks Implementation »

Do CPS transformation on interpreter

I eventually grokked lambda-lifting and worked on some code for it but ultimately I wasn't getting what I wanted out of it.

The larger goal was to have a function from terms to terms: to convert them such that old term was now wrapped in a lambda, expecting a continuation. Phil convinced me this was bunk, since evaluating the new terms still happens according to the same process as the old ones.

The proper goal should have been to modify the *interpreter*. The interpreter, then, should evaluate terms *using* a continuation-passing style. Trying to modify the terms in-place was a bad idea, since it makes them harder to read, messes up the types, and may screw up some other stuff down the road. CPS should simplify things for us, not complicate them! So, I wrote up a lambda-calculus interpreter that uses the continuation-passing style. SML code for this is below.

datatype Term = Const of string | Var of string
              | Thing of string * Term
              | Lam of string * Term | App of Term * Term;

type Envir = (string * Term) list;

(* Kinds of continuations: *)
datatype Cont = FL of Term * Envir
              | Ylppa of Term * Envir;

fun subst(name, term) (Const x) = Const x
 | subst(name, term) (Var x) = if name = x then term else (Var x)
  | subst(name, term) (Lam(param, body)) =
        if name = param then
            Lam(param, body)
            Lam(param, subst(name, term) body)
  | subst(name, term) (App(f, a)) = App(subst(name, term) f,
                                        subst(name, term) a);

exception NoSuchVar of string;
exception NoSuchPrimitive of string;

fun lookup x [] = raise NoSuchVar x
  | lookup x ((vr, vl)::others) = if x = vr then vl else lookup x others;

load "Int";

fun const_apply "inc" (Const a) env = Const(Int.toString (1 +
                                           getOpt(Int.fromString a, 0)))
  | const_apply const (Lam l) env = Thing(const, Lam l)
  | const_apply const arg env = raise NoSuchPrimitive const;

fun appl_cont [] vl = vl
  | appl_cont (FL(t, env) :: rest) vl = eval t env (Ylppa(vl,env) :: rest)
  | appl_cont (Ylppa(t, env) :: rest) (Lam(p,b)) =
        eval b ((p, t)::env) rest
  | appl_cont (Ylppa(t, env) :: rest) (Const c) =
        appl_cont rest (const_apply c t env)

and eval (Const x) env cont = appl_cont cont (Const x)
  | eval (Var x) env cont = appl_cont cont (lookup x env)
    (* FLAW: this doesn't preserve the environment the Lam was evaluated in *)
  | eval (Lam(a, b)) env cont = appl_cont cont (Lam(a, b))  
  | eval (App(f, a)) env cont = eval a env (FL(f, env) :: cont);

fun tleval t = eval t [] []
   handle NoSuchPrimitive prim
        => (print("no such primitive " ^ prim);
            Const "dead");

Post a comment