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; }