LuaJIT

LuaJIT

>>81
Here's the eval/apply for a Scheme interpreter I wrote in C. The whole thing is about 1600 lines of code. More than half the code is just primitive procedure definitions, so the core is less than 800 lines.

object *eval(object *exp, object *env) {
    object *seq, *var, *val, *proc, *args;

    while (!is_self_evaluating(exp)) {
        if (is_variable(exp))
            return lookup_variable_value(exp, env);
        if (is_quoted(exp)) {
            return cadr(exp);
        } else if (is_quasiquoted(exp)) {
            return eval_quasiquote(cadr(exp), env);
        } else if (is_delay(exp)) {
            return compound(cons(nil, cdr(exp)), env);
        } else if (is_lambda(exp)) {
            return compound(cdr(exp), env);
        } else if (is_definition(exp)) {
            seq = cdr(exp);
            if (is_symbol(car(seq))) {
                return define_variable(car(seq), eval(cadr(seq), env), env);
            } else {
                var = caar(seq);
                val = make_lambda(cdar(seq), cdr(seq));
                exp = cons(car(exp), cons(var, cons(val, nil)));
            }
        } else if (is_assignment(exp)) {
            return set_variable_value(cadr(exp), eval(caddr(exp), env), env);
        } else if (is_if(exp)) {
            if (is_true(eval(cadr(exp), env)))
                exp = caddr(exp);
            else if (cdddr(exp))
                exp = cadddr(exp);
            else
                return boolean(false);
        } else if (is_cond(exp)) {
            for (seq = cdr(exp); seq; seq = cdr(seq))
                if (is_tagged_list(car(seq), "else") ||
                    is_true(eval(caar(seq), env))) {
                    for (seq = cdar(seq); cdr(seq); seq = cdr(seq))
                        eval(car(seq), env);
                    break;
                }
            if (!seq)
                return boolean(false);
            exp = car(seq);
        } else if (is_case(exp)) {
            val = eval(cadr(exp), env);
            for (exp = cddr(exp); exp; exp = cdr(exp))
                for (seq = caar(exp); seq; seq = cdr(seq))
                    if (is_eq(seq, symbol("else")) || is_eqv(car(seq), val)) {
                        for (seq = cdar(exp); cdr(seq); seq = cdr(seq))
                            eval(car(seq), env);
                        break;
                    }
            if (!seq)
                return boolean(false);
            exp = car(seq);
        } else if (is_begin(exp)) {
            for (seq = cdr(exp); seq && cdr(seq); seq = cdr(seq))
                eval(car(seq), env);
            if (!seq)
                return nil;
            exp = car(seq);
        } else if (is_and(exp)) {
            for (seq = cdr(exp); seq && cdr(seq); seq = cdr(seq))
                if (is_false(eval(car(seq), env)))
                    return boolean(false);
            if (!seq)
                return boolean(true);
            exp = car(seq);
        } else if (is_or(exp)) {
            for (seq = cdr(exp); seq && cdr(seq); seq = cdr(seq))
                if (is_true(val = eval(car(seq), env)))
                    return val;
            if (!seq)
                return boolean(false);
            exp = car(seq);
        } else if (is_let(exp)) {
            var = val = nil;
            for (seq = cadr(exp); seq; seq = cdr(seq)) {
                var = cons(caar(seq), var);
                val = cons(eval(cadar(seq), env), val);
            }
            env = extend_environment(var, val, env);
            for (seq = cddr(exp); cdr(seq); seq = cdr(seq))
                eval(car(seq), env);
            exp = car(seq);
        } else if (is_let_star(exp)) {
            env = environment(env);
            for (seq = cadr(exp); seq; seq = cdr(seq))
                append_variable(caar(seq), eval(cadar(seq), env), env);
            for (seq = cddr(exp); cdr(seq); seq = cdr(seq))
                eval(car(seq), env);
            exp = car(seq);
        } else if (is_application(exp)) {
            proc = eval(car(exp), env);
            args = list_of_values(cdr(exp), env);
            if (is_compound(proc)) {
                seq = to_compound(proc).proc;
                env = to_compound(proc).env;
                env = extend_environment(car(seq), args, env);
                for (seq = cdr(seq); seq && cdr(seq); seq = cdr(seq))
                    eval(car(seq), env);
                exp = car(seq);
            } else if (is_primitive(proc)) {
                return to_primitive(proc)(args);
            } else {
                error("apply", "not applicable", proc);
            }
        } else {
            error("eval", "unknown expression type", exp);
        }
    }
    return exp;
}