void l_eval(const char *source, const char *source_file, LClosure *closure) {
LAst ast = l_parse(source, source_file);
list_iter_p iter = list_iterator(ast, FRONT);
while(list_next(iter) != NULL) {
l_eval_node((LNode*)list_current(iter), closure);
}
}
LValue *l_eval_call_args(LNode *node, LValue *func, LClosure *outer_closure, LClosure *inner_closure) {
int i, argc;
LValue *v, *args_val, **ref;
LNode **args;
if(node != NULL) {
argc = node->exprc;
args = node->exprs;
} else {
argc = 0;
args = NULL;
}
if(outer_closure != inner_closure) {
// initialize all args to nil
for(i=0; i<func->core.func.argc; i++) {
v = l_value_new(L_NIL_TYPE, inner_closure);
l_closure_set(inner_closure, func->core.func.args[i]->val, v, true);
}
}
// setup the arguments
args_val = l_value_new(L_LIST_TYPE, inner_closure);
args_val->core.list = create_vector();
LValue ***args_ref = malloc(sizeof(LValue**) * argc);
// set all passed args
for(i=0; i<argc; i++) {
if(args[i]->type == L_VAR_TYPE) { // pass vars by reference
ref = l_closure_get_ref(outer_closure, args[i]->val);
if(ref != NULL) {
args_ref[i] = ref;
v = *ref;
} else {
// handle error
l_eval_var_node(args[i], outer_closure);
}
} else { // eval as normal and set the value
v = l_eval_node(args[i], outer_closure);
ref = malloc(sizeof(LValue*));
*ref = v;
args_ref[i] = ref;
}
// append to 'args' variable
vector_add(args_val->core.list, v, sizeof(v));
}
for(i=0; i<func->core.func.argc; i++) {
l_ref_put(inner_closure->locals, func->core.func.args[i]->val, args_ref[i]);
}
l_closure_set(inner_closure, "args", args_val, true);
return args_val;
}
LValue *l_eval_list_node(LNode *node, LClosure *closure) {
LValue *value = l_value_new(L_LIST_TYPE, closure);
value->core.list = create_vector();
LValue *v;
int i;
for(i=0; i<node->exprc; i++) {
v = l_eval_node(node->exprs[i], closure);
vector_add(value->core.list, v, sizeof(v));
}
return value;
}
LValue *l_eval_assign_node(LNode *node, LClosure *closure) {
LValue *value = l_eval_node(node->exprs[0], closure);
l_closure_set(closure, node->val, value, false);
return value;
}
LValue *l_eval_call_node(LNode *node, LValue *func, LClosure *closure) {
if(func == NULL) func = l_eval_var_node(node, closure);
char *name = (node != NULL) ? node->val : "";
LValue *value, *args_val;
LNode *expr;
int i;
// create a running scope to hold arguments
// and a reference to self (for recursion)
// TODO this may not be necessary (can't we just do `cl=func->core.func.closure`?)
LClosure *cl = l_closure_clone(func->core.func.closure, node);
tail_loop:
l_debug(L_DEBUG_CALL) {
if(node) printf(">>> entering %s on line %d in %s\n", name, node->line_no, node->source_file);
else printf(">>> entering %s\n", name);
}
if(strcmp(name, "") != 0)
l_closure_set(cl, name, func, true);
args_val = l_eval_call_args(node, func, closure, cl);
if(func->core.func.ptr != NULL) {
// native C code
if(!setjmp(cl->jmp)) {
value = func->core.func.ptr(args_val, cl);
} else {
// function called longjmp to initiate a tail call
l_debug(L_DEBUG_CALL) printf("^^^ reached end of %s (longjmp tail call)\n", name);
node = NULL;
func = l_closure_get(cl, "--tail-call--");
closure = cl;
l_closure_backfill(func->core.func.closure, cl, node);
name = "";
goto tail_loop;
}
} else {
// Lydia code
int exprc = func->core.func.exprc;
if(exprc > 0) {
// eval all but the last expression
for(i=0; i<exprc-1; i++) {
expr = func->core.func.exprs[i];
value = l_eval_node(expr, cl);
}
expr = func->core.func.exprs[exprc-1];
if(expr->type == L_CALL_TYPE) { // tail call
l_debug(L_DEBUG_CALL) printf("^^^ reached end of %s (tail call)\n", name);
node = expr;
func = l_eval_var_node(node, cl);
closure = cl;
l_closure_backfill(func->core.func.closure, cl, node);
name = node->val;
goto tail_loop;
} else {
value = l_eval_node(expr, cl);
}
} else {
value = l_value_new(L_NIL_TYPE, cl);
}
}
l_closure_free(cl);
l_debug(L_DEBUG_CALL) printf("<<< returning from %s\n", name);
return value;
}
