cell_t *invoke(cell_t *fun, cell_t *args, environ_t *env) {
int argslen, paramlen;
environ_t *new_env;
function_t *func = fun->slot2.fun;
cell_t *ret;
cell_t *code;
handle_t *hc;
argslen = proper_list_length(args,0);
paramlen = proper_list_length(func->param_list, 0);
if (argslen != paramlen) return NULL; /* error */
create_empty_environment(&new_env);
extend(func->lexical_env, new_env, func->param_list, args);
code = func->code;
hc = handle_push(code);
while (NULL != code && !NILP(code)) {
ret = evaluate(CAR(code), new_env); // code handled
code = handle_get(hc);
code = CDR(code);
handle_set(hc, code);
}
handle_pop(hc);
return ret;
}
// FIXME can't cope with circular lists
CELL func_length(CELL frame)
{
int n = proper_list_length(FV0);
if (n == -1) {
return make_exception("expects a <proper list>");
}
return make_int(n);
}
cell_t *evargs(cell_t *args, environ_t *env) {
#define MAX_LISP_ARGS 16
handle_t *harray[MAX_LISP_ARGS];
int length;
int i;
cell_t *tmp, *head = nil_cell, *tail = nil_cell;
handle_t *hhandle, *thandle;
if ((length = proper_list_length(args, 0)) < 0) return NULL; /* error */
if (length > MAX_LISP_ARGS) return NULL; /* can only handle 16 args atm */
for (i = 0; i < length; i++, args = CDR(args)) {
harray[i] = handle_push(CAR(args));
}
for (i = 0; i < length; i++) {
cell_t *t = handle_get(harray[i]);
handle_set(harray[i], evaluate(t, env)); // everything handled
}
hhandle = handle_push(head);
thandle = handle_push(tail);
for (i = length - 1; i >= 0; i--) {
tmp = new(cell_t); // head and tail protected by handles
head = handle_get(hhandle);
tail = handle_get(thandle);
tail = head;
head = handle_get(harray[i]);
CONS(tmp, head, tail);
head = tmp;
handle_set(hhandle, head);
handle_set(thandle, tail);
}
handle_pop(thandle);
handle_pop(hhandle);
for (i = length - 1; i >= 0; i--) {
handle_pop(harray[i]);
}
return head;
}
// FIXME - should typecheck all list elements before allocating storage?
CELL func_list_to_string(CELL frame)
{
CELL list = FV0;
int n = proper_list_length(list);
if (n == -1) {
return make_exception("expects list of characters");
}
gc_root_1("func_list_to_string", list);
CELL result = make_string_raw(n);
gc_unroot();
CHAR* data = GET_STRING(result)->data;
int i;
for(i = 0; i < n; ++i) {
CELL ch = CAR(list);
list = CDR(list);
if (!CHARP(ch)) {
return make_exception("expects list of characters");
}
data[i] = GET_CHAR(ch);
}
return result;
}
