Value *eval(Value *form, Value *env)
{
switch (gettype(form)) {
case T_INT: return form;
case T_SYM:
{
Value *value = lookup(form, env);
if (value == NULL) {
error("Undefined symbol.");
exit(1);
}
return value;
} break;
case T_PAIR:
{
Value *verb = CAR(form);
if (verb == quote_sym) {
return CADR(form);
} else if (verb == lambda_sym) {
return eval_lambda(form, env);
} else if (verb == if_sym) {
return eval_if(form, env);
} else if (verb == define_sym) {
return eval_define(form, env);
} else {
return apply(eval(verb, env), mapeval(CDR(form), env));
}
} break;
default:
error("I don't know how to evaluate that.");
break;
}
}
T eval(T form, Environment env) {
T o;
switch(gettype(form)) {
case T_INT:
case T_STR:
return form;
case T_SYM:
o = lookup(form, env);
if (NILP(o)) {
error("Undefined symbol");
exit(1);
}
return o;
case T_CELL:
o = CAR(form);
/* (quote (1 2 3 4)) */
if (o == sym_quote) {
return CADR(form);
/* (lambda () (..)) */
} else if (o == sym_lambda) {
return eval_lambda(form, env);
/* (if () (then) (else)) */
} else if (o == sym_if) {
return eval_if(form, env);
/* (defun foo () (...)) */
} else if (o == sym_defun) {
return eval_defun(form, env);
} else {
return apply(eval(o, env), mapeval(CDR(form), env));
}
default:
error("I have no idea how to eval that.");
break;
}
return NIL;
}
Value eval_list(Value expression, Environment *environment) {
w_assert(expression.type == CONS);
Bool lambda_call = false;
Value function_symbol = NEXT(expression);
Value lambda;
Function *function;
if (function_symbol.type == CONS) {
if (CAR(function_symbol).type == SYMBOL &&
CAR(function_symbol).val.symbol_val == symbols_lambda.val.symbol_val) {
lambda = eval(function_symbol, environment);
lambda_call = true;
} else {
return VALUE_ERROR;
}
} else if (function_symbol.type == LAMBDA) {
lambda = function_symbol;
lambda_call = true;
} else if (function_symbol.type == SYMBOL) {
Value function_value;
Bool found = hash_get(environment -> functions, function_symbol, &function_value);
if (!found) {
/* TODO: log error */
/* TODO: "Did you mean?" */
debug_value(function_symbol);
log_error("Function XXX not found");
return VALUE_ERROR;
}
w_assert(function_value.type == FUNCTION);
function = function_value.val.function_val;
} else {
return VALUE_ERROR;
}
Value args;
if (lambda_call || function -> eval) {
args = VALUE_NIL;
while (expression.type == CONS) {
Value arg = NEXT(expression);
args = CONS(eval(arg, environment), args);
}
args = list_reverse(args);
w_assert(expression.type == NIL);
/* TODO: benchmark, which approach is better, the above or below? */
/* if (expression.type == CONS) { */
/* args = CONS1(VALUE_NIL); */
/* } else { */
/* args = expression; */
/* } */
/* Cons *top = args.val.cons_val; */
/* while (true) { */
/* Value arg = NEXT(expression); */
/* top -> car = eval(arg, environment); */
/* if (expression.type == CONS) { */
/* top -> cdr = CONS1(VALUE_NIL); */
/* top = top -> cdr.val.cons_val; */
/* } else { */
/* top -> cdr = expression; */
/* break; */
/* } */
/* } */
} else {
/* To ensure we avoid mutation in altering code the list is copied
If we guaranteed that no function with eval = false modifies the list we could give it directly
This would be an obvious performance optimization. But needs tests.
We can only guarantee this for c_code, not for userdefined macros.
TODO: Do this */
args = list_copy(expression);
}
Value result;
if (lambda_call) {
result = eval_lambda(lambda, args, environment);
} else {
result = eval_apply(function_symbol, function, args, environment);
}
list_destroy(args);
return result;
}
///////////////////////////////////////////////////////////////////
//eval
//requires two arguments:exp & tail_context
///////////////////////////////////////////////////////////////////
cellpoint eval(void)
{
if (is_true(is_self_evaluating(args_ref(1)))){
reg = args_ref(1);
}else if (is_true(is_variable(args_ref(1)))){
reg = args_ref(1);
args_push(current_env);
args_push(reg);
reg = lookup_var_val();
}else if (is_true(is_quoted(args_ref(1)))){
args_push(args_ref(1));
reg = quotation_text();
}else if (is_true(is_assignment(args_ref(1)))){
args_push(args_ref(1));
reg = eval_assignment();
}else if (is_true(is_definition(args_ref(1)))){
args_push(args_ref(1));
reg = eval_definition();
}else if (is_true(is_if(args_ref(1)))){
//eval if expression with the second argument (tail_context)
reg = args_ref(1);
args_push(args_ref(2));
args_push(reg);
reg = eval_if();
}else if (is_true(is_lambda(args_ref(1)))){
args_push(args_ref(1));
reg = eval_lambda();
}else if (is_true(is_begin(args_ref(1)))){
args_push(args_ref(1));
reg = begin_actions();
//eval the actions of begin exp with the second argument (tail_context)
args_push(args_ref(2));
args_push(reg);
reg = eval_sequence();
}else if (is_true(is_cond(args_ref(1)))){
args_push(args_ref(1));
reg = cond_2_if();
//eval the exp with the second argument (tail_context)
args_push(args_ref(2));
args_push(reg);
reg = eval();
}else if (is_true(is_and(args_ref(1)))){
reg = args_ref(1);
args_push(args_ref(2));
args_push(reg);
reg = eval_and();
}else if (is_true(is_or(args_ref(1)))){
reg = args_ref(1);
args_push(args_ref(2));
args_push(reg);
reg = eval_or();
}else if (is_true(is_let(args_ref(1)))){
//convert let to combination
args_push(args_ref(1));
reg = let_2_combination();
//evals the combination
args_push(args_ref(2));
args_push(reg);
reg = eval();
}else if (is_true(is_letstar(args_ref(1)))){
//convert let* to nested lets
args_push(args_ref(1));
reg = letstar_2_nested_lets();
//evals the nested lets
args_push(args_ref(2));
args_push(reg);
reg = eval();
}else if (is_true(is_application(args_ref(1)))){
//computes operator
args_push(args_ref(1));
reg = operator();
args_push(a_false);
args_push(reg);
reg = eval();
stack_push(&vars_stack, reg);
//computes operands
args_push(args_ref(1));
reg = operands();
args_push(reg);
reg = list_of_values();
//calls apply with the second argument (tail_context)
args_push(args_ref(2));
args_push(reg);
args_push(stack_pop(&vars_stack));
reg = apply();
}else {
printf("Unknown expression type -- EVAL\n");
error_handler();
}
args_pop(2);
return reg;
}
