#はじめに
はい。この記事はD言語Advent Calendar 4日目の記事です。
はい。いま13日ですね。9日過ぎてるのは単に僕のコードの解説をするモチベーションが無くなったことが原因です。ごめんなさい。とりあえず書いたのでこれでお願いします...

皆さん、S式は好きですか？
多分、S式に馴染みのない方はNOといい馴染みのある方はYESと言うと思います。
そもそも、私は実際にS式を書いたり処理するようになるまではS式は読みにくくて(主に見た目が)ヤバイ記法だと思っていました。

しかし、S式は表現が自由でありながらもパースがとても楽な表現です。
この記事ではそのS式という記法を用いたオリジナルのプログラミング言語、ChickenClispを実装します。
ChickenClispはLisp方言の一つであり、Schemeを意識しました。
意識したとは書きましたが、私はScheme初心者であるため、若干syntaxを真似した程度に過ぎませんが。
また、ChickenClispは現在開発中と言うこともありまだまだ機能は少ないですしパフォーマンスも改善もしなければなりません。
また、この記事だけでChickenClispを完全に解説することは不可能です(現在のChickenClispのソースコード全体の行数が気になって、今試しにfind . -type f -name "*.d" | xargs wc -l | sort -nとしてみたところ4275行とでてきました笑)。
したがって、完全な解説を行うことはせずに、最低限の解説のみを書こうと思います。

もともとはミニマルなChickenClispを作って実際に言語を作る！という記事にしたかったのですがそれはあまりにもコストが高すぎて(完成品のコードからエッセンスだけを削ったりするのって結構難しくて...(切りたくない機能が多いので))無理だったのでこの記事では解説にとどめます。ただ、いいわけじゃないですけどこの記事の内容を理解した後にもう一度ChickenClispのコードを読むとLisp処理系を実装するってどういうことなのかがわかると思います。はい。
この記事ではChickenClispのコアと個人的に実装で面白いなぁと思った点について節を設けて解説したいと思います。

#開発の経緯
解説に入る前に、ChickenClispを開発するに至った経緯を簡単に書きます。

もともと、私は勉強のためにLisp処理系を書きたいと考えていました。
そこで、rui314/minilispを読んだりしていました。
そんな時に、ふとQiitaを眺めているとプログラミング言語を作る。１時間で。という記事を発見しました。(基本的な実装についてはそちらを参照していただくといいかもしれません...)
そこで、元記事中ではJavaで実装されていたOrelangを私はTypeScriptで再実装しさらに機能を追加したOrelang_TSを開発しました。
そして、実装した後に Qiitaで見つけたOrelang(俺言語)をTypeScriptで実装し、さらにif式や関数定義を追加したりS式で書けるようにしてみたという記事を書きました。
この記事を書いた後もしばらくはTypeScriptでOrelang_TSの開発を続けました。
しかし、私はD言語が好きです。TypeScriptも好きですが、やっぱり一番好きなのはD言語です。
したがって、D言語で開発したい！！！という思いが次第に強くなり、開発をはじめました。
それが、ChickenClispです。

さて、実装の話に移りましょうか。

#実装をしよう。
##プログラミング言語言語を実装するとはどういうことだろうか。
さて、はじめに断っておきますが、僕は言語開発のプロとかでは決して無くてなんとなくそれっぽいものを作って遊んでるだけのゆるふわです。そのため、以下で用いる用語はしばしば不適当なものであるかもしれません。
ご了承ください...
また、節の見出しは一見すると言語開発一般に対する話のように見えますが、そうではなく、あくまでもChickenClispの開発に限った話となります。
これも予めご了承ください。

さて、ChickenClispの構成について見ていきましょう。

パーサー(字句解析器)/トランスパイラ ※S式のパーサーは20分もあれば書ける。
評価器

ChickenClispは所謂インタプリタ型の言語故に、コンパイルの処理が入らず、この2,3のコンポーネントから構成されています。
それぞれについてとりあえず説明します。

###パーサーとトランスパイラ
上に書いたとおり、ChickenClispはLisp処理系であり、S式を表現として受け取ります。
そして、このパーサーとトランスパイラこそがS式を表現として受け取る部分を担います。パーサーはParserクラスとしてParser.dに、トランスパイラはTranspilerとしてTranspiler.dにて定義しています。

例えば、次のような表現を受け取ります。

(println "foo")
(println (+ 1 2))

見て分かる通り、S式は基本的にポーランド記法で書かれた表現です。
ChickenClispで許している表現は(一部の特殊な例, condなどは例外的ですのでここでは考えません)1番左に適用したい関数名や演算子(ChickenClispでは演算子も関数として扱います)を書き、その後に半角スペース区切りで引数列を与えることで関数適用を行います。

また、ChickenClispが扱うことのできる値と型は以下のとおりです。

数値型(double) <- 整数と小数をdoubleで包括的に扱う。
文字列型(string) <- ChickenClispではCやDにおける文字と文字列の区別がありません。
シンボル型 <- クオーテーションで囲まれていない文字列はシンボルとして扱われます。
真偽値型とnull <- trueかfalseを真偽値型はとります。また、内部的にはnullも状態として持ちます(あとで少し解説します。)
リスト型(配列型) <- '(1 2 3 5 "abc" "def")のような'()の中に空白スペース区切りで要素を書くとリストとして扱われます。
クラスのインスタンス(実装的にはクロージャーの型) <- 内部的にはクロージャーをいい感じにハンドリングしています。

ここまでがS式として受け取れる型や値です。
内部的には、ちょろっと書きましたが、クロージャーやImmediateValueとか様々な型を扱っています。それについては後ほど書くかもしれません。

とりあえず、こんな感じの値をS式をつかって適用したりしていくとLispになります。
このS式をChickenClisp側、すなわちD言語側の表現にトランスパイルすることでChickenClispはS式を扱っています。
実装的には、パーサー自体がほぼほぼトランスパイラという感じになっているのですが、パーサーだけだとちょっと不具合が出るので(これは実装上の問題)、トランスパイラのクラスを作り、そこからパーサーを読んでほんの少しだけ工夫することでトランスパイラを実現しています。これについても後ほど書くかもです。というか書きます。

なお、パーサーを書くのは簡単で20分ぐらいあればパーサーを書くことが出来ると思います。(ただし、ここに闇が存在します。これは後述します。)

Parser.d

module orelang.Parser;
import orelang.expression.ImmediateValue,
       orelang.expression.SymbolValue,
       orelang.Value;
import std.regex,
       std.conv;

auto nrgx = ctRegex!"[0-9]";

class Parser {
  static size_t nextBracket(string code) {
    size_t index,
           leftCount = 1,
           rightCount;

    while (leftCount != rightCount) {
      if (code[index] == '(') { leftCount++; }
      if (code[index] == ')') { rightCount++; }
      ++index;
    }

    return index;
  }

  static Value[] parse(string code) {
    Value[] _out;

    for (size_t i; i < code.length; ++i) {
      dchar ch = code[i];

      // スペースはスキップする
      if (ch == ' ') {
        continue;
      } else {
        /* '('が来た場合、次の括弧(')'で閉じられる)までを解析すべき範囲として
         * 再帰的にパーサーに食わせる。
         * そして再帰的にパースしてきた戻り値をValueでラップして_outに追加することでパースを行う */
        if (ch == '(') {
          size_t j = nextBracket(code[i+1..$]);

          _out ~= new Value(parse(code[i+1..i+j]));

          i += j;// インデックスの更新。'('に対応する')'までスキップするため。
        } else if (ch == ')') {
          // 閉じ括弧が来た場合にパースを終了しそこまでにパースしたものをreturnする。
          return _out;
        } else {
          // 数字かどうかを判定する。また、'-'から始まり次に数字が始まった場合は負の数として扱う。(nrgxは/[0-9]/という正規表現を持っている)
          if (ch.to!string.match(nrgx) || (i + 1 < code.length && ch == '-' && code[i + 1].to!string.match(nrgx))) {
            string tmp;
            size_t j = i;

            // 小数も扱うために'.'が来た場合にその次のトークンが存在しそれが数字で会った場合に処理を続ける。
            do {
              tmp ~= code[j];
              ++j;
            } while (
                j < code.length &&
                ((code[j] != ' ' && code[j].to!string.match(nrgx))
                 ||  (code[j] == '.' && j + 1 < code.length && code[j + 1].to!string.match(nrgx)))
                );

            // 一時的に文字列として読み取った数字をdoubleとして扱う。
            _out ~= new Value(tmp.to!double);

            i = j - 1;
          } else if (ch == '\"' || ch == '\'') { // '\"'や'\''を受け取った場合
            // '\''を受取り、かつその次のトークンが存在しさらにその次のトークンが'('である場合に、リストとして扱う。
            if (ch == '\'' && i + 1 < code.length && code[i + 1] == '(') {
              // 閉じ括弧のインデックスを得る。
              size_t j = nextBracket(code[i + 2..$]) + 1;

              _out ~= new Value(new ImmediateValue(new Value(parse(code[i+2..j+i]))));

              i += j;
            } else {
              // 文字列として処理する。
              string tmp;
              size_t j = i + 1;

              while (j < code.length && code[j] != ch) {
                if (j < code.length) {
                  tmp ~= code[j];
                } else {
                  throw new Error("Syntax Error");
                }

                ++j;
              }

              _out ~= new Value(tmp);
              i = j;
            }
          } else {
            // Bool, Null, シンボルの処理。
            string tmp;
            size_t j = i;

            while (
                j < code.length && code[j] != '\"' && code[j] != '\'' &&
                code[j] != '(' && code[j] != ')' && code[j] != ' '
                ) {
              tmp ~= code[j];
              ++j;
            }

            if (tmp == "true") {
              _out ~= new Value(true);
            } else if (tmp == "false") {
              _out ~= new Value(false);
            } else if (tmp == "null") {
              _out ~= new Value;
            } else {
              _out ~= new Value(new SymbolValue(tmp));
            }

            i = j;
          }
        }
      }
    }

    return _out;
  }
}

これがChickenClispのパーサーです。

###評価器
内部表現に変換されたS式を再帰的に評価していき、実際にChickenClispの動作を行う部分です。
ChickenClispではEngineクラスがそれを担っています(特にeval関数とgetExpression関数が担当しています。)。また、EngineクラスはEngine.dで定義しています。

とりあえず、うえの2つの部分を作ると、ChickenClispのコアを作ることが出来ます。
行数としては、(ここで未紹介のValue.dも含めて)1148行らしいです。
(厳密にはsource/orelang/expressionの
IExpression.d, SymbolValue.d, CallOperator.d, ClassType.d, ImmediateValue.dと, source/orelang/operator/IOperator.dも必要ですので行数はもう少し増えますが...)

評価器については不要な部分を割愛してValue.dについて解説した後に解説を行います。

##実装における課題。
さて、実装をするにあたって根本的な問題が存在します。
それは、僕が初めD言語ではなくTypeScriptで開発を始めた理由でもあります。
それは、静的に型が決定されるD言語でどうやって動的に与えられるChickenClispの型を扱うか、です。
これは言い換えると、ChickenClisp側の複数の型をD言語側で一つの型としてどう扱うか、です。
こうやって言い換えると解決方法は思いつきやすいと思います。

複数の型をラップするクラスを作る

はい、これがソリューションになります。
(これがパーサーで言及した闇です)

なぜこれがソリューションとなるのでしょうか?それは単純です。
D言語では複数の型を返しうる関数を書くことが出来ません。
例えば次のコードはダメです。

struct X {}

auto ret(string r) {
  static if (r == "i") {
    return 1;
  } else if (r == "s") {
    return "a";
  } else if (r == "x") {
    return X();
  }
}

これを解決するために、例えば上の例では一つの型(structやclass)でintとstring、Xを一つの型Valueを定義することで解決できます。
次のようなコードになります。

import std.exception,
       std.stdio,
       std.conv;
struct X{}

// Valueがもつ値の型を表すタグとして列挙体を使う。
enum ValueType {
  Integer,
  String,
  X,
  Null
}

class Value {
  // Valueが内部で持つ型についての情報を持つ。
  ValueType type;

  // 値の実体
  private {
    int     integer_value;
    string  string_value;
    X       x_value;
  }

  // コンストラクタ
  this()               { this.type = ValueType.Null; }
  this(ValueType type) { this.type = type; }
  this(int value) { this.opAssign(value); }
  this(string value)  { this.opAssign(value); }
  this(X value)    { this.opAssign(value); }

  // ゲッター。セッターはopAssignを使って実現するために明示的に書く必要はない。
  int     getInteger() { enforce(this.type == ValueType.Integer);
                         return this.integer_value; }
  string  getString()  { enforce(this.type == ValueType.String);
                         return this.string_value; }
  X       getX()       { enforce(this.type == ValueType.X);
                         return this.x_value; }

  // value = 1;
  void opAssign(int value) {
    this.init;
    this.integer_value = value;
    this.type          = ValueType.Integer;
  }

  // value = "abc";
  void opAssign(string value) {
    this.init;
    this.string_value = value;
    this.type         = ValueType.String;
  }

  // value = X();
  void opAssign(X value) {
    this.init;
    this.x_value    = value;
    this.type       = ValueType.X;
  }

  // Valueを文字列表示するためのoverride
  override string toString() {
    final switch(this.type) with (ValueType) {
      case Integer: return this.integer_value.to!string;
      case String:  return this.string_value;
      case X:       return this.x_value.to!string;
      case Null:    return "null";
    }
  }

  // value += value2;
  void addTo(Value value) {
    enforce(this.type == value.type && value.type == ValueType.Integer);
    this.integer_value += value.getInteger;
  }

  // value -= value2;
  void subTo(Value value) {
    enforce(this.type == value.type && value.type == ValueType.Integer);
    this.integer_value -= value.getInteger;
  }

  // value *= value2;
  void mulTo(Value value) {
    enforce(this.type == value.type && value.type == ValueType.Integer);
    this.integer_value *= value.getInteger;
  }

  // value /= value2;
  void divTo(Value value) {
    enforce(this.type == value.type && value.type == ValueType.Integer);
    this.integer_value /= value.getInteger;
  }

  // value %= value2;
  void modTo(Value value) {
    enforce(this.type == value.type && value.type == ValueType.Integer);
    this.integer_value %= value.getInteger;
  }

  // value + value2;
  Value opBinary(string op)(Value value) if (op == "+") {
    enforce(value.type == ValueType.Integer);
    return new Value(this.integer_value + value.getInteger);
  }

  // value - value2;
  Value opBinary(string op)(Value value) if (op == "-") {
    enforce(value.type == ValueType.Integer);

    return new Value(this.integer_value - value.getInteger);
  }

  // value * value2;
  Value opBinary(string op)(Value value) if (op == "*") {
    enforce(value.type == ValueType.Integer);
    return new Value(this.integer_value * value.getInteger);
  }

  // value / value2;
  Value opBinary(string op)(Value value) if (op == "/") {
    enforce(value.type == ValueType.Integer);
    return new Value(this.integer_value / value.getInteger);
  }

  // value % value2;
  Value opBinary(string op)(Value value) if (op == "%") {
    enforce(value.type == ValueType.Integer);
    return new Value(this.integer_value % value.getInteger);
  }

  // Valueを初期化する。
  void init() {
    if (this.type != ValueType.Null) {
      if (this.type == ValueType.Integer) { this.integer_value = 0;  }
      if (this.type == ValueType.String)  { this.string_value  = ""; }
      if (this.type == ValueType.X)       { this.x_value       = X(); }

      this.type = ValueType.Null;
    }
  }

  // 同値確認
  override bool opEquals(Object _value) {
    if ((cast(Value)_value) is null) {
      throw new Error("Can not compare between incompatibility");
    }

    Value value = cast(Value)_value;

    if (this.type != value.type) {
      throw new Error("Can not compare between incompatibility type " ~ this.type.to!string ~ " and " ~ value.type.to!string);
    }

    final switch(this.type) with (ValueType) {
      case Integer:
        return this.integer_value == value.integer_value;
      case String:
        return this.string_value  == value.string_value;
      case X:
        return this.x_value    == value.x_value;
      case Null:
        throw new Error("Can't compare with Null");
    }
  }

  // 値の比較
  override int opCmp(Object _value) {
    if ((cast(Value)_value) is null) {
      throw new Error("Can not compare between incompatibility");
    }

    Value value = cast(Value)_value;

    if (this.type != value.type) {
      throw new Error("Can not compare between incompatibility type " ~ this.type.to!string ~ " and " ~ value.type.to!string);
    }

    final switch(this.type) with (ValueType) {
      case Integer:
        auto c = this.integer_value,
             d = value.integer_value;

        if (c == d) { return 0;  }
        if (c < d)  { return -1; }
        return 1;
      case String:
        auto c = this.string_value,
             d = value.string_value;

        if (c == d) { return 0;  }
        if (c < d)  { return -1; }
        return 1;
      case X:
        return this.x_value    == value.x_value;
      case Null:
        throw new Error("Can't compare with Null");
    }
  }

  /* Valueを複製する。
   * 単純にvalue1を
   * value2 = value1;
   * とすると、Classは参照渡しなのでvalue2をいじるとvalue1の値が変わってしまう。
   * そのために新たなValueを返す為の関数を作る。
   * 実際にコピーを行うときは
   * value2 = value1.dup;
   * とする。 */
  Value dup() {
    final switch (this.type) with (ValueType) {
      case Integer:
        return new Value(this.integer_value);
      case String:
        return new Value(this.string_value);
      case X:
        return new Value(this.x_value);
      case Null:
        return new Value;
    }
  }
}


void main() {
  writeln(new Value);        // null
  writeln(new Value(1));     // Integer
  writeln(new Value("abc")); // String
  writeln(new Value(X()));   //X
}

個人的にこのようにEnumを識別用のタグとして値をラップしていい感じに扱う手法が好きでよく使っています。JSONパーサーを書いたときとかもこれをつかいました。
なお、多分__traits(allMembers, value)とかで/.*_value/で正規表現を書けてゲッターとかを自動生成してmixinとかも可能だとは思いますが面倒くさかったので愚直に手打ちしてValue.dは実装しました。

実際のコードは次のようになります。

Value.d

module orelang.Value;
import orelang.expression.ImmediateValue,
       orelang.operator.DynamicOperator,
       orelang.expression.IExpression,
       orelang.expression.SymbolValue,
       orelang.expression.ClassType,
       orelang.operator.IOperator,
       orelang.Closure;
import std.algorithm,
       std.exception,
       std.array,
       std.traits,
       std.regex,
       std.conv;

enum ValueType {
  ImmediateValue,
  SymbolValue,
  IExpression,
  ClassType,
  IOperator,
  Closure,
  HashMap,
  Numeric,
  String,
  Ubyte,
  Bool,
  Null,
  Array
}

class Value {
  ValueType type;

  private {
    double  numeric_value;
    string  string_value;
    bool    bool_value;
    ubyte   ubyte_value;
    Value[] array_value;
    ImmediateValue imv_value;
    SymbolValue    sym_value;
    IExpression    ie_value;
    ClassType      class_value;
    IOperator      io_value;
    Closure        closure_value;
    Value[string]  hashmap_value;
  }

  this()               { this.type = ValueType.Null; }
  this(ValueType type) { this.type = type; }
  this(T)(T value) if (isNumeric!T) { this.opAssign(value); }
  this(string value)  { this.opAssign(value); }
  this(bool value)    { this.opAssign(value); }
  this(ubyte value)   {
    this.init;
    this.ubyte_value = value;
    this.type        = ValueType.Ubyte;
  }
  this(Value[] value) { this.opAssign(value); }
  this(ImmediateValue value) {
    this.init;
    this.imv_value = value;
    this.type      = ValueType.ImmediateValue; }
  this(SymbolValue value) {
    this.init;
    this.sym_value = value;
    this.type      = ValueType.SymbolValue; }
  this(IExpression value)    { this.opAssign(value); }
  this(ClassType value)      { this.opAssign(value); }
  this(IOperator value)      { this.opAssign(value); }
  this(Closure value)        { this.opAssign(value); }
  this(Value[string] value)  { this.opAssign(value); }

  double  getNumeric() { enforce(this.type == ValueType.Numeric);
                         return this.numeric_value; }
  string  getString()  { enforce(this.type == ValueType.String || this.type == ValueType.SymbolValue);
                         return this.type == ValueType.String ? this.string_value : this.sym_value.value; }
  bool    getBool()    { enforce(this.type == ValueType.Bool);
                         return this.bool_value; }
  ubyte   getUbyte()   { enforce(this.type == ValueType.Ubyte);
                         return this.ubyte_value; }
  auto    getNull()    { throw new Error("Can't get from NULL value"); }
  Value[] getArray()   { enforce(this.type == ValueType.Array);
                         return this.array_value; }
  ImmediateValue getImmediateValue() { enforce(this.type == ValueType.ImmediateValue);
                                       return this.imv_value; }
  SymbolValue    getSymbolValue()    { enforce(this.type == ValueType.SymbolValue);
                                       return this.sym_value; }
  IExpression    getIExpression()    { enforce(this.type == ValueType.IExpression);
                                       return this.ie_value; }
  ClassType      getClassType()      { enforce(this.type == ValueType.ClassType);
                                       return this.class_value; }
  IOperator      getIOperator()      { enforce(this.type == ValueType.IOperator);
                                       return this.io_value; }
  Closure        getClosure()        { enforce(this.type == ValueType.Closure);
                                       return this.closure_value; }
  Value[string]  getHashMap()        { enforce(this.type == ValueType.HashMap);
                                       return this.hashmap_value; }

  void opAssign(T)(T value) if (isNumeric!T) {
    this.init;
    this.numeric_value = value;
    this.type = ValueType.Numeric;
  }

  void opAssign(T)(T value) if (is(T == string)) {
    this.init;
    this.string_value = value;
    this.type         = ValueType.String;
  }

  void opAssign(bool value) {
    this.init;
    this.bool_value = value;
    this.type       = ValueType.Bool;
  }

  void opAssign(T)(T[] value) if (is(T == Value)) {
    this.init;
    this.array_value = value;
    this.type        = ValueType.Array;
  }

  void opAssign(T)(T[] value) if (!is(T == Value) && !is(T == immutable(char))) {
    this.init;
    this.array_value = [];

    foreach (e; value) this.array_value ~= new Value(e);

    this.type        = ValueType.Array;
  }

  void opAssign(IExpression value) {
    this.init;
    this.ie_value = value;
    this.type     = ValueType.IExpression;
  }

  void opAssign(ClassType value) {
    this.init;
    this.class_value = value;
    this.type        = ValueType.ClassType;
  }

  void opAssign(IOperator value) {
    this.init;
    this.io_value = value;
    this.type     = ValueType.IOperator;
  }

  void opAssign(Closure value) {
    this.init;
    this.closure_value = value;
    this.type          = ValueType.Closure;
  }

  void opAssign(Value[string] value) {
    this.init;
    this.hashmap_value = value;
    this.type          = ValueType.HashMap; 
  }

  override string toString() {
    final switch(this.type) with (ValueType) {
      case Numeric: return this.numeric_value.to!string;
      case String:  return this.string_value;
      case Bool:    return this.bool_value.to!string;
      case Ubyte:   return this.ubyte_value.to!string;
      case Null:    return "null";
      case Array:   return "[" ~ this.array_value.map!(value => value.toString).array.join(", ") ~ "]";
      case HashMap: return this.hashmap_value.to!string;
      case ImmediateValue: return this.imv_value.toString;
      case SymbolValue:    return this.sym_value.value;
      case IExpression:    return this.ie_value.stringof;
      case ClassType:      return this.class_value.stringof;
      case IOperator:      return this.io_value.stringof;
      case Closure:        return this.closure_value.stringof;
    }
  }

  void addTo(Value value) {
    enforce(this.type == value.type && value.type == ValueType.Numeric);
    this.numeric_value += value.getNumeric;
  }

  void subTo(Value value) {
    enforce(this.type == value.type && value.type == ValueType.Numeric);
    this.numeric_value -= value.getNumeric;
  }

  void mulTo(Value value) {
    enforce(this.type == value.type && value.type == ValueType.Numeric);
    this.numeric_value *= value.getNumeric;
  }

  void divTo(Value value) {
    enforce(this.type == value.type && value.type == ValueType.Numeric);
    this.numeric_value /= value.getNumeric;
  }

  void modTo(Value value) {
    enforce(this.type == value.type && value.type == ValueType.Numeric);
    this.numeric_value %= value.getNumeric;
  }

  Value opBinary(string op)(Value value) if (op == "+") {
    enforce(value.type == ValueType.Numeric);
    return new Value(this.numeric_value + value.getNumeric);
  }

  Value opBinary(string op)(Value value) if (op == "-") {
    enforce(value.type == ValueType.Numeric);

    return new Value(this.numeric_value - value.getNumeric);
  }

  Value opBinary(string op)(Value value) if (op == "*") {
    enforce(value.type == ValueType.Numeric);
    return new Value(this.numeric_value * value.getNumeric);
  }

  Value opBinary(string op)(Value value) if (op == "/") {
    enforce(value.type == ValueType.Numeric);
    return new Value(this.numeric_value / value.getNumeric);
  }

  Value opBinary(string op)(Value value) if (op == "%") {
    enforce(value.type == ValueType.Numeric);
    return new Value(this.numeric_value % value.getNumeric);
  }

  void init() {
    if (this.type != ValueType.Null) {
      if (this.type == ValueType.Numeric) { this.numeric_value = 0;  }
      if (this.type == ValueType.String)  { this.string_value  = ""; }
      if (this.type == ValueType.Array)   { this.array_value   = []; }
      if (this.type == ValueType.Bool)    { this.bool_value    = false; }
      if (this.type == ValueType.Ubyte)   { this.ubyte_value   = 0;  }
      if (this.type == ValueType.ImmediateValue) { this.imv_value = null; }
      if (this.type == ValueType.SymbolValue)    { this.sym_value = null; }
      if (this.type == ValueType.IExpression)    { this.ie_value  = null; }
      if (this.type == ValueType.ClassType)      { this.class_value   = null; }
      if (this.type == ValueType.IOperator)      { this.io_value      = null; }
      if (this.type == ValueType.Closure)        { this.closure_value = null; }
      if (this.type == ValueType.HashMap)        { this.hashmap_value = null; }

      this.type = ValueType.Null;
    }
  }

  Value opIndex() {
    enforce(this.type == ValueType.Array);

    return new Value;
  }

  Value opIndex(size_t idx) {
    enforce(this.type == ValueType.Array);

    if (!(idx < this.array_value.length)) {
      throw new Error("Out of index of the Array, orded - " ~ idx.to!string ~ " but length of the array is " ~ this.array_value.length.to!string);
    }

    return this.array_value[idx];
  }

  Value opIndex(Value value) {
    enforce(this.type == ValueType.HashMap);

    if (value.getString !in this.hashmap_value) {
      throw new Error("No such a key in the hash, key - " ~ value.toString ~ ", hash - " ~ this.hashmap_value.stringof);
    }

    return this.hashmap_value[value.getString];
  }

  override bool opEquals(Object _value) {
    if ((cast(Value)_value) is null) {
      throw new Error("Can not compare between incompatibility");
    }

    Value value = cast(Value)_value;

    if (this.type != value.type) {
      throw new Error("Can not compare between incompatibility type " ~ this.type.to!string ~ " and " ~ value.type.to!string);
    }

    final switch(this.type) with (ValueType) {
      case ImmediateValue:
        throw new Error("Can't compare with ImmediateValue");
      case SymbolValue:
        return this.sym_value.value == value.getSymbolValue.value;
      case IExpression:
        throw new Error("Can't compare with IExpression");
      case ClassType:
        throw new Error("Can't compare with ClassType");
      case IOperator:
        throw new Error("Can't compare with IOperator");
      case Closure:
        throw new Error("Can't compare with Closure");
      case HashMap:
        throw new Error("Can't compare with HashMap");
      case Numeric:
        return this.numeric_value == value.numeric_value;
      case String:
        return this.string_value  == value.string_value;
      case Bool:
        return this.bool_value    == value.bool_value;
      case Ubyte:
        return this.ubyte_value   == value.ubyte_value;
      case Null:
        throw new Error("Can't compare with Null");
      case Array:
        Value[] a = this.getArray,
                b = value.getArray;

        if (a.length != b.length) {
          return false;
        }

        foreach (idx; 0..(a.length)) {
          if (a[idx].opCmp(b[idx]) != 0) { return false; }
        }

        return true;
    }
  }

  override int opCmp(Object _value) {
    if ((cast(Value)_value) is null) {
      throw new Error("Can not compare between incompatibility");
    }

    Value value = cast(Value)_value;

    if (this.type != value.type) {
      throw new Error("Can not compare between incompatibility type " ~ this.type.to!string ~ " and " ~ value.type.to!string);
    }

    final switch(this.type) with (ValueType) {
      case ImmediateValue:
        throw new Error("Can't compare with ImmediateValue");
      case SymbolValue:
        auto c = this.sym_value.value,
             d = value.getSymbolValue.value;
        if (c == d) { return 0; }
        if (c < d)  { return -1; }
        return 1;
      case IExpression:
        throw new Error("Can't compare with IExpression");
      case ClassType:
        throw new Error("Can't compare with ClassType");
      case IOperator:
        throw new Error("Can't compare with IOperator");
      case Closure:
        throw new Error("Can't compare with Closure");
      case HashMap:
        throw new Error("Can't compare with HashMap");
      case Numeric:
        auto c = this.numeric_value,
             d = value.numeric_value;

        if (c == d) { return 0;  }
        if (c < d)  { return -1; }
        return 1;
      case String:
        auto c = this.string_value,
             d = value.string_value;

        if (c == d) { return 0;  }
        if (c < d)  { return -1; }
        return 1;
      case Ubyte:
        auto c = this.ubyte_value,
             d = value.ubyte_value;

        if (c == d) { return 0;  }
        if (c < d)  { return -1; }
        return 1;
      case Bool:
        throw new Error("Can't compare with Bool");
      case Null:
        throw new Error("Can't compare with Null");
      case Array:
        Value[] a = this.getArray,
                b = value.getArray;

        if (a.length != b.length) {
          throw new Error("Can't compare between different size array");
        }

        foreach (idx; 0..(a.length)) {
          if (a[idx].opCmp(b[idx]) != 0) { return 1; }
        }

        return 0;
    }
  }

  Value dup() {
    final switch (this.type) with (ValueType) {
      case ImmediateValue:
        return new Value(this.imv_value);
      case SymbolValue:
        return new Value(this.sym_value);
      case IExpression:
        return new Value(this.ie_value);
      case ClassType:
        return new Value(this.class_value);
      case IOperator:
        return new Value(this.io_value);
      case Closure:
        return new Value(this.closure_value);
      case HashMap:
        return new Value(this.hashmap_value);
      case Numeric:
        return new Value(this.numeric_value);
      case String:
        return new Value(this.string_value);
      case Bool:
        return new Value(this.bool_value);
      case Ubyte:
        return new Value(this.ubyte_value);
      case Null:
        return new Value;
      case Array:
        return new Value(this.array_value.dup);
    }
  }
}

で、上のValue.dを用いて書いた評価器全体が以下になります(エッセンスだけ切り抜こうと思ったんですけど面倒なのでコード全体を貼ります。実際に解説している箇所を見つけて呼んでください...)
また、パフォーマンスのためにLazedAssocArrayという型を用いて連想配列を遅延させています。それについては以前記事を書いたのでそれを参照してください。

D言語の連想配列で値としてクラスのインスタンスを格納する場合のパフォーマンスを向上させた

Engine.d

module orelang.Engine;

/**
 * Premitive Interfaces and Value Classes
 */
import orelang.expression.ImmediateValue,
       orelang.expression.CallOperator,
       orelang.expression.IExpression,
       orelang.expression.ClassType,
       orelang.operator.IOperator,
       orelang.Closure,
       orelang.Value;

/**
 * variables
 */
import orelang.operator.DatetimeOperators,
       orelang.operator.IsHashMapOperator,
       orelang.operator.TranspileOperator,
       orelang.operator.HashMapOperators,
       orelang.operator.DigestOperators,
       orelang.operator.DynamicOperator,
       orelang.operator.ForeachOperator,
       orelang.operator.StringOperators,
       orelang.operator.ArrayOperators,
       orelang.operator.AssertOperator,
       orelang.operator.ClassOperators,
       orelang.operator.DebugOperators,
       orelang.operator.DeffunOperator,
       orelang.operator.DefineOperator,
       orelang.operator.DefvarOperator,
       orelang.operator.FilterOperator,
       orelang.operator.GetfunOperator,
       orelang.operator.IsListOperator,
       orelang.operator.IsNullOperator,
       orelang.operator.LambdaOperator,
       orelang.operator.LengthOperator,
       orelang.operator.RemoveOperator,
       orelang.operator.SetIdxOperator,
       orelang.operator.StdioOperators,
       orelang.operator.AliasOperator,
       orelang.operator.ConvOperators,
       orelang.operator.CurlOperators,
       orelang.operator.EqualOperator,
       orelang.operator.FileOperators,
       orelang.operator.LogicOperator,
       orelang.operator.PathOperators,
       orelang.operator.PrintOperator,
       orelang.operator.TboxOperators,
       orelang.operator.TimesOperator,
       orelang.operator.UntilOperator,
       orelang.operator.UUIDOperators,
       orelang.operator.WhileOperator,
       orelang.operator.AsIVOperator,
       orelang.operator.CondOperator,
       orelang.operator.ConsOperator,
       orelang.operator.EvalOperator,
       orelang.operator.FoldOperator,
       orelang.operator.LoadOperator,
       orelang.operator.SortOperator,
       orelang.operator.StepOperator,
       orelang.operator.TypeOperator,
       orelang.operator.UriOperators,
       orelang.operator.WhenOperator,
       orelang.operator.AddOperator,
       orelang.operator.CarOperator,
       orelang.operator.CdrOperator,
       orelang.operator.DivOperator,
       orelang.operator.GetOperator,
       orelang.operator.LetOperator,
       orelang.operator.MapOperator,
       orelang.operator.MulOperator,
       orelang.operator.ModOperator,
       orelang.operator.SetOperator,
       orelang.operator.SeqOperator,
       orelang.operator.SubOperator,
       orelang.operator.IfOperator;
import orelang.operator.RegexClass,
       orelang.operator.FileClass;

import std.exception;

/**
 * Lazed Associative Array
 *
 * For instance;
 *   assocArray["key"] = new ValueType
 *  The above code create a new instance of ValueType with some consts(memory amount and time).
 * However it likely to be a bobottleneck if the value isn't needed.
 * Then this class provides lazed associative array, this class willn't create an instance until the value become needed.
 * In other words, this is sort of lazy evaluation for performance.
 */
class LazedAssocArray(T) {
  /**
   * Flags, indicates whether the instance of the key is already created  
   */
  bool[string] called;
  /**
   * This variable holds the instance as a value of hashmap.
   */
  T[string]    storage;
  /**
   * This variable holds the constructor calling delegate to make the instance which will be called when the isntance become needed.
   */
  T delegate()[string] constructors;
  bool[string] alwaysNew;

  alias storage this;

  /**
   * This function works like:
   *  // laa is an instance of LazedAssocArray
   *  laa["key"] = new T;
   * with following way:
   *  laa.insert!("key", "new T");
   *
   * This function uses string-mixin for handling "new T", becase D can't allow make an alias of the expr liek `new T`
   */
  void insert(string key, string value, bool always = false)() {
    constructors[key] = mixin("delegate T () { return " ~ value ~ ";}");
    called[key]       = false;

    if (always) {
      alwaysNew[key] = true;
    }
  }

  void insert(string key, T delegate() value, bool always = false)() {
    constructors[key] = value;
    called[key]       = false;

    if (always) {
      alwaysNew[key] = true;
    }
  }

  void insert(string key, T function() value, bool always = false)() {
    constructors[key] = () => value();
    called[key]       = false;

    if (always) {
      alwaysNew[key] = true;
    }
  }

  void insert(string key, T delegate() value, bool always = false) {
    constructors[key] = value;
    called[key]       = false;

    if (always) {
      alwaysNew[key] = true;
    }
  }

  void insert(string key, T function() value, bool always = false) {
    constructors[key] = () => value();
    called[key]       = false;

    if (always) {
      alwaysNew[key] = true;
    }
  }

  /**
   * Set the value with the key.
   * This function works like:
   *  laa["key"] = value;
   * with
   * laa.set("key", value) 
   */
  void set(string key, T value) {
    storage[key] = value;
    called[key]  = true;
  }

  /**
   * Make an alias of the key
   */
  void link(string alternative, string key) {
    const flag = called[key];
    called[alternative] = flag;

    if (flag) {
      storage[alternative] = storage[key];
    } else {
      constructors[alternative] = constructors[key];
    }
  }

  /**
   * An overloaded function of opIndexAssing
   * This function hooks: laa["key"] = value; event but this function might be no use
   */
  void opIndexAssing(T value, string key) {
    storage[key] = value;
    called[key] = true;
  }

  /**
   * An overloaded function of opIndex
   * This function hooks: laa["key"] event.
   */ 
  T opIndex(string key) {
    if (key in called && key in alwaysNew) {
      return constructors[key]();
    }

    if (!called[key]) {
      T newT = constructors[key]();

      storage[key] = newT;
      called[key]  = true;

      return newT;
    }

    return storage[key];
  }
}

/**
 * Script Engine of ChickenClisp
 */
class Engine {
  enum ConstructorMode {
    CLONE
  }

  // Debug flags for Engine
  bool debug_get_expression = false;

  /**
   * This holds variables and operators.
   * You can distinguish A VALUE of the child of this from whether a varibale or an operator.
   */
  LazedAssocArray!Value variables;

  bool sync_storage;

  /**
   * Default Constructor
   */
  this() {
    this.variables = new LazedAssocArray!Value;

    // オペレーターを登録する。    

    // Arithmetic operations
    this.variables.insert!("+",        q{new Value(cast(IOperator)(new AddOperator))});
    this.variables.insert!("-",        q{new Value(cast(IOperator)(new SubOperator))});
    this.variables.insert!("*",        q{new Value(cast(IOperator)(new MulOperator))});
    this.variables.insert!("/",        q{new Value(cast(IOperator)(new DivOperator))});
    this.variables.insert!("%",        q{new Value(cast(IOperator)(new ModOperator))});

    // Comparison operators
    this.variables.insert!("=",        q{new Value(cast(IOperator)(new EqualOperator))});
    this.variables.insert!("<",        q{new Value(cast(IOperator)(new LessOperator))});
    this.variables.insert!(">",        q{new Value(cast(IOperator)(new GreatOperator))});
    this.variables.insert!("<=",       q{new Value(cast(IOperator)(new LEqOperator))});
    this.variables.insert!(">=",       q{new Value(cast(IOperator)(new GEqOperator))});

    // Varibale/Function operators
    this.variables.insert!("def",      q{new Value(cast(IOperator)(new DeffunOperator))});
    this.variables.insert!("set",      q{new Value(cast(IOperator)(new SetOperator))});
    this.variables.insert!("set-p",    q{new Value(cast(IOperator)(new SetPOperator))});
    this.variables.insert!("set-c",    q{new Value(cast(IOperator)(new SetCOperator))});
    this.variables.insert!("get",      q{new Value(cast(IOperator)(new GetOperator))});
    this.variables.insert!("let",      q{new Value(cast(IOperator)(new LetOperator))});
    this.variables.insert!("as-iv",    q{new Value(cast(IOperator)(new AsIVOperator))});
    this.variables.insert!("define",   q{new Value(cast(IOperator)(new DefineOperator))});
    this.variables.insert!("def-var",  q{new Value(cast(IOperator)(new DefvarOperator))});
    this.variables.insert!("get-fun",  q{new Value(cast(IOperator)(new GetfunOperator))});
    this.variables.insert!("set-idx",  q{new Value(cast(IOperator)(new SetIdxOperator))});

    // Loop operators
    this.variables.insert!("step",     q{new Value(cast(IOperator)(new StepOperator))});
    this.variables.insert!("times",    q{new Value(cast(IOperator)(new TimesOperator))});
    this.variables.insert!("until",    q{new Value(cast(IOperator)(new UntilOperator))});
    this.variables.insert!("while",    q{new Value(cast(IOperator)(new WhileOperator))});

    // Logic operators
    this.variables.insert!("!",        q{new Value(cast(IOperator)(new NotOperator))});
    this.variables.insert!("&&",       q{new Value(cast(IOperator)(new AndOperator))});
    this.variables.insert!("||",       q{new Value(cast(IOperator)(new OrOperator))});

    // I/O operators
    this.variables.insert!("print",    q{new Value(cast(IOperator)(new PrintOperator))});
    this.variables.insert!("println",  q{new Value(cast(IOperator)(new PrintlnOperator))});
    
    // Condition operators
    this.variables.insert!("if",       q{new Value(cast(IOperator)(new IfOperator))});
    this.variables.insert!("cond",     q{new Value(cast(IOperator)(new CondOperator))});
    this.variables.insert!("when",     q{new Value(cast(IOperator)(new WhenOperator))});
    
    // Functional operators
    this.variables.insert!("lambda",   q{new Value(cast(IOperator)(new LambdaOperator))});
    this.variables.insert!("map",      q{new Value(cast(IOperator)(new MapOperator))});
    this.variables.insert!("for-each", q{new Value(cast(IOperator)(new ForeachOperator))});
    this.variables.insert!("fold",     q{new Value(cast(IOperator)(new FoldOperator))});
    this.variables.insert!("filter",   q{new Value(cast(IOperator)(new FilterOperator))});

    // List operators
    this.variables.insert!("car",      q{new Value(cast(IOperator)(new CarOperator))});
    this.variables.insert!("cdr",      q{new Value(cast(IOperator)(new CdrOperator))});
    this.variables.insert!("seq",      q{new Value(cast(IOperator)(new SeqOperator))});
    this.variables.insert!("cons",     q{new Value(cast(IOperator)(new ConsOperator))});
    this.variables.insert!("sort",     q{new Value(cast(IOperator)(new SortOperator))});
    this.variables.insert!("list?",    q{new Value(cast(IOperator)(new IsListOperator))});
    this.variables.insert!("remove",   q{new Value(cast(IOperator)(new RemoveOperator))});
    this.variables.insert!("length",   q{new Value(cast(IOperator)(new LengthOperator))});

    // HashMap operators
    this.variables.insert!("new-hash",         q{new Value(cast(IOperator)(new NewHashOperator))});
    this.variables.insert!("make-hash",        q{new Value(cast(IOperator)(new MakeHashOperator))});
    this.variables.insert!("hash-set-value",   q{new Value(cast(IOperator)(new HashSetValueOperator))});
    this.variables.insert!("hash-get-value",   q{new Value(cast(IOperator)(new HashGetValueOperator))});
    this.variables.insert!("hash-get-keys",    q{new Value(cast(IOperator)(new HashGetKeysOperator))});
    this.variables.insert!("hash-get-values",  q{new Value(cast(IOperator)(new HashGetValuesOperator))});

    // String operators
    this.variables.insert!("string-concat",    q{new Value(cast(IOperator)(new StringConcatOperator))});
    this.variables.insert!("string-join",      q{new Value(cast(IOperator)(new StringJoinOperator))});
    this.variables.insert!("string-split",     q{new Value(cast(IOperator)(new StringSplitOperator))});
    this.variables.insert!("string-length",    q{new Value(cast(IOperator)(new StringLengthOperator))});
    this.variables.insert!("string-slice",     q{new Value(cast(IOperator)(new StringSliceOperator))});
    this.variables.insert!("as-string",        q{new Value(cast(IOperator)(new AsStringOperator))});
    this.variables.insert!("string-repeat",    q{new Value(cast(IOperator)(new StringRepeatOperator))});
    this.variables.insert!("string-chomp",     q{new Value(cast(IOperator)(new StringChompOperator))});

    // Conversion operators
    this.variables.insert!("number-to-string", q{new Value(cast(IOperator)(new numberToStringOperator))});
    this.variables.insert!("number-to-char",   q{new Value(cast(IOperator)(new numberToCharOperator))});
    this.variables.insert!("char-to-number",   q{new Value(cast(IOperator)(new charToNumberOperator))});
    this.variables.insert!("float-to-integer", q{new Value(cast(IOperator)(new floatToIntegerOperator))});
    this.variables.insert!("ubytes-to-string", q{new Value(cast(IOperator)(new ubytesToStringOperator))});
    this.variables.insert!("ubytes-to-integers", q{new Value(cast(IOperator)(new ubytesToIntegersOperator))});
    
    // Array Operators
    this.variables.insert!("array-new",        q{new Value(cast(IOperator)(new ArrayNewOperator))});
    this.variables.insert!("array-get-n",      q{new Value(cast(IOperator)(new ArrayGetNOperator))});
    this.variables.insert!("array-set-n",      q{new Value(cast(IOperator)(new ArraySetNOperator))});
    this.variables.insert!("array-slice",      q{new Value(cast(IOperator)(new ArraySliceOperator))});
    this.variables.insert!("array-append",     q{new Value(cast(IOperator)(new ArrayAppendOperator))});
    this.variables.insert!("array-concat",     q{new Value(cast(IOperator)(new ArrayConcatOperator))});
    this.variables.insert!("array-length",     q{new Value(cast(IOperator)(new ArrayLengthOperator))});
    this.variables.insert!("array-flatten",    q{new Value(cast(IOperator)(new ArrayFlattenOperator))});
    this.variables.insert!("array-reverse",    q{new Value(cast(IOperator)(new ArrayReverseOperator))});

    // Utility operators
    this.variables.insert!("eval",      q{new Value(cast(IOperator)(new EvalOperator))});
    this.variables.insert!("load",      q{new Value(cast(IOperator)(new LoadOperator))});
    this.variables.insert!("type",      q{new Value(cast(IOperator)(new TypeOperator))});
    this.variables.insert!("alias",     q{new Value(cast(IOperator)(new AliasOperator))});
    this.variables.insert!("assert",    q{new Value(cast(IOperator)(new AssertOperator))});
    this.variables.insert!("is-null?",  q{new Value(cast(IOperator)(new IsNullOperator))});
    this.variables.insert!("is-hash?",  q{new Value(cast(IOperator)(new IsHashMapOperator))});
    this.variables.insert!("transpile", q{new Value(cast(IOperator)(new TranspileOperator))});

    // Curl Operators
    this.variables.insert!("curl-download",    q{new Value(cast(IOperator)(new CurlDownloadOperator))});
    this.variables.insert!("curl-upload",      q{new Value(cast(IOperator)(new CurlUploadOperator))});
    this.variables.insert!("curl-get",         q{new Value(cast(IOperator)(new CurlGetOperator))});
    this.variables.insert!("curl-get-string",  q{new Value(cast(IOperator)(new CurlGetStringOperator))});
    this.variables.insert!("curl-post",        q{new Value(cast(IOperator)(new CurlPostOperator))});
    this.variables.insert!("curl-post-string", q{new Value(cast(IOperator)(new CurlPostStringOperator))});

    // Uri Operators
    this.variables.insert!("url-encode-component", q{new Value(cast(IOperator)(new UrlEncodeComponentOperator))});

    // UUID Operators
    this.variables.insert!("random-uuid",          q{new Value(cast(IOperator)(new RandomUUIDOperator))});

    // Datetime Operators
    this.variables.insert!("get-current-unixtime", q{new Value(cast(IOperator)(new GetCurrentUNIXTime))});

    // Digest Operators
    this.variables.insert!("hmac-sha1",            q{new Value(cast(IOperator)(new HMACSHA1Operator))});

    // Debug Operators
    this.variables.insert!("dump-variables", q{new Value(cast(IOperator)(new DumpVaribalesOperator))});
    this.variables.insert!("peek-closure",   q{new Value(cast(IOperator)(new PeekClosureOperator))});
    this.variables.insert!("call-closure",   q{new Value(cast(IOperator)(new CallClosureOperator))});
    this.variables.insert!("toggle-ge-dbg",  q{new Value(cast(IOperator)(new ToggleGEDebugOperator))});

    // Class Operators
    this.variables.insert!("class",          q{new Value(cast(IOperator)(new ClassOperator))});
    this.variables.insert!("new",            q{new Value(cast(IOperator)(new NewOperator))});

    // Path Operators
    this.variables.insert!("path-exists",    q{new Value(cast(IOperator)(new PathExistsOperator))});
    this.variables.insert!("path-is-dir",    q{new Value(cast(IOperator)(new PathIsDirOperator))});
    this.variables.insert!("path-is-file",   q{new Value(cast(IOperator)(new PathIsFileOperator))});

    // File Operators
    this.variables.insert!("remove-file",    q{new Value(cast(IOperator)(new RemoveFileOperator))});
    this.variables.insert!("remove-dir",     q{new Value(cast(IOperator)(new RemoveDirOperator))});
    this.variables.insert!("get-cwd",        q{new Value(cast(IOperator)(new GetcwdOperator))});
    this.variables.insert!("get-size",       q{new Value(cast(IOperator)(new GetsizeOperator))});

    // STDIO Operators
    this.variables.insert!("readln",         q{new Value(cast(IOperator)(new ReadlnOperator))});
    this.variables.insert!("stdin-by-line",  q{new Value(cast(IOperator)(new StdinByLINEOperator))});

    // Aliases
    this.variables.link("not", "!");
    this.variables.link("and", "&&");
    this.variables.link("or",  "||");
    this.variables.link("begin", "step");

    // Classes
    this.variables.insert("FileClass",  () => new Value(cast(ClassType)(new FileClass(this))), true);
    this.variables.insert("Regex",      () => new Value(cast(ClassType)(new RegexClass(this))), true);

    // Termbox Operators
    this.variables.insert!("tbox-init",     q{new Value(cast(IOperator)(new TboxInitOperator))});
    this.variables.insert!("tbox-clear",    q{new Value(cast(IOperator)(new TboxInitOperator))});
    this.variables.insert!("tbox-shutdown", q{new Value(cast(IOperator)(new TboxShutdownOperator))});
    this.variables.insert!("tbox-set-cell", q{new Value(cast(IOperator)(new TboxSetCellOperator))});
    this.variables.insert!("tbox-flush",    q{new Value(cast(IOperator)(new TboxFlushOperator))});
    this.variables.insert!("tbox-poll-key", q{new Value(cast(IOperator)(new TboxPollKeyOperator))});
    this.variables.insert!("tbox-width",    q{new Value(cast(IOperator)(new TboxWidthOperator))});
    this.variables.insert!("tbox-height",   q{new Value(cast(IOperator)(new TboxHeightOperator))});
  }

  /**
   * Constructor to make a clone
   */
  this(ConstructorMode mode) {}

  /**
   * Super Class for a cloned object
   */
  private Engine _super;

  Engine peekSuper() {
    return this._super;
  }

  /**
   * Clone this object
   */
  Engine clone() {
    Engine newEngine = new Engine(ConstructorMode.CLONE);

    newEngine._super = this;

    newEngine.variables = new LazedAssocArray!Value;

    if (!sync_storage) {
      newEngine.variables.called       = this.variables.called.dup;
      newEngine.variables.constructors = this.variables.constructors;
      newEngine.variables.storage      = this.variables.storage.dup;
    } else {
      newEngine.variables.called       = this.variables.called;
      newEngine.variables.constructors = this.variables.constructors;
      newEngine.variables.storage      = this.variables.storage;
    }

    return newEngine;
  }

  /**
   * Define new variable
   */
  public Value defineVariable(string name, Value value) {
    this.variables.set(name, value.dup);

    return value;
  }

  /**
   * Set a value into certain variable
   */
  public Value setVariable(string name, Value value) {
    Engine engine = this;

    while (true) {
      if (name in engine.variables.called) {
        engine.variables.set(name, value.dup);
        return value;
      } else if (engine._super !is null) {
        engine = engine._super;
      } else {
        engine.defineVariable(name, value);
      }
    }
  }

  /**
   * Get a value from variables table
   */ 
  public Value getVariable(string name) {
    Engine engine = this;

    while (true) {
      if (name in engine.variables.called) {
        return engine.variables[name];
      } else if (engine._super !is null) {
        engine = engine._super;
      } else {
        return new Value;
      }
    }
  }

  /**
   * Evalute Object
   * 評価器本体。getExpressionを呼ぶことでパースして得られたValueを処理していく。
   */
  public Value eval(Value script) {
    Value ret = new Value(this.getExpression(script));

    if (ret.type == ValueType.IOperator) {
      return ret;
    }

    enforce(ret.type == ValueType.IExpression);

    ret = ret.getIExpression.eval(this);

    if (ret.type == ValueType.IOperator) {
      return new Value(new Closure(this, ret.getIOperator));
    } else {
      return ret;
    }
  }

  /**
   * getExpression
   * Build Script Tree
   * 
   * 与えられたValue scriptのscript.typeを見て処理を決定していく。
   * ここが(ChickenClispのコア中のコアといえるので)1番解説すべき場所だと思う。
   */
  public IExpression getExpression(Value script) {
    if (debug_get_expression) {
      import std.stdio;
      writeln("[getExpression] script -> ", script);
    }

    // 即値を受け取った場合にreturn
    if (script.type == ValueType.ImmediateValue) {
      return script.getImmediateValue;
    }

    // 配列を受け取った場合、それは関数/オペレーター呼び出しなので適用したりいい感じにする。
    if (script.type == ValueType.Array) {
      Value[] scriptList = script.getArray;//配列本体をscriptから取り出す。

      if (scriptList[0].type == ValueType.Array) {
        /* 関数/オペレーターを取り出す。
         * ここで未定義のものが`scriptList[0][0].getString`に入ってるとLazedAssocArrayでエラーが出る。
         * エラー補足をしたほうがいいかもだけど面倒くさいので後回しにしてる。 */
        Value op = this.variables[scriptList[0][0].getString];

        if (op.type == ValueType.Closure) { // opがクロージャーの場合。(これはクラスの実装になってる) opとは(a b c)のaに当たる部分であり、ここにクロージャーが来るとChickenClispではaをクラスのインスタンスとして扱う。
          Closure   closure  = op.getClosure; //クロージャーを取り出す。
          Engine    engine   = closure.engine; //クロージャーからengineを取り出す。
          IOperator operator = closure.operator; // クロージャーからオペレーターを取り出す。

          // オペーレーターをコールする。
          Closure cls = operator.call(engine, scriptList[0].getArray[1..$]).getClosure;

          // クロージャーを評価する(実際に引数を適用する)
          if (scriptList.length == 2) {
            return new ImmediateValue(cls.eval(scriptList[1..$]));
          } else {
            return new ImmediateValue(cls.eval([]));
          }
        } else if (op.type == ValueType.IOperator) { // opが関数だった場合
          // 関数を呼び出す場合にオペーレーターと引数をセットして呼び出す準備を行う。(オペーレーター(関数)を呼び出すためのクラスCallOperatorを使う)
          CallOperator ret = new CallOperator(
                                this.variables[scriptList[0][0].getString].getIOperator,
                                scriptList[0].getArray[1..$]);
          // retを評価することで戻り値を得る。
          Value        tmp = ret.eval(this);

          /* 戻り値が何かで場合分けする。
           * 入れ子になってる場合、つまり
           * ((a b c) d e f)
           * (a b c)も戻り値にd e f を適用したりとかするための実装である*/
          if (tmp.type == ValueType.Closure) {
            // クロージャーの場合、上で言うd e f(つまり引数)をクロージャーに適用する。
            return new ImmediateValue(tmp.getClosure.eval(scriptList[1..$]));
          } else if (tmp.type == ValueType.IOperator) {
           /* 関数呼び出しのネストを処理。
            * 上で言うaが高階関数である場合にその戻り値として帰ってきた関数にd e fを適用する。*/
            return new ImmediateValue(tmp.getIOperator.call(this, scriptList[1..$]));
          } else if (tmp.type == ValueType.ClassType) {
            /* クラスが帰ってきた場合、クラスに引数を適用する。
             * ((cls) a)これはaが変数の場合cls.aを参照し、関数の場合呼び出す(インスタンス関数)
             * ((cls) a b c)これはcls.a(b, c)という様な感じになる。*/
            ClassType cls = tmp.getClassType;
            return new ImmediateValue(cls.call(cls._engine, scriptList[1..$]));
          }
        } else {
          throw new Error("Invalid Operator was given!");
        }
      }

      // ここまで来た場合scriptはネストのない適用なので普通にそのままevalをしたりCallOperatorを呼んだりする。
      Value tmp = this.variables[scriptList[0].getString];

      if (tmp.type == ValueType.IOperator) {
        IOperator op = tmp.getIOperator;
        return new CallOperator(op, scriptList[1..$]);
      } else if (tmp.type == ValueType.Closure) {
        return new CallOperator(tmp.getClosure.operator, scriptList[1..$]);
      } else if (tmp.type == ValueType.ClassType) {
        ClassType cls = tmp.getClassType;
        return new ImmediateValue(cls.call(cls._engine, scriptList[1..$]));
      } else {
        throw new Error("Invalid Operator was given!");
      }
    } else {
      /* シンボルか文字列の場合ここに来る。
       * シンボルの場合は変数/関数の定義(this.variables)から参照して返す。*/
      if (script.type == ValueType.SymbolValue || script.type == ValueType.String) {
        if (script.type == ValueType.SymbolValue) {
          Value tmp;
          tmp = this.getVariable(script.getString).dup;

          if (tmp.type != ValueType.Null) {
            return new ImmediateValue(tmp);
          }
        } else {
          // 文字列の場合は即値として返す。
          return new ImmediateValue(new Value(script.getString));
        }
      }

      // その他の値は即値で返す。(数値とか)
      return new ImmediateValue(script);
    }
  }

  public bool variableDefined(string name) {
    return this.getVariable(name).type != ValueType.Null;
  }
}

ここまでで、ChickenClispのコアについて書いちゃったので後は面白いかもしれないと個人的に思った部分についての解説を行います。
あ、忘れる前に下の記事でIOperatorは紹介しますがその他の内部で使われてるクラスやインターフェイスをここで紹介しておきます(と言ってもコードを張るだけですが)

式を表すインターフェイス

IExpression.d

module orelang.expression.IExpression;
import orelang.Engine,
       orelang.Value;

interface IExpression {
  Value eval(Engine engine);
}

####即値のImmediateValue

ImmediateValue.d

module orelang.expression.ImmediateValue;
import orelang.expression.IExpression,
       orelang.Engine,
       orelang.Value;
import std.string,
       std.conv;

class ImmediateValue : IExpression {
  Value value;

  this(Value value) {
    this.value = value;
  }

  public Value eval(Engine engine) {
    return this.value;
  }

  override string toString() {
    string base = "ImmediateValue {";
    string _body;

    if (value.type == ValueType.Array) {
      string[] elems;

      foreach (elem; value.getArray) {
        elems ~= elem.toString;
      }

      _body = "[" ~ elems.join(", ") ~ "]"; 
    } else {
      _body = value.toString;
    }

    return base ~ _body ~ "}";
  }
}

####シンボル

SymbolValue.d

module orelang.expression.SymbolValue;
import orelang.expression.IExpression,
       orelang.Engine,
       orelang.Value;
import std.string,
       std.conv;

class SymbolValue : IExpression {
  string value;

  this(string value) {
    this.value = value;
  }

  public Value eval(Engine engine) {
    return new Value(this.value);
  }

  override string toString() {
    return "SymbolValue(" ~ this.value ~ ")";
  }
}

関数呼び出し用のクラス

CallOperator.d

module orelang.expression.CallOperator;
import orelang.expression.IExpression,
       orelang.operator.IOperator,
       orelang.Closure,
       orelang.Engine,
       orelang.Value;

class CallOperator : IExpression {
  private {
    IOperator operator;
    Value[] args;
  }

  this(IOperator operator, Value[] args) {
    this.operator = operator;
    this.args     = args;
  }

  /**
   * eval
   */
  public Value eval(Engine engine) {
    Closure closure = engine.eval(new Value(this.operator)).getClosure;

    return closure.eval(this.args);
  }
}

##関数の実装について
ChickenClispでは2種類の関数が存在します(厳密に言えばクラスも入るので4種類になりますがここではクラスは無視します。クラスも大体この2種類に対応するので)。
それはD言語側で実装した組み込み関数とChickenClisp側で定義される関数です。
まずはじめにDの言語側で関数を実装する場合はどのようになっているかについて書きます。
また、ここでは関数の呼び出しについても書きます。(割りと雑に実装しています)。

D側の話をするとは書きましたが共通の部分も多いのでまずは共通部分の説明を行います。
ChickenClispでは関数はIOperatorというインターフェイスを継承したクラスという形で実装します。D言語側で関数を実装する場合は直接IOperatorを継承し、ChickenClisp側から実装する場合はDynamicOperator(これはIOperatorを継承しています。)を用いて間接的に定義します。

IOperatorとは次のような定義です。

IOperator.d

module orelang.operator.IOperator;
import orelang.Engine,
       orelang.Value;

interface IOperator {
  Value call(Engine engine, Value[] args);
}

つまり、関数はValue call(Engine engine, Value[] args);を実装していればいいということです。
engineが環境を保持し、argsが引数です。関数がコールされるときはこれが内部でコールされています。
それではDでの実装について実装の例を上げてみます。

###D言語側で関数を定義する例

module orelang.operator.PrintOperator;
import orelang.operator.IOperator,
       orelang.Engine,
       orelang.Value;
import std.algorithm,
       std.range,
       std.stdio,
       std.conv;

class PrintOperator : IOperator {
  /**
   * call
   */
  public Value call(Engine engine, Value[] args) {
    foreach (arg; args) {
      Value item = engine.eval(arg);

      if (arg.type == ValueType.String || (arg.type == ValueType.SymbolValue && (item.type == ValueType.IExpression || item.type == ValueType.ImmediateValue || item.type == ValueType.IOperator))) {
        item = arg;
      }

      if (item.type == ValueType.Array) {
        write("(");
        write(item.getArray.map!(e => e.toString).join(" "));
        write(")");
      } else {
        write(item.toString());
      }
    }

    return new Value(0.0);
  }
}

class PrintlnOperator : IOperator {
  /**
   * call
   */
  public Value call(Engine engine, Value[] args) {
    foreach (arg; args) {
      Value item = engine.eval(arg);

      if (arg.type == ValueType.String || (arg.type == ValueType.SymbolValue && (item.type == ValueType.IExpression || item.type == ValueType.ImmediateValue || item.type == ValueType.IOperator))) {
        item = arg;
      }

      if (item.type == ValueType.Array) {
        write("(");
        write(item.getArray.map!(e => e.toString).join(" "));
        write(")");
      } else {
        write(item.toString());
      }
    }

    writeln;

    return new Value(0.0);
  }
}

このように書くことでprintとprintlnを実装します。ただ、これではprintやprintlnをChickenClispに登録できないのでEngineで登録します。それが

// I/O operators
this.variables.insert!("print",    q{new Value(cast(IOperator)(new PrintOperator))});
this.variables.insert!("println",  q{new Value(cast(IOperator)(new PrintlnOperator))});

です。

PrintOperatorとPrintlnOperatorのインスタンスをそれぞれprintとprintlnに束縛することでChickenClisp側から使えるようになっています。

ChickenClispで関数を定義する

ChickenClispでは関数実装を基本的に無名関数として実装しています。
そして、関数定義はそれを環境に名前で束縛することで行っています。
ここでは、関数の実装を行うDynamicOperatorとそれを用いて実際に登録するDeffunOperatorを解説します。
DynamicOperatorが無名関数を実現するためのクラスです。
実装は以下のようになります。

DynamicOperator.d

module orelang.operator.DynamicOperator;
import orelang.operator.IOperator,
       orelang.Engine,
       orelang.Value;

/**
 * Dynamic Operator
 */

class DynamicOperator : IOperator {
  private {
    // 引数名リスト
    string[] funcArgs;
    // 関数本体
    Value    funcBody;
  }

  this (string[] funcArgs, Value funcBody) {
    // 引数と関数本体をセットする。
    this.funcArgs = funcArgs;
    this.funcBody = funcBody;
  }

  public Value call(Engine engine, Value[] args) {
    /* 関数がコールされたときにここが呼び出される。
     * 引数は引数名を変数名として渡された実引数を束縛し
     * 普通の変数と同等のものとして受け渡しを実現している。
     */
    size_t i;
    // 関数内部ではスコープを分けるために環境を複製する。(こうしないと引数が親のスコープにも変数として定義されてしまうなどの問題が発生する。)
    Engine _engine = engine.clone;

    // ここで引数を変数として定義する。
    foreach (arg; this.funcArgs) {
      _engine.defineVariable(arg, engine.eval(args[i++]));
    }

    // ここで関数本体を評価する。
    return _engine.eval(this.funcBody);
  }

  override string toString() {
    string base = "orelang.operator.DynamicOperator.DynamicOperator {";
    import std.string;
    string _body = "[funcArgs : [" ~ funcArgs.join(", ") ~ "], " ~ "funcBody : " ~ funcBody.toString ~ "]";

    return base ~ _body ~ "}";
  }
}

ポイントは上のクラスは関数名に依存しないということがポイントです。それゆえに、これで無名関数が実現できるというからくりです。
そして、実際にChickenClispで関数を定義する場合は次のように書きます。

(def square (x)
  (* x x))

ここでdefはDeffunOperatorが呼び出されます。これが(square 5)と呼ばれると

(def-var x 5)
(* x x)

が実行され、その値25がリターンされるという仕組みになっています。

さて、そのDeffunOperatorは次のように実装します。

DeffunOperator.d

module orelang.operator.DeffunOperator;
import orelang.operator.DynamicOperator,
       orelang.operator.IOperator,
       orelang.Engine,
       orelang.Value;
import std.algorithm,
       std.array;

class DeffunOperator : IOperator {
  /**
   * call
   */
  public Value call(Engine engine, Value[] args) {
    string funcName   = args[0].getString;// 関数名を受け取る。
    string[] funcArgs = args[1].getArray.map!(value => value.getString).array;//引数名リストを得る。
    Value funcBody    = args[2];//これが関数本体

    // 環境に関数を登録する。
    return engine.defineVariable(funcName, new Value(cast(IOperator)(new DynamicOperator(funcArgs, funcBody))));
  }
}

このようにして実現されています。

さらっと書きましたが、ChickenClispでは関数への引数の受け渡しは普通の変数と同等のものとして内部で扱われています。具体的には、関数本体が実行される直前に引数名にそれに対応する値を引数として渡された値列を元に変数を定義することで実現しています。
なお、こんな感じの実装なのでChickenClispはオーバーロードが出来ません。(引数の数のチェックをしてないし)

ラムダ式の実装について

もう説明するまでも無い気はしますが、単純です。
DynamicOperatorを呼べばいいだけです。

LambdaOperator.d

module orelang.operator.LambdaOperator;
import orelang.operator.DynamicOperator,
       orelang.operator.IOperator,
       orelang.Engine,
       orelang.Value;
import std.algorithm,
       std.array;

class LambdaOperator : IOperator {
  /**
   * call
   */
  public Value call(Engine engine, Value[] args) {
    string[] funcArgs = args[0].getArray.map!(value => value.getString).array;// 引数リストを得る。
    Value funcBody    = args[1]; // 関数本体を得る。

    // DynamicOperatorを呼んで関数を生成しreturnする。
    return new Value(new DynamicOperator(funcArgs, funcBody));
  }
}

クロージャーの実装について

クロージャーの実装も簡単です。
クロージャーは環境を閉じ込めた状態の関数と考えることが出来ます。
なので環境と関数を一つの枠にまとめて上げればいいわけなので次のように実装します。

Closure.d

module orelang.Closure;
import orelang.operator.IOperator,
       orelang.Engine,
       orelang.Value;

class Closure {
  public {
    Engine    engine;
    IOperator operator;
  }

  this (Engine engine, IOperator operator) {
    this.engine   = engine;
    this.operator = operator;
  }

  Value eval(Value[] args) {
    return this.operator.call(this.engine, args);
  }
}

これでクロージャーが実現できます。(めっちゃ楽)

クラスの実装について

クラスの実装は上で作ったクロージャーを使います。
というのも、クラスのインスタンスはインスタンス変数などの状態を持ちます。
そのために環境を保持するためにクロージャーを使うといいと言うわけです。
実装はClassTypeという型とクラスに関する機能(newとかcallとか(これでインスタンス変数を参照したりインスタンス関数を実現する))を実装するClassOperatorsを実装します。

まずは、ClassTypeから。

ClassType.d

module orelang.expression.ClassType;
import orelang.Engine,
       orelang.Value;

class ClassType {
  Engine _engine;

  this(Engine _engine) {
    this._engine   = _engine;
  }

  /* インスタンス変数やインスタンス関数の呼び出しとかを行う。簡単な実装なので解説は割愛します。 */
  public Value call(Engine engine, Value[] args) {
    string funcName;

    if (args[0].type == ValueType.SymbolValue) {
      funcName = args[0].getString;
    } else {
      funcName = engine.eval(args[0]).getString;
    }

    Value member = this._engine.variables[funcName];

    if (member.type == ValueType.IOperator) {
      return member.getIOperator.call(this._engine, args.length > 1 ? args[1..$] : (Value[]).init);
    } else {
      return member;
    }
  }
}

続いて、ClassOperators。

ClassOperators.d

module orelang.operator.ClassOperators;
import orelang.operator.DynamicOperator,
       orelang.expression.ClassType,
       orelang.operator.IOperator,
       orelang.Closure,
       orelang.Engine,
       orelang.Value;

/* ChickenClispではClassを書くときに
 * (class クラス名
 *   クラスの実装)
 * とかく。ここではその`class`関数(構文のように見えるが実際は普通の関数と変わらない)を実装する。
 */
class ClassOperator : IOperator {
  public Value call(Engine engine, Value[] args) {
    string className = engine.eval(args[0]).getString;
    Engine cEngine   = engine.clone;

    if (args.length > 1) {
      foreach (member; args[1..$]) {
        cEngine.eval(member);
      }
    }

    if ("constructor" !in cEngine.variables.called) {
      cEngine.defineVariable("constructor", new Value(cast(IOperator)(new DynamicOperator((string[]).init, new Value)))); 
    }

    ClassType clst = new ClassType(cEngine);
    Value     cls  = new Value(clst);

    engine.defineVariable(className, cls);

    return cls;
  }
}

/* インスタンスの生成を行うnew関数を定義する。
 * 使い方は
 * (new クラス名 コンストラクタの引数)
 */
class NewOperator : IOperator {
  public Value call(Engine engine, Value[] args) {
    string className;

    if (args[0].type == ValueType.SymbolValue) {
      className = args[0].getString;
    } else {
      className = engine.eval(args[0]).getString;
    }

    ClassType _cls = engine.getVariable(className).getClassType;
    ClassType cls  = new ClassType(_cls._engine.clone);
    // コンストラクタの引数リスト。
    Value[] cArgs;

    if (args.length > 0) {
      foreach (arg; args[1..$]) {
        cArgs ~= engine.eval(arg);
      }
    }

    cls._engine.variables["constructor"].getIOperator.call(cls._engine, cArgs);

    return new Value(cls);
  }
}

とりあえずこんな感じで色々と実装については説明した気はします...
なんか記事としてのクオリティはゴミな気がしますが、なんとなくD言語でLisp処理系を実装する雰囲気はつかめたんじゃないかなぁ...と思います。
完全なソースコードはGitHubで公開していますのでそちらも参照してください: GitHub - alphaKAI/ChickenClisp
スターを付けてくれると停滞している開発が再開されるかもしれないです(なんか内部の実装がビミョーだなーって思う部分が合ったりパフォーマンスがめっちゃ悪かったりとかで投げている部分もあるので割りとモチベーションが無いとつらい状態で止まっています)

[おまけ] ChickenClispでプログラムを書いてみよう。

これだけで終わるのは流石にアレなので、実際にChickenClispで書いたプログラムを紹介します。これらはChickenClispのsamplesに含まれているものと同じです。

##n-queenのソルバ

nqueen.ore

(def null? (ls) (= (length ls) 0))
(def pair? (ls) (and (list? ls) (> (length ls) 0)))

(def print-board (board)
  (step
    (def print-line (q size)
      (step
        (print "| ")
        (let loop ((x 0))
          (when (< x size)
            (if (= x q)
              (print "Q ")
              (print ". "))
            (loop (+ x 1))))
        (println "|")))

    (def print-waku (size)
      (step
        (print "*-")
        (let loop ((x 0))
          (when (< x size)
            (print "--")
            (loop (+ x 1))))
        (println "*")))

    (let ((size (length board)))
      (step
        (print-waku size)
        (let loop ((ls board))
          (when (pair? ls)
            (print-line (car ls) size)
            (loop (cdr ls))))
        (print-waku size)
        (println)))))

(def conflict? (column line board)
  (let loop ((x (- column 1)) (ls board))
      (cond ((null? ls) false)
            ((or (= (- column line) (- x (car ls)))
                  (= (+ column line) (+ x (car ls))))
              true)
            (else
              (loop (- x 1) (cdr ls))))))

(def safe? (line board)
  (cond ((null? board) true)
    ((conflict? (length board) line board) false)
    (else (safe? (car board) (cdr board)))))

(def queen (ls board)
  (cond ((null? ls)
    (if (safe? (car board) (cdr board))
    (print-board board)))
    (else
      (for-each
        (lambda (n)
          (queen (remove (lambda (x) (= x n)) ls)
                  (cons n board)))
        ls))))

(def queen-fast (ls board)
  (if (null? ls)
    (step
      (println board)
      (print-board board))
    (for-each
      (lambda (n)
        (if (not (conflict? (length board) n board))
          (queen-fast
            (remove (lambda (x) (= x n)) ls)
            (cons n board))))
      ls)))

(set n 8)
(queen-fast (seq n) '())

base64エンコーダ

base64.ore

(def zip (arr1 arr2)
      (map (lambda (i) (as-iv (cons (array-get-n arr1 i) (array-get-n arr2 i))))
          (seq (length arr1))))

(def assocArray (zipped)
      (step
        (make-hash hashmap)
        (def-var idx 0)
        (while (< idx (length zipped))
              (step
                (def-var tuple (array-get-n zipped idx))
                (def-var key   (array-get-n tuple 0))
                (def-var value (array-get-n tuple 1))
                (hash-set-value hashmap key value)
                (set idx (+ idx 1))))
        hashmap))

(def convb (N base)
      (step
        (def _convb (N tmp stack base)
            (if (not (= tmp 0))
                (_convb N (float-to-integer (/ tmp base)) (array-append stack (% tmp base)) base)
                (string-join (map (lambda (n) (number-to-string n)) (array-reverse stack)))))
        (_convb N N '() base)))

(def createTable ()
      (step
        (def-var charset (string-split "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))
        (def-var ziparg (map (lambda (i)
                                    (step
                                      (def-var e (convb i 2))
                                      (if (= (string-length e) 6)
                                          e
                                          (while (< (string-length e) 6)
                                                  (set e (string-concat "0" e))))))
                        (seq (length charset))))
        (assocArray (zip ziparg charset))))

(def convertDataInto8Bits (data)
      (map (lambda (i)
                  (step
                    (def-var e (convb i 2))
                    (if (= (string-length e) 8)
                        e
                        (while (< (string-length e) 8)
                                (set e (string-concat "0" e))))))
          data))

(def-var table (createTable))

(def base64encode (data)
      (step
        (def makePrepared (binaries)
            (step
              (def-var bLen (string-length binaries))
              (def-var quotients
                        (map (lambda (i) (string-slice binaries (* i 6) (* (+ i 1) 6)))
                            (seq (float-to-integer (/ bLen 6)))))
              (if (= (% bLen 6) 0)
                  quotients
                  (array-append quotients
                                (step
                                  (def-var $ (string-length binaries))
                                  (def-var remainds (string-slice binaries (- $ (% bLen 6)) $))
                                  (while (< (string-length remainds) 6)
                                          (set remainds (string-concat remainds "0")))
                                  remainds)))))

        (def makeQuotients (prepared)
            (step
              (def-var pLen (array-length prepared))
              (map (lambda (i)
                            (as-iv (step
                                    (def-var j (* i 4))
                                    (map (lambda (k) (hash-get-value table (array-get-n prepared (+ j k))))
                                          (seq 4)))))
                    (seq (float-to-integer (/ pLen 4))))))

        (def finallize (prepared quotients)
            (step
              (def-var pLen (array-length prepared))
              (if (= (% (array-length prepared) 4) 0)
                  quotients
                  (array-append quotients (step
                                            (def-var $ (array-length prepared))
                                            (def-var remainds (array-slice prepared (- $ (% pLen 4)) $))
                                            (def-var fst (map (lambda (remaind) (hash-get-value table remaind)) remainds))
                                            (def-var fstlen (array-length fst))
                                            (def-var snd "")
                                            (while (< (+ (string-length snd) fstlen) 4)
                                                    (set snd (string-concat snd "=")))
                                            (as-iv (array-append fst snd)))))))

        (def-var binaries (string-join (convertDataInto8Bits data)))
        (def-var prepared (makePrepared binaries))
        (def-var quotients (makeQuotients prepared))
        (string-concat (array-flatten (map (lambda (x) x) (finallize prepared quotients))))))

これはD言語で書いたワンライナーのBase64エンコーダをChickenClispに移植したものです。(移植元:[D言語で書く "イケメンなコード" ~ Base64エンコーダをワンライナーで書く ~] (http://qiita.com/alpha_kai_NET/items/f9fabe15f5619e10e654))

実際に使う例はこちらです。

base64_sample.ore

(load "samples/base64")
(def string-into-numbers (str)
  (map (lambda (e) (char-to-number e)) (string-split str)))

(def str2b64 (str)
  (base64encode (string-into-numbers str)))


(def-var from "abcdefghijklmnopqrstuvwxyz")
(def-var dst (str2b64 from))
(println "from - " from)
(println "dst - " dst)
(println "valid? - " (if (= "YWJjZGVmZ2hpamtsbW5vcHFyc3R1dnd4eXo=" dst) "yes" "no"))

TwitterのAPIラッパー

curlによるネットワーク処理とかHMAC-SHA1によるハッシュ化が出来るのでTwitterのAPIラッパーを書くことも出来ます。
それがこちらです。

twitter.ore

(load "samples/base64")

(def-var authorizeKeys '("oauth_consumer_key" "oauth_nonce" "oauth_signature_method" "oauth_timestamp" "oauth_token" "oauth_version"))
(def-var baseUrl "https://api.twitter.com/1.1/")

(def buildParams (additionalParam)
  (begin
    (def-var now (get-current-unixtime))
    (make-hash params)
    (for-each (lambda (pair)
                      (begin
                        (def-var key   (car pair))
                        (def-var value (car (cdr pair)))
                        (hash-set-value params key value)))
      '((cons "oauth_consumer_key"     consumerKey)
        (cons "oauth_nonce"            (random-uuid))
        (cons "oauth_signature_method" "HMAC-SHA1")
        (cons "oauth_timestamp"        now)
        (cons "oauth_token"            accessToken)
        (cons "oauth_version"          "1.0")))

    (def-var adp-is-null
      (if (is-hash? additionalParam)
        false
        (= "null" additionalParam)))

    (set params (if adp-is-null
                    params
                    (begin
                      (for-each (lambda (key) (hash-set-value params key (hash-get-value additionalParam key)))
                                (hash-get-keys additionalParam))
                      params)))

    (for-each (lambda (key) (hash-set-value params key (url-encode-component (hash-get-value params key))))
              (hash-get-keys params))

    params))

(def signature (method url params)
  (begin
    (def-var query (string-join (map (lambda (k) (string-concat k "=" (hash-get-value params k))) (sort (hash-get-keys params))) "&"))
    (def-var key   (string-join (map (lambda (x) (url-encode-component x)) '(consumerSecret accessTokenSecret)) "&"))
    (def-var base  (string-join (map (lambda (x) (url-encode-component x)) '(method url query)) "&"))
    (def-var oauthSignature (url-encode-component (base64encode (ubytes-to-integers (hmac-sha1 key base)))))

    oauthSignature))

(def request (type endPoint paramsArgument)
  (begin
    (def-var method
      (if (|| (= type "GET") (= type "get"))
        "GET"
        "POST"))

    (def-var params (buildParams paramsArgument))
    (def-var url    (string-concat baseUrl endPoint))
    (def-var oauthSignature (signature method url params))
    (hash-set-value params "oauth_signature" oauthSignature)

    (def-var authorize (string-concat "OAuth " 
                                      (string-join (map (lambda (k) (string-concat k "=" (hash-get-value params k)))
                                                        authorizeKeys)
                                                   ",")))
    (def-var path      (string-join (map (lambda (k) (string-concat k "=" (hash-get-value params k)))
                                         (hash-get-keys params))
                                    "&"))

    (def-var header (new-hash))
    (hash-set-value header "Authorization" authorize)

    (if (= method "GET")
      (curl-get-string (string-concat url "?" path) header)
      (curl-post-string url path header))))

これもほとんど拙作のD言語向けのTwitterAPIラッパーのTwitter4Dを移植したような感じです。
また、これをクラスを用いるような感じに書き換えるとTwitter4Dとほぼおんなじ感じになって良いです。

実際に使う例はこちらです。ConsumerKeyなどを設定すると使えます。

twitter_sample.ore

(load "samples/twitter")

(def-var consumerKey       "")
(def-var consumerSecret    "")
(def-var accessToken       "")
(def-var accessTokenSecret "")

(make-hash args)
(hash-set-value args "status" "Hello, world!")
(request "POST" "statuses/update.json" args)

以上です。

記事のアップが遅くなってごめんなさい ><