Name: LuaJIT 2012-02-25 0:48
LuaJIT
#include <unistd.h>
int main(int argc, char* argv[])
{
(void) argc;
execvp("diff", argv);
return -1;
}
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;
}