Schemeをつくろう(17) eval

なんだかんだ色々迷走しながらも、なんとかここまでまとまりました。lambdaが大体出来上がってきました。出来ることといえば、lambda位なんですが、クロージャらしきモノもあります。

ポイントとか

• evalの基本はeval(オブジェクト, 環境)で評価します。
  • (+ x y z)これが評価前のオブジェクト、何の意味も持ってない。記号らしきもの。
  • おぉ、+発見。こいつは、プリミティブな関数らしいぞ。
  • 括弧の中、変数の中を再帰的にどんどん見ていく。
  • (x . 1) (y . 2)コレが環境。ローカル変数。(+ 1 2 z)。zねぇよ。
  • 環境に無い場合は、グローバル変数を見に行きます。zの中を見ます。あ、z = 3
  • 繋げると、(+ 1 2 3)になって、call。答えは6
• 変数のつくりかた
  • ローカル変数とグローバル変数では「やってることが全然違う」というのが特徴。
  • トップレベルじゃないときはローカル変数を定義。(x . 1)とする。
  • トップレベルで宣言されたときは、グローバル変数を定義。z = 3シンボルの中に入れる。
  • Cもローカルな変数はスタックの中。グローバルな変数はスタックの中には無い。全然違う。
  • トップレベル判別がイマイチ。
• マイ関数のつくりかた
  • 簡単。「lambda」ってあったら、
  • closure(束縛用引数(x y), 関数の中身, 今の環境のコピー)
  • 何もしないで、保存。それだけ。
  • ただ、環境はポインタになってるので、リストの先頭アドレスのコピーを取っておく事が重要。コピーじゃないとダメぇ。
• マイ関数を呼び出す
  • クロージャな場合は、環境を呼び出した環境に一旦戻す。だからapply_closureに「環境が無い」
  • apply_closure(クロージャ, 引数(1 2))
  • apply_closure(クロージャなし, 引数, 環境)と、引数に環境を持つと、ダイナミックスコープになる。
  • Schemer&Vimper的に激しく気持ち悪い。僕はemacsを使わないLisperなのです。
  • で、引数(x . 1) (y . 2)と束縛。ローカル変数に送る。そしたらeval。
• undefについて。
  • どうもnullだけだとマズイようだ。値に何も入ってないことを示すのに、nullだけでは判断が付かない。つまり、(define nil '())が出来ない。適当なアドレスをundefに割り振ることにした。
• applyがいったい何者なのかイマイチわかってない。
• ((について。
  • ((ってあったら、とりあえず中を見てみる。

gosh> ((+ 1 2 3) (+ 4 5 6))
*** ERROR: invalid application: (6 15)

• • エラーは色々ヒントを教えてくれる。素晴らしい。

作ってみてわかったことは「eval重要」ってこと。evalが違うと、Common Lispになったり、Schemeになっちゃったりする。だからスゲーeval重要。

ちなみに僕のはSchemeらしきショボショボLisp。

ソース

今の所のソース。ソースは長いのか。短めか。270行位。

作れば作る程短くなってしまう不思議。

#include <stdio.h>

#include "error.h"
#include "list.h"
#include "symbol.h"
#include "eval.h"

static object s_define, s_lambda, s_if, s_apply, s_quote, s_eval, s_env;

/* eval */
static object eval_map(object o, object *env);
static object eval_value(object sym, object *env);
static object eval_symbol(object sym, object args, object *env);

static object apply(object sym, object args);
static object apply_closure(object c, object values);

/* syntax */
static object if_syntax(object args, object *env);
static object apply_syntax(object args, object *env);
static object eval_syntax(object args, object *env);
static object lambda(object args, object *env);

/* define */
static object define(object args, object *env);
static void append_env(object sym, object value, object *env);
static object find_value(object sym, object *env);

static object assq(object key, object list);


object eval(object o, object *env)
{
    if (is_null(o))                               /* () -> error */
        error("eval : null");
    else if (is_symbol(o))                        /* abc -> "hello!!" */
        return eval_value(o, env);
    else if (!is_pair(o))                         /* 123 -> 123 */
        return o;
    else {
        object head = car(o);
        object body = cdr(o);

        if (is_symbol(head))                      /* (+ 1 2) -> 3 */
            return eval_symbol(head, body, env);
        else if (is_closure(head))                /* (<closure> body) */
            return apply_closure(head, body);
        else if (is_pair(head))                   /* ((lambda ..) (..  -> (<closure> .. */
            return eval(eval_map(o,env), env);
        else
            error("eval : can't eval");
    }
}

/* eval all aruguments ((+ 1 2 3) ...) -> (6 ...) */
static object eval_map(object args, object *env)
{
    if (is_null(args))
        return null();
    else if (is_pair(args)) {
        object a,d;

        a = eval(car(args), env);     /* eval */
        d = eval_map(cdr(args), env); /* next */
        return cons(a, d);
    } else
        return eval(args, env);       /* error かも。 */
}

static object eval_value(object sym, object *env)
{
    object value = find_value(sym, env);

    if (!is_undef(value))
        return value;
    else
        error("eval : undefind value");
}

static object eval_symbol(object sym, object args, object *env)
{
    object value = find_value(sym, env);

    if (!is_undef(value)) {
        args = eval_map(args, env);
        return apply(value, args);
    }

    if (eq_symbol(sym, s_define))
        return define(args, env);
    else if (eq_symbol(sym, s_apply))
        return apply_syntax(args, env);
    else if (eq_symbol(sym, s_eval))
        return eval_syntax(args, env);
    else if (eq_symbol(sym, s_lambda))
        return lambda(args, env);
    else if (eq_symbol(sym, s_if))
        return if_syntax(args, env);
    else if (eq_symbol(sym, s_quote))
        return car(args);
    else if (eq_symbol(sym, s_env)) {    /* debug syntax */
        display(*env);
        newline();
        return undef();
    } else
        error("eval : undefind");
}

/* bind aruguments */
static object apply(object fun, object args)
{
    if (is_function(fun))
        return call(fun, args);
    else if (is_closure(fun))
        return apply_closure(fun, args);
    else
        error("apply error");
}

static object apply_closure(object c, object values)
{
    object args = closure_args(c);
    object body = closure_body(c);
    object root = closure_env(c);
    object res  = undef();

    object *env = &root;

    /* bind */
    if (!is_pair(args))                          /* (lambda x x) */
        append_env(args, values, env);
    else {
        for (; !(is_null(args) || is_null(values));
             args = cdr(args), values = cdr(values))
            append_env(car(args), car(values), env);

        if (!(is_null(args) && is_null(values)))
            error("closure : bind error");
    }

    /* eval body */
    for (; !is_null(body); body = cdr(body))
        res = eval(car(body), env);

    return res;
}


/* syntax */
static object lambda(object args, object *env)
{
    if (length(args) >= 2)
        return closure(car(args), cdr(args), *env);
    else
        error("lambda : arugument error");
}

static object apply_syntax(object args, object *env)
{
    if (length(args) == 2) {
        object sym = car(args);
        object fun;

        fun = find_value(sym, env);

        if (is_undef(fun))
            error("syntax apply : not find value");

        args = eval(cadr(args), env);

        return apply(fun, args);
    } else
        error("syntax apply : arugument error");
}

static object eval_syntax(object args, object *env)
{
    if (length(args) == 1)
        return eval(eval(car(args), env), env);
    else
        error("syntax eval : arugument error");
}

static object if_syntax(object args, object *env)
{
    if (length(args) == 3) {
        object ex = car(args);

        ex = eval(ex, env);

        if (!is_boolean(ex))
            error("syntax if : not boolean");

        if (is_true(ex))
            return eval(cadr(args), env);
        else
            return eval(car(cddr(args)), env);
    } else
        error("syntax if : arugument error");
}


/* define */
static object define(object args, object *env)
{
    object sym, value, head, body;

    if (!is_pair(args))
        error("define : argument error");

    head = car(args);
    body = cdr(args);

    if (is_pair(head)) {                       /* closure */
        sym  = car(head);
        value = closure(cdr(head), body, *env);
    } else if (is_symbol(head)) {              /* value */
        sym = head;
        if (length(body) != 1)
            error("define argument error");
        value = eval(car(body), env);

    } else
        error("define : not symbol");

    /* set values */
    if (is_null(*env))                        /* global */
        set_symbol_value(sym, value);
    else                                      /* local */
        append_env(sym, value, env);
    return value;
}

static void append_env(object sym, object value, object *env)
{
    *env = cons(cons(sym, value), *env);
}

static object find_value(object sym, object *env)
{
    /* local */
    object value;

    if (!is_null(value  = assq(sym, *env)))
        return cdr(value);

    /* global */
    if (!is_undef(value = get_symbol_value(sym)))
        return value;

    /* not find */
    return undef();
}

/* util */
static object assq(object key, object list)
{
    while (!is_null(list)) {
        if (eq_symbol(car(car(list)), key))
            return car(list);
        list = cdr(list);
    }
    return null(); /* not find */
}

void init_syntax_symbols(void)
{
    s_define = symbol("define");
    s_lambda = symbol("lambda");
    s_if     = symbol("if");
    s_apply  = symbol("apply");
    s_quote  = symbol("quote");
    s_eval   = symbol("eval");
    s_env    = symbol("env");
}

修行が足りません。修行じゃぁ〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜。