static action_t cont_quote() {
size_t len = length(expr);
if (len != 1)
argument_error(len);
pop_cont();
expr = car(expr);
return ACTION_APPLY_CONT;
}
static action_t cont_do() {
ref_t body = C(cont)->val[0];
if (isnil(body)) {
pop_cont();
return ACTION_APPLY_CONT;
}
C(cont)->val[0] = cdr(body);
return eval_expr(car(body));
}
static action_t cont_macroexpand() {
C(cont)->expand = (expr != C(cont)->val[0]);
if(!C(cont)->expand) {
pop_cont();
return ACTION_APPLY_CONT;
}
C(cont)->val[0] = expr;
cont = continuation(cont_macroexpand1, cont);
return ACTION_APPLY_CONT;
}
static action_t cont_macroexpand1() {
if (iscons(expr)) {
ref_t symbol = check_symbol(car(expr));
if (has_function(symbol)) {
ref_t func = get_function(symbol);
if (ismacro(func)) {
C(cont)->fn = cont_apply_apply, C(cont)->val[0] = func;
expr = cdr(expr);
return ACTION_APPLY_CONT;
}
}
}
pop_cont();
return ACTION_APPLY_CONT;
}
static action_t cont_apply_apply() {
ref_t func = C(cont)->val[0], args = expr;
ref_t formals = getformals(func);
size_t arity = getarity(func);
C(cont)->closure = getclosure(func);
for(; arity > 0; arity--, formals = cdr(formals), args = cdr(args))
bind(car(formals), car(args));
if (!isnil(formals))
bind(car(formals), args);
init_vals(cont);
if (isbuiltin(func)) {
getfn(func)();
pop_cont();
}
else
eval_do(getbody(func));
return ACTION_APPLY_CONT;
}
static action_t cont_fn() {
ref_t formals = car(expr), body = cdr(expr);
size_t arity = 0;
bool rest = NO;
if (!islist(formals))
error("invalid function: formals must be a list");
for(; !isnil(formals); arity++, formals = cdr(formals)) {
ref_t sym = car(formals);
if (sym == sym_amp) {
if (length(cdr(formals)) != 1)
error("invalid function: must have exactly one symbol after &");
rest = YES;
set_car(formals, cadr(formals));
set_cdr(formals, NIL);
break;
}
}
formals = car(expr);
pop_cont();
expr = lambda(formals, body, C(cont)->closure, arity, rest);
return ACTION_APPLY_CONT;
}
struct task_s *
invoke (struct continuation_s *cont, struct function_s *val)
{
switch ( cont->t )
{
case CONTINUATION_APP1:
{
struct task_s *task = new_task ();
task->t = TASK_APP1;
init_ptr (&task->d.task_app1_v.erator, val);
init_ptr (&task->d.task_app1_v.rand,
cont->d.continuation_app1_v.rand);
init_ptr (&task->d.task_app1_v.cont,
cont->d.continuation_app1_v.cont);
return task;
}
case CONTINUATION_APP:
{
struct task_s *task = new_task ();
task->t = TASK_APP;
init_ptr (&task->d.task_app_v.erator,
cont->d.continuation_app_v.erator);
init_ptr (&task->d.task_app_v.erand, val);
init_ptr (&task->d.task_app_v.cont,
cont->d.continuation_app_v.cont);
return task;
}
case CONTINUATION_DEL:
{
struct task_s *task = new_task ();
task->t = TASK_APP;
init_ptr (&task->d.task_app_v.erator, val);
init_ptr (&task->d.task_app_v.erand,
cont->d.continuation_del_v.erand);
init_ptr (&task->d.task_app_v.cont,
cont->d.continuation_del_v.cont);
return task;
}
case CONTINUATION_ABORT:
{
struct task_s *task = new_task ();
struct continuation_s *cont = pop_cont ();
task->t = TASK_INVOKE;
init_ptr (&task->d.task_invoke_v.cont, cont);
init_ptr (&task->d.task_invoke_v.val, val);
release_continuation(cont);
return task;
}
case CONTINUATION_FINAL:
{
struct task_s *task = new_task ();
task->t = TASK_FINAL;
return task;
}
}
fprintf (stderr, "INTERNAL ERROR: invoke() surprised!\n");
return NULL;
}
static action_t cont_symbol() {
pop_cont();
expr = lookup(expr);
return ACTION_APPLY_CONT;
}
static action_t cont_if_branches() {
ref_t branches = C(cont)->val[0];
pop_cont();
return eval_expr(isnil(expr) ? cadr(branches) : car(branches));
}
static action_t cont_eval() {
pop_cont();
C(cont)->expand = NO;
return ACTION_EVAL;
}
