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