Union _with_open_driver(ExAtom *env, Cell *args) { ArgsIsAtLeast1<IsSymbol> checker(args); checker.check(); Symbol *driver_sym; driver_sym = checker.get0(); Cell *body; body = checker.getRemains(); if ( body == Cell::NIL ) { throw std::runtime_error("no body."); } ExAtom *new_env; if ( driver_sym->name == "root" ) { new_env = environment::getSystemRootEnvironment(); } else { Union u_new_env; bool find_flag; u_new_env = environment::getValue(env, *driver_sym, &find_flag); if ( !find_flag ) { throw std::runtime_error("no driver name."); } new_env = u_new_env.getEnvironmentExAtom(); if ( new_env == 0 ) { throw std::runtime_error("no driver."); } } return eval_sequence(new_env, body); }
// see note for eval_sequence, below struct object * eval(struct pair *form, struct environment *env) { struct pair *seq = make_pair(&form->obj, &NIL->obj); struct object *ret = eval_sequence(seq, env); dealloc_obj(&seq->obj); return ret; }
object_t apply(object_t p, object_t argl) { proc_t proc = obj_get_proc(p); if(isprimitiveproc(proc)) /* primitive procedure */ return (proc->fn)(argl); else { object_t extended = extend_environment(lambda_params(p), argl, lambda_env(p)); return eval_sequence(lambda_body(p), &extended); } }
data_t *apply(const data_t *proc, const data_t *args) { data_t *out; if(is_primitive_procedure(proc)) return apply_primitive_procedure(proc, args); if(is_compound_procedure(proc)) { out = eval_sequence( get_procedure_body(proc), extend_environment(get_procedure_parameters(proc), args, get_procedure_environment(proc))); return out; } printf("Unknown procedure type -- APPLY\n"); return make_symbol("error"); }
data_t *eval(const data_t *exp, data_t *env) { if(eval_plz_die) { eval_plz_die = 0; ExitThread(0); } if(is_self_evaluating(exp)) return (data_t*)exp; if(is_variable(exp)) return lookup_variable_value(exp, env); if(is_quoted_expression(exp)) return get_text_of_quotation(exp); if(is_assignment(exp)) return eval_assignment(exp, env); if(is_definition(exp)) return eval_definition(exp, env); if(is_if(exp)) return eval_if(exp, env); if(is_lambda(exp)) return make_procedure(get_lambda_parameters(exp), get_lambda_body(exp), env); if(is_begin(exp)) return eval_sequence(get_begin_actions(exp), env); if(is_cond(exp)) return eval(cond_to_if(exp), env); if(is_letrec(exp)) return eval(letrec_to_let(exp), env); if(is_let_star(exp)) return eval(let_star_to_nested_lets(exp), env); if(is_let(exp)) return eval(let_to_combination(exp), env); if(is_application(exp)) return apply( eval(get_operator(exp), env), get_list_of_values(get_operands(exp), env)); printf("Unknown expression type -- EVAL '"); return make_symbol("error"); }
static data_t *eval_sequence(const data_t *exps, data_t *env) { if(is_last_exp(exps)) return eval(get_first_exp(exps), env); eval(get_first_exp(exps), env); return eval_sequence(get_rest_exps(exps), env); }
/////////////////////////////////////////////////////////////////// //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; }