static void *list_new(t_pd *dummy, t_symbol *s, int argc, t_atom *argv) { if (!argc || argv[0].a_type != A_SYMBOL) newest = list_append_new(s, argc, argv); else { t_symbol *s2 = argv[0].a_w.w_symbol; if (s2 == gensym("append")) newest = list_append_new(s, argc-1, argv+1); else if (s2 == gensym("cat")) newest = list_cat_new(); else if (s2 == gensym("prepend")) newest = list_prepend_new(s, argc-1, argv+1); else if (s2 == gensym("split")) newest = list_split_new(atom_getfloatarg(1, argc, argv)); else if (s2 == gensym("trim")) newest = list_trim_new(); else if (s2 == gensym("length")) newest = list_length_new(); else if (s2 == gensym("fromsymbol")) newest = list_fromsymbol_new(); else if (s2 == gensym("tosymbol")) newest = list_tosymbol_new(); else { error("list %s: unknown function", s2->s_name); newest = 0; } } return (newest); }
// This is where most of the strict/lazy distinction is. static value_t *e_fncall(env_t *env, expr_t *fn, list_t *args) { value_t *fnv; eli_closure_t c; // Call-by-need (lazy function calls): suspend (thunk-ify) each // argument in the given environment. c.env = env; c.list = list_empty(); list_iterate(args, thunk_list_i, &c); list_reverse(c.list); // Due to C's 'break' being imperfect, use 'goto' for clarity. loop: // Evaluate the function to a closure/data constructor in the given // environment. fnv = e_expr(env, fn); switch (fnv->type) { case v_datacons: // Construct a new data constructor value; we need to do this in // case the value we got from evaluating the "function" is shared. { value_t *dcv = alloc_value(v_datacons); datacons_tag(dcv) = datacons_tag(fnv); datacons_params(dcv) = list_append_new(datacons_params(fnv), c.list); fnv = dcv; } break; case v_closure: { int paramsArgs; // Bind the closure's parameters to the given arguments in a new // environment. At this point the original environment has // served its purpose. env = closure_env(fnv); env_new_scope(&env); paramsArgs = list_zip_with(closure_params(fnv), c.list, e_bind_params_i, env); // See how the number of parameters and arguments relate. switch (paramsArgs) { case -1: // Didn't get enough arguments, so wait for some more by // building a new closure. { value_t *fn_unsaturated = alloc_value(v_closure); closure_params(fn_unsaturated) = list_drop_new(list_length(c.list), closure_params(fnv)); closure_body(fn_unsaturated) = closure_body(fnv); closure_env(fn_unsaturated) = env; fnv = fn_unsaturated; } break; case 0: // Got exactly the right number of arguments. Evaluate the // body in the extended environment. fnv = e_expr(env, closure_body(fnv)); break; case 1: // Got too many arguments for this closure. Assuming // type-correctness, that implies the body of this closure // reduces to a function, so let's try again. Note the // environment has already been updated. fn = closure_body(fnv); c.list = list_drop_new(list_length(closure_params(fnv)), c.list); goto loop; } break; case v_builtin_fn: { int nArgs; int nParams; // See how the number of parameters and arguments relate. nArgs = list_length(c.list); nParams = builtin_num_params(fnv); if (nArgs < nParams) { // Didn't get enough arguments, so wait for some more by // building a new closure-like thing. value_t *fn_unsaturated = alloc_value(v_builtin_fn); builtin_num_params(fn_unsaturated) = nParams - nArgs; builtin_args(fn_unsaturated) = builtin_args(fnv); list_append(&builtin_args(fn_unsaturated), &c.list); builtin_fn(fn_unsaturated) = builtin_fn(fnv); return fn_unsaturated; } else if (nArgs > nParams) { // Got too many arguments. Assuming type-correctness, that // implies the built-in function returns a function closure, // so let's try again. // FIXME error("builtin function application is over-saturated.\n"); return NULL; // value_t *result = builtin_fn(fnv)(list_take_new(builtin_num_params(fnv), c.list)); // fncall_fn(expr) = closure_body(fnv); // c.list = list_drop_new(nParams, c.list); // env = fn_env; // break; /\* Loop *\/ } else { // Got exactly the right number of arguments. return builtin_fn(fnv)(c.list); } } break; default: fprintf(stdout, "e_fncall: expression:\n"); pp_expr(stdout, fn, 2); fprintf(stdout, "\non line %d evaluated to non-function/data constructor value:\n", fn->line_num); print_value(stdout, fnv); error("\n"); break; } } return fnv; }