evaluatorの再帰実装→CPS化→Continuationのde-functionalize→ループ化

プログラミング言語のインタプリタを実装するとき、構文木にあわせて再帰で書くほうが基本的に楽だ。しかし、多くの実装で再帰呼び出しは回数に制限があったり処理が遅かったりする。そこで、再帰呼び出し型のevalをループで記述する動機ができる。ただ、いきなりループで書こうとすると、インタプリタコードがわけわからなくなるし、バグも入りやすい。

そこでループを作る戦略として、

• 再帰呼び出しで実装
• 再帰呼び出しのContinuation Passing Style(CPS)化
  • CPS形式は末尾呼び出し形式でもある
• Continuationのde-functionalize、つまりContinuationの関数表現をデータオブジェクトであらわす
  • クロージャを明示的なデータオブジェクトにする
• 末尾呼び出し関数のループ化

こうすれば、ループ形式インタプリタも素直に対応付けができる。クロージャも使わないので、Javaとかでも実装しやすいかも。

実装言語はjavascript。ここでの対象言語は形無しラムダ式＋定数(JavaScriptオブジェクト)。

言語仕様

言語は、関数(EFunc)と関数適用(ECall)と変数(EVar)で構成される単純形無しラムダ式に、JavaScriptオブジェクトにあたる定数(EVal)を加えたもの。

// AST expr
EFunc = function EFunc(param, body) {
  this.param = param;
  this.body = body;
};

ECall = function ECall(func, arg) {
  this.func = func;
  this.arg = arg;
};

EVar = function EVar(name) {
  this.name = name;
};

EVal = function EVal(value) {
  this.value = value;
}

言語の構文木は、以下の例のように書く。

// (\n->n) 10
new ECall(new EFunc("n", new EVar("n")), new EVal(10))

構文糖

関数は引数は確実にひとつになっているし、変数定義もない。そこで複数引数や変数定義に対応した構文糖を用意してみた。

sfunc = function sfunc(params, body) {
  if (params.length == 1) return new EFunc(params[0], body);
  var param = params[0];
  var params = params.slice(1);
  return new EFunc(param, sfunc(params, body));
};
scall = function scall(func, args) {
  if (args.length == 1) return new ECall(func, args[0]);
  var arg = args[args.length-1];
  var args = args.slice(0, args.length-1);
  return new ECall(scall(func, args), arg);
};
slet = function slet(name, value, body) {
  return new ECall(new EFunc(name, body), value);
};
svar = function svar(name) {
  return new EVar(name);
};
sval = function sval(value) {
  return new EVal(value);
};
sunit = function sunit() {
  return EVal(undefined);
};

これを使うと以下のような例がかける。

// k = \x->\y->x; k 10 20
slet("k", sfunc(["x", "y"], svar("x")), 
     scall(svar("k"), [sval(10), sval(20)]))

これも引数なしは対応してないし、再帰関数もかけないが、そのへんは主題ではないのでこのあたりでとめておく。(引数なし関数は、関数は暗黙の引数を必ず一つ持ち、適用時は余計な引数(たとえばunit)を渡すようにすることで可能。再帰関数や相互呼び出しはyコンビネータにあたる構文(ERec(name, body)とか)を追加する)

再帰版evaluator

データ構造の定義

evaluatorを作るにあたり、式を評価した結果としての「値」と、それらの値を引数として保持する「環境(フレーム)」をまず用意する。

Env = function Env(parent) {
  this.vars = {};
  this.parent = parent;
  this.put = function put(name, value) {
    this.vars[name] = value;
  };
  this.get = function get(name) {
    if (this.vars.hasOwnProperty(name)) {
      return this.vars[name];
    } else {
      if (this.parent == null) {
        debug("var not found: " + name);
        return sunit();
      }
      return this.parent.get(name);
    }
  };
};

// Value
VVal = function VVal(value) {
  this.value = value;
};

VFunc = function VFunc(env, param, body) {
  this.env = env;
  this.param = param;
  this.body = body;
};

環境は継承機能つき辞書。この言語の場合、値は定数と関数の二タイプにしている。

再帰版evaluator

再帰版evaluator

// version 1: naive evaluator
simpleEvaluate = function simpleEvaluate(expr, env) {
  if (expr instanceof EFunc) {
    return new VFunc(env, expr.param, expr.body);
  }
  if (expr instanceof ECall) {
    var func = simpleEvaluate(expr.func, env);
    // ToBe Lazy: func = eager(func)
    var arg = simpleEvaluate(expr.arg, env);
    // ToBe Lazy: arg = new VLazy(expr.arg, env);
    if (func instanceof VFunc) {
      var newEnv = new Env(func.env);
      newEnv.put(func.param, arg);
      //debug(func.param + "=" + arg);
      return simpleEvaluate(func.body, newEnv);
    } else if (func instanceof VVal) {
      return valueApply(func, arg);
    }
  }
  if (expr instanceof EVar) {
    return env.get(expr.name);
  }
  if (expr instanceof EVal) {
    return new VVal(expr.value);
  }
};

evaluatorは各構文要素で振り分け、それぞれにあった処理をして値を返す。この型は evaluator::Expr->Env->Value になる。ECallのように構文要素でメンバーに要素を持つものは、再帰的にevaluatorを適用してその結果を使うことになる。EFuncは、値として環境を保持させたVFuncを返すだけである。一方ECallでは、そのVFuncで保持させた環境に引数を追加してボディの式を実行するものになる。これがレキシカルスコープの実現になっている。VFuncの環境ではなく、evaluatorに渡った環境を親環境として使うと、ダイナミックスコープになる。環境の実装しだいで、両方見るような実装も作れる。

(ToDo Lazyコメントはnon-strictな評価で実装するときの変更点)

unboxing

ECallの評価では、関数がVFuncのときと、定数VValのときがある。VValのときはjavascript関数が入っていてそれを呼び出す仕組みが必要になる。以下はその仕組み。

// unboxing
valueApply = function valueApply(func, arg) {
  var funcObj = func.value;
  if (typeof funcObj != "function") {
    return func;
  }
  if (funcObj.length > 1) {
    funcObj = curry(funcObj, []);
  }
  var funcArg = lambda2Js(arg);
  // ToBe Lazy: funcArg = function () { return lambda2Js(arg); }
  return new VVal(funcObj(funcArg));
};
lambda2Js = function lambda2Js(value) {
  // ToBe Lazy: value = eager(value);
  if (value instanceof VVal) {
    return value.value;
  } else if (value instanceof VFunc) {
    return function lambdaFunc(arg) {
      var func = new EFunc(value.param, value.body);
      var expr = new ECall(func, new EVal(arg));
      var ret = runEvaluator(expr, value.env);
      return lambda2Js(ret);
    };
  }
};

valueApplyでは、引数側はVValかVFuncであり、それをjavascriptのオブジェクトにしてjavascript関数にわたす必要がある。VValのときは中に入ってるものになり、VFuncのときはfunctionにして渡してやる。VFuncからjavascriptのfunctionにするには、単に引数からEVal、VFuncが持つ式と環境を使ってECallを作り、evaluatorを呼び出して、その結果を再帰的にjavascriptオブジェクトにすればいい。

ちなみに以降の変換では、valueApplyやこの中のrunEvaluatorの書き換えまでは行っていないが、これもevaluatorの書き換えと同様に行える。

再帰版→CPS版への書き換え

CPS版のevaluatorの型は第三引数にContinuation関数を受け取るExpr->Env->Cont->Valueになる。Cont型は前の結果を受け取って最終結果を返す関数Value->Valueだ。

段階1: 関数引数の変更書き換え

まず、関数をcpsEvaluate(expr, env, cont)に書き換える。

// 未完成: 引数contの追加のみ
cpsEvaluate = function cpsEvaluate(expr, env, cont) {
  if (expr instanceof EFunc) {
    return new VFunc(env, expr.param, expr.body);
  }
  if (expr instanceof ECall) {
    var func = cpsEvaluate(expr.func, env, ...);
    var arg = cpsEvaluate(expr.arg, env, ...);
    if (func instanceof VFunc) {
      var newEnv = new Env(func.env);
      newEnv.put(func.param, arg);
      //debug(func.param + "=" + arg);
      return cpsEvaluate(func.body, newEnv, ...);
    } else if (func instanceof VVal) {
      return valueApply(func, arg);
    }
  }
  if (expr instanceof EVar) {
    return env.get(expr.name);
  }
  if (expr instanceof EVal) {
    return new VVal(expr.value);
  }
};

段階2: return v; => return cont(c);書き換え

次に値を直接返していた部分をcontに渡して返すものに書き換える。

// 未完成: 非再帰で値を返していた部分return v;をreturn cont(v)にする。
cpsEvaluate = function cpsEvaluate(expr, env, cont) {
  if (expr instanceof EFunc) {
    return cont(new VFunc(env, expr.param, expr.body));
  }
  if (expr instanceof ECall) {
    var func = cpsEvaluate(expr.func, env, ...);
    var arg = cpsEvaluate(expr.arg, env, ...);
    if (func instanceof VFunc) {
      var newEnv = new Env(func.env);
      newEnv.put(func.param, arg);
      //debug(func.param + "=" + arg);
      return cpsEvaluate(func.body, newEnv, ...);
    } else if (func instanceof VVal) {
      return cont(valueApply(func, arg));
    }
  }
  if (expr instanceof EVar) {
    return cont(env.get(expr.name));
  }
  if (expr instanceof EVal) {
    return cont(new VVal(expr.value));
  }
};

段階3: 再帰呼び出しの後続部分の関数化

次に再帰呼び出しで渡す部分のcontは、それ以降全体をくるんで戻り値は引数にした関数を渡し、それをreturnするように書き換える。

// 未完成: var func = cpsEvaluate(expr.func, env, ...);のCPS化
cpsEvaluate = function cpsEvaluate(expr, env, cont) {
  if (expr instanceof EFunc) {
    return cont(new VFunc(env, expr.param, expr.body));
  }
  if (expr instanceof ECall) {
    //var func = cpsEvaluate(expr.func, env, ...);
    return cpsEvaluate(expr.func, env, function (func) {
      var arg = cpsEvaluate(expr.arg, env, ...);
      if (func instanceof VFunc) {
        var newEnv = new Env(func.env);
        newEnv.put(func.param, arg);
        //debug(func.param + "=" + arg);
        return cpsEvaluate(func.body, newEnv, ...);
      } else if (func instanceof VVal) {
        return cont(valueApply(func, arg));
      }
    });
  }
  if (expr instanceof EVar) {
    return cont(env.get(expr.name));
  }
  if (expr instanceof EVal) {
    return cont(new VVal(expr.value));
  }
};

後続部分の関数化を繰り返して完成

さらにその中も末尾再帰呼び出し形式に書き換える。最後の再帰呼び出しで渡すcontinuationには大本の引数のcontを渡す。

// 完成: 全体をCPS化
cpsEvaluate = function cpsEvaluate(expr, env, cont) {
  if (expr instanceof EFunc) {
    return cont(new VFunc(env, expr.param, expr.body));
  }
  if (expr instanceof ECall) {
    //var func = cpsEvaluate(expr.func, env, ...);
    return cpsEvaluate(expr.func, env, function (func) {
      //var arg = cpsEvaluate(expr.arg, env, ...);
      return cpsEvaluate(expr.arg, env, function (arg) {
        if (func instanceof VFunc) {
          var newEnv = new Env(func.env);
          newEnv.put(func.param, arg);
          //debug(func.param + "=" + arg);
          return cpsEvaluate(func.body, newEnv, cont);
        } else if (func instanceof VVal) {
          return cont(valueApply(func, arg));
        }
      });
    });
  }
  if (expr instanceof EVar) {
    return cont(env.get(expr.name));
  }
  if (expr instanceof EVal) {
    return cont(new VVal(expr.value));
  }
};

最終的にevaluatorにするには、大本で引数をそのまま返す関数を渡して実行する。

function runEvaluate(expr, env) {
  return cpsEvaluate(expr, env, function (value) { return value; });
}

となる。

CPS版のde-functionalize

CPS版のContinuationは再帰部分で実行環境を保持した関数を渡している。

defunctionalizeするとは、この関数を実行環境で必要なものを保持するデータオブジェクトContと、その処理系に分離すること。つまり、evaluatorではcontObjを受け取り、CPS版中のcont(v)の部分は、applyCont(contObj, v)という形式に書き換えることになる。

段階1: 各cont関数に対応したデータオブジェクトを用意

まず、CPS版のevaluatorのcontに渡すfunctionになっている部分を全部個別のデータオブジェクトにする。

// <= function (value) { return value; } 
CHalt = function CHalt() {
};

// <= function (func) { ... }
CEvalFunc = function CEvalFunc(arg, env, cont) {
  this.arg = arg;
  this.env = env;
  this.cont = cont;
};

// <= function (arg) { ... }
CEvalArg = function CEvalArg(func, env, cont) {
  this.func = func;
  this.env = env;
  this.cont = cont;
};

データオブジェクトが保持するのは、対応するfunctionの引数以外の使用している変数すべて(素直にやれば、CEvalFuncの場合argじゃなくてexprなんだけど、実際使ってるのはexpr.argだけなので、ショートカットしてしまったということで。CEvalArgも同様)。

段階2: cont(v) => applyCont(cont, v)書き換え

次はevaluatorの書き換え。まずはcont(v)をapplyCont(cont, v)にする。

// 未完成: cont(v) => applyCont(cont, v)
defuncEvaluate = function defuncEvaluate(expr, env, cont) {
  if (expr instanceof EFunc) {
    return applyCont(cont, new VFunc(env, expr.param, expr.body));
  }
  if (expr instanceof ECall) {
    return defuncEvaluate(expr.func, env, function (func) {
      return defuncEvaluate(expr.arg, env, function (arg) {
        if (func instanceof VFunc) {
          var newEnv = new Env(func.env);
          newEnv.put(func.param, arg);
          //debug(func.param + "=" + arg);
          return defuncEvaluate(func.body, newEnv, cont);
        } else if (func instanceof VVal) {
          return applyCont(cont, valueApply(func, arg));
        }
      });
    });
  }
  if (expr instanceof EVar) {
    return applyCont(cont, env.get(expr.name));
  }
  if (expr instanceof EVal) {
    return applyCont(cont, new VVal(expr.value));
  }
};

段階3: applyContの雛型

次にapplyCont(cont, value)をもとの関数から用意する。

// 未完成: パターンわけ
applyCont = function applyCont(cont, value) {
  if (cont instanceof CHalt) {
    ...
  }
  if (cont instanceof CEvalFunc) {
    ...
  }
  if (cont instanceof CEvalArg) {
    ...
  }
};

段階4: CHaltの置き換え

次にfunction部分をContオブジェクトに変えていく。替えた中身はapplyContの中身になる。
まずは大本のCHaltから置き換える。

// 完成: CHalt書き換え
function runEvaluate(expr, env) {
  // function (value) { return value; } => CHalt
  return defuncEvaluate(expr, env, new CHalt());
}

// 未完成: CHaltの置き換え
applyCont = function applyCont(cont, value) {
  if (cont instanceof CHalt) {
    // <= function (value) { return value; }
    return value;
  }
  if (cont instanceof CEvalFunc) {
    ...
  }
  if (cont instanceof CEvalArg) {
    ...
  }
};

段階4: CEvalFuncの置き換え

CEvalFuncへの置き換え。

// 完成: function (func) {...} => CEvalFunc(arg, env, cont)
defuncEvaluate = function defuncEvaluate(expr, env, cont) {
  if (expr instanceof EFunc) {
    return applyCont(cont, new VFunc(env, expr.param, expr.body));
  }
  if (expr instanceof ECall) {
     return defuncEvaluate(expr.func, env, new CEvalFunc(expr.arg, env, cont));
     /*
     return defuncEvaluate(expr.func, env, function (func) {
      return defuncEvaluate(expr.arg, env, function (arg) {
        if (func instanceof VFunc) {
          var newEnv = new Env(func.env);
          newEnv.put(func.param, arg);
          //debug(func.param + "=" + arg);
          return defuncEvaluate(func.body, newEnv, cont);
        } else if (func instanceof VVal) {
          return applyCont(cont, valueApply(func, arg));
        }
      });
    });
    */
  }
  if (expr instanceof EVar) {
    return applyCont(cont, env.get(expr.name));
  }
  if (expr instanceof EVal) {
    return applyCont(cont, new VVal(expr.value));
  }
};

// 未完成: CEvalFuncの置き換え
applyCont = function applyCont(cont, value) {
  if (cont instanceof CHalt) {
    // <= function (value) { return value; }
    return value;
  }
  if (cont instanceof CEvalFunc) {
    // 関数の中身を(変数をあわせて)そのまま埋める 
    // 変数対応: evalに渡すarg => cont.arg, env => cont.env, cont => cont.cont, func => value
    return defuncEvaluate(cont.arg, cont.env, function (arg) {
      if (value instanceof VFunc) {
        var newEnv = new Env(value.env);
        newEnv.put(value.param, arg);
        //debug(value.param + "=" + arg);
        return defuncEvaluate(value.body, newEnv, cont.cont);
      } else if (func instanceof VVal) {
        return applyCont(cont.cont, valueApply(value, arg));
      }
    });
  }
  if (cont instanceof CEvalArg) {
    ...
  }
};

段階5: CEvalArgの書き換え

残りのCEvalArg部分を書き換え。

// 未完成: CEvalFuncの置き換え
applyCont = function applyCont(cont, value) {
  if (cont instanceof CHalt) {
    // <= function (value) { return value; }
    return value;
  }
  if (cont instanceof CEvalFunc) {
    return defuncEvaluate(cont.arg, cont.env, new CEvalArg(value, cont.env, cont.cont));
    /*
    return defuncEvaluate(cont.arg, cont.env, function (arg) {
      if (value instanceof VFunc) {
        var newEnv = new Env(value.env);
        newEnv.put(value.param, arg);
        //debug(value.param + "=" + arg);
        return defuncEvaluate(value.body, newEnv, cont.cont);
      } else if (func instanceof VVal) {
        return applyCont(cont.cont, valueApply(value, arg));
      }
    });
    */
  }
  if (cont instanceof CEvalArg) {
    // 対応: value => cont.func, cont.cont => cont.cont, arg => value
    if (value instanceof VFunc) {
      var newEnv = new Env(cont.func.env);
      newEnv.put(cont.func.param, value);
      //debug(cont.func.param + "=" + value);
      return defuncEvaluate(cont.func.body, newEnv, cont.cont);
    } else if (func instanceof VVal) {
      return applyCont(cont.cont, valueApply(cont.func, value));
    }
  }
};

どうやらCEvalArgは使わないものまで保持してたようだ。

完成版

複数の関数やデータに分かれて対応関係を示すコメントも埋まっているので、対応関係のコメントを削りまとめたもの

// Cont
CHalt = function CHalt() {
};

CEvalFunc = function CEvalFunc(arg, env, cont) {
  this.arg = arg;
  this.env = env;
  this.cont = cont;
};

CEvalArg = function CEvalArg(func, env, cont) {
  this.func = func;
  this.env = env;
  this.cont = cont;
};

// evaluator: top level
function runEvaluate(expr, env) {
  return defuncEvaluate(expr, env, new CHalt());
}

// defunctionalized CPS evaluator 
defuncEvaluate = function defuncEvaluate(expr, env, cont) {
  if (expr instanceof EFunc) {
    return applyCont(cont, new VFunc(env, expr.param, expr.body));
  }
  if (expr instanceof ECall) {
     return defuncEvaluate(expr.func, env, new CEvalFunc(expr.arg, env, cont));
  }
  if (expr instanceof EVar) {
    return applyCont(cont, env.get(expr.name));
  }
  if (expr instanceof EVal) {
    return applyCont(cont, new VVal(expr.value));
  }
};

// continuation runner
applyCont = function applyCont(cont, value) {
  if (cont instanceof CHalt) {
    return value;
  }
  if (cont instanceof CEvalFunc) {
    return defuncEvaluate(cont.arg, cont.env, new CEvalArg(value, cont.env, cont.cont));
  }
  if (cont instanceof CEvalArg) {
    if (value instanceof VFunc) {
      var newEnv = new Env(cont.func.env);
      newEnv.put(cont.func.param, value);
      //debug(cont.func.param + "=" + value);
      return defuncEvaluate(cont.func.body, newEnv, cont.cont);
    } else if (func instanceof VVal) {
      return applyCont(cont.cont, valueApply(cont.func, value));
    }
  }
};

末尾再帰関数のループ化

この書き換えをステップでやると膨大な量になるので、やり方だけ。

単純末尾呼び出し再帰関数のループ化は、returnの部分を以下のようにしてwhileループに入れればいい。

• 再帰呼び出しのreturn: 引数を上書きしてcontinue;
• 再帰呼び出しでないreturn: returnする

function foo(arg1, arg2) {
  if (...) {
    ...
    return c;
  }
  if (...) {
    ...
    return foo(a, b);
  }
}
// ↓
function foo(arg1, arg2) {
  while (true) {
    if (...) {
      ...
      return c;
    }
    if (...) {
      ...
      arg1 = a;
      arg2 = b;
      continue;
    }
  }
}

注意点は、arg1、arg2を上書きするとき副作用が起きる点を忘れないこと、たとえば呼び出し部がreturn f(a, arg1.m)だからといって、arg1 = a; arg2 = arg1.m; とかやるとアウト。

相互末尾再帰呼び出し関数のループ化

末尾再帰だけど、複数の関数が交互に呼び合ってる場合はどうするか。

• 再帰関数をひとつにまとめる。
• その大関数をループ化する。

基本は、引数に全部の関数引数をのせ、さらにフラグを用意して振り分け、再帰呼び出しは呼び出す関数のフラグをセットして呼び出す。という泥臭い方法になる。さらに応用としては

• 外から呼ばれない関数の引数は、ローカル変数にする。
• フローにさらに限定があるなら、ショートカットする。

工夫するだけバグも入りやすくなるので、あまり深くやらないほうがいい。

function f(a, b) {...}
function g(a, c) {...}
// ↓
DO_F = 1;
DO_G = 2;
function h(flag, a1, b, a2, c) {
  switch (flag) {
  case DO_F:
    ...
  case DO_G:
    ...
  }
}

まとめとか

CEvalFuncやCEvalArgってのは呼び出しもとの処理の名前であり、Continuation of Eval Funcとかだけど、実際のところ、あとに行う処理の名前を付けたほうがいいかも。CEvalFunc=>CPushArg、CEvalArg=>CInvokeFuncのような感じに。

unbox処理のvalueApplyをCPS化しなかったのは、以降で書き換える関数が増えて、記述量が増えて面倒なため。ただ、Lazynessを入れる場合も、ECallでfuncを取り出すときに呼ぶeagerでは再帰的にevaluatorを適用することになり(つまりeval同様にCPS関数にする必要が出る)、またvalueApply中にもeagerが入るのでvalueApplyのCPS書き換えが必須になってしまうのでやめた、という経緯。

一連の書き換えは最後まで機械的に可能なはず。機能的には再帰バージョンがかければ十分だが、たとえばcontinuationのようなものを使えるようにする言語系だと、evalのCPS化はほぼ必須のもので、そこまでやるなら関数のデータ化までするといいかな。

リソース

• John C. Reynolds: Definitional Interpreters for Higher-Order Programming Languages
  • http://www.brics.dk/~hosc/local/HOSC-11-4-pp363-397.pdf

ソース全体

コードlang.js

// event handler
function doRun() {
  var input = document.getElementById("input").value;
  var expr = eval(input);
  
  document.getElementById("output").innerHTML += "\n[expr]\n";
  document.getElementById("output").innerHTML += expr.toString();
  document.getElementById("output").innerHTML += "\n[evaluated]\n";
  var result = evaluate(expr);
  document.getElementById("output").innerHTML += result.toString();
}

function doClear() {
  document.getElementById("debug").innerHTML = "";
  document.getElementById("output").innerHTML = "";
}

// utilities
debug = function debug(obj) {
  document.getElementById("debug").innerHTML += obj + "\n";
}
curry = function curry(func, args) {
  var curried = function curried(arg) {
    var nargs = args.slice(0);
    nargs.push(arg);
    if (func.length == nargs.length) {
      var ret = func.apply(null, nargs);
      return ret;
    } else {
      return curry(func, nargs);
    }
  };
  return curried;
};
extend = function extend(ctor, obj) {
  if (! ctor.prototype) {
    ctor.prototype = {}
  }
  for (var prop in obj) {
    ctor.prototype[prop] = obj[prop];
  }
  return ctor;
}
LObject = function LObject() {
  this.toString = function toString() {
    return this.toIndented("");
  };
  this.toIndented = function toIndented(indent) {
    var nested = indent + "  ";
    var ret = this.constructor.name + " {\n";
    for (var prop in this) {
      if (!this.hasOwnProperty(prop)) continue;
      ret += nested + prop + " = ";
      var val = this[prop];
      if (typeof val == "object" && val["toIndented"]) {
        ret += val.toIndented(nested);
      } else {
        ret += val + "\n";
      }
    }
    ret += indent + "}\n";
    return ret;
  }
};

// AST expr
EFunc = function EFunc(param, body) {
  this.param = param;
  this.body = body;
};
extend(EFunc, new LObject());
ECall = function ECall(func, arg) {
  this.func = func;
  this.arg = arg;
};
extend(ECall, new LObject());
EVar = function EVar(name) {
  this.name = name;
};
extend(EVar, new LObject());
EVal = function EVal(value) {
  this.value = value;
}
extend(EVal, new LObject());


// syntax
sfunc = function sfunc(params, body) {
  if (params.length == 1) return new EFunc(params[0], body);
  var param = params[0];
  var params = params.slice(1);
  return new EFunc(param, sfunc(params, body));
};
scall = function scall(func, args) {
  if (args.length == 1) return new ECall(func, args[0]);
  var arg = args[args.length-1];
  var args = args.slice(0, args.length-1);
  return new ECall(scall(func, args), arg);
};
slet = function slet(name, value, body) {
  return new ECall(new EFunc(name, body), value);
};
svar = function svar(name) {
  return new EVar(name);
};
sval = function sval(value) {
  return new EVal(value);
};
sunit = function sunit() {
  return EVal(undefined);
};


// Runtime
Env = function Env(parent) {
  this.vars = {};
  this.parent = parent;
  this.put = function put(name, value) {
    this.vars[name] = value;
  };
  this.get = function get(name) {
    if (this.vars.hasOwnProperty(name)) {
      return this.vars[name];
    } else {
      if (this.parent == null) {
        debug("var not found: " + name);
        return sunit();
      }
      return this.parent.get(name);
    }
  };
};

// Value
VVal = function VVal(value) {
  this.value = value;
};
extend(VVal, new LObject());
VFunc = function VFunc(env, param, body) {
  this.env = env;
  this.param = param;
  this.body = body;
};
extend(VFunc, new LObject());

// version 1: naive evaluator
simpleEvaluate = function simpleEvaluate(expr, env) {
  if (expr instanceof EFunc) {
    return new VFunc(env, expr.param, expr.body);
  }
  if (expr instanceof ECall) {
    var func = simpleEvaluate(expr.func, env);
    // ToBe Lazy: func = eager(func)
    var arg = simpleEvaluate(expr.arg, env);
    // ToBe Lazy: arg = new VLazy(expr.arg, env);
    if (func instanceof VFunc) {
      var newEnv = new Env(func.env);
      newEnv.put(func.param, arg);
      //debug(func.param + "=" + arg);
      return simpleEvaluate(func.body, newEnv);
    } else if (func instanceof VVal) {
      return valueApply(func, arg);
    }
  }
  if (expr instanceof EVar) {
    return env.get(expr.name);
  }
  if (expr instanceof EVal) {
    return new VVal(expr.value);
  }
};
// unboxing
valueApply = function valueApply(func, arg) {
  var funcObj = func.value;
  if (typeof funcObj != "function") {
    return func;
  }
  if (funcObj.length > 1) {
    funcObj = curry(funcObj, []);
  }
  var funcArg = lambda2Js(arg);
  // ToBe Lazy: funcArg = function () { return lambda2Js(arg); }
  return new VVal(funcObj(funcArg));
};
lambda2Js = function lambda2Js(value) {
  // ToBe Lazy: value = eager(value);
  if (value instanceof VVal) {
    return value.value;
  } else if (value instanceof VFunc) {
    return function lambdaFunc(arg) {
      var func = new EFunc(value.param, value.body);
      var expr = new ECall(func, new EVal(arg));
      var ret = runEvaluator(expr, value.env);
      return lambda2Js(ret);
    };
  }
};


// version 2: cps evaluator
cpsEvaluate = function cpsEvaluate(expr, env, cont) {
  if (expr instanceof EFunc) {
    return cont(new VFunc(env, expr.param, expr.body));
  }
  if (expr instanceof ECall) {
    return cpsEvaluate(expr.func, env, function (func) {
      func = reduce(func);
      return cpsEvaluate(expr.arg, env, function (arg) {
        if (func instanceof VFunc) {
          var newEnv = new Env(func.env);
          newEnv.put(func.param, arg);
          //debug(func.param + "=" + arg);
          return cpsEvaluate(func.body, newEnv, cont);
        } else if (func instanceof VVal) {
          return cont(valueApply(func, arg));
        }
      });
    });
  }
  if (expr instanceof EVar) {
    return cont(env.get(expr.name));
  }
  if (expr instanceof EVal) {
    return cont(new VVal(expr.value));
  }
};



// version 3: defunctionalized cps evaluator
CHalt = function CHalt() {
};
extend(CHalt, new LObject());
CEvalFunc = function CEvalFunc(arg, env, cont) {
  this.arg = arg;
  this.env = env;
  this.cont = cont;
}
extend(CEvalFunc, new LObject());
CEvalArg = function CEvalArg(func, env, cont) {
  this.func = func;
  this.env = env;
  this.cont = cont;
}
extend(CEvalArg, new LObject());

// cont is CXxxx object
defuncEvaluate = function defuncEvaluate(expr, env, cont) {
  if (expr instanceof EFunc) {
    return applyCont(cont, new VFunc(env, expr.param, expr.body));
  }
  if (expr instanceof ECall) {
    return defuncEvaluate(expr.func, env, new CEvalFunc(expr.arg, env, cont));
  }
  if (expr instanceof EVar) {
    return applyCont(cont, env.get(expr.name));
  }
  if (expr instanceof EVal) {
    return applyCont(cont, new VVal(expr.value));
  }
  
};
applyCont = function applyCont(cont, value) {
  if (cont instanceof CHalt) {
    return value;
  }
  if (cont instanceof CEvalFunc) {
    return defuncEvaluate(cont.arg, cont.env, new CEvalArg(value, cont.env, cont.cont));
  }
  if (cont instanceof CEvalArg) {
    if (cont.func instanceof VFunc) {
      var newEnv = new Env(cont.func.env);
      newEnv.put(cont.func.param, value);
      //debug(cont.func.param + "=" + arg);
      return defuncEvaluate(cont.func.body, newEnv, cont.cont);
    } else if (cont.func instanceof VVal) {
      return applyCont(cont.cont, valueApply(cont.func, value));
    }
  }
};

// looped evaluator
DO_EVAL = 0;
DO_CONT = 1;
loopedEvaluate = function loopedEvaluate(expr, env) {
  var cont1 = new CHalt();
  var cont2 = null;
  var value = null;
  var invoke = DO_EVAL;
  
  //while (true) {
  for (var i = 0; i < 100; i += 1) {
    // evaluation
    switch (invoke) {
    case DO_EVAL:
      //debug(expr.constructor.name);
      if (expr instanceof EFunc) {
        value = new VFunc(env, expr.param, expr.body);
        cont2 = cont1;
        invoke = DO_CONT;
        //return applyCont(cont, new VFunc(env, expr.param, expr.body));
      } else if (expr instanceof ECall) {
        cont1 = new CEvalFunc(expr.arg, env, cont1);
        expr = expr.func;
        invoke = DO_EVAL;
        //return defuncEvaluate(expr.func, env, new CEvalFunc(expr.arg, env, cont));
      } else if (expr instanceof EVar) {
        value = env.get(expr.name);
        cont2 = cont1;
        invoke = DO_CONT;
        //return applyCont(cont, env.get(expr.name));
      } else if (expr instanceof EVal) {
        value = new VVal(expr.value);
        cont2 = cont1;
        invoke = DO_CONT;
        //return applyCont(cont, new VVal(expr.value));
      } else {
        debug("Expr ERROR");
        return;
      }
      break;
    case DO_CONT:
      // continuation
      //debug(cont2.constructor.name);
      if (cont2 instanceof CHalt) {
        return value;
      } else if (cont2 instanceof CEvalFunc) {
        expr = cont2.arg;
        env = cont2.env;
        cont1 = new CEvalArg(value, cont2.env, cont2.cont);
        invoke = DO_EVAL;
        //return defuncEvaluate(cont.arg, cont.env, new CEvalArg(value, cont.env, cont.cont));
      } else if (cont2 instanceof CEvalArg) {
        if (cont2.func instanceof VFunc) {
          var newEnv = new Env(cont2.func.env);
          newEnv.put(cont2.func.param, value);
          //debug(cont.func.param + "=" + arg);
          expr = cont2.func.body;
          env = newEnv;
          cont1 = cont2.cont;
          invoke = DO_EVAL;
          //return defuncEvaluate(cont.func.body, newEnv, cont.cont);
        } else if (cont2.func instanceof VVal) {
          value = valueApply(cont2.func, value);
          cont2 = cont2.cont;
          invoke = DO_CONT;
          //return applyCont(cont.cont, valueApply(cont.func, value));
        }
      } else {
        debug("Cont ERROR");
        return;
      }
      break;
    }
  }
  debug("ERROR");
}


// evaluate
runEvaluator = function runEvaluator(expr, env) {
  return loopedEvaluate(expr, env);
  //return defuncEvaluate(expr, env, new CHalt());
  //return cpsEvaluate(expr, env, function (result) { return result; });
  //return simpleEvaluate(expr, env);
};
evaluate = function evaluate(expr) {
  return runEvaluator(expr, new Env(null));
  // ToBe Lazy: return eager(runEvaluator(expr, new Env(null));
};

HTMLフォームとか

<html>
<head>
  <script src="lang.js" type="application/javascript;version=1.7" />
</head>
<body>
  <div>
    <form>
      <textarea id="input" cols="80" rows="10">
slet("k", sfunc(["x", "y"],
                svar("x")),
     scall(svar("k"), [sval(10), sval(20)]));
        </textarea>
    </form>
    <button onclick="doRun()">DO IT</button>
    <button onclick="doClear()">CLEAR LOG</button>
  </div>
  <pre id="debug"></pre>
  <pre id="output"></pre>
</body>
</html>