+struct ao_lisp_stack {
+ ao_poly next;
+ ao_poly actuals;
+ ao_poly formals;
+ ao_poly frame;
+ ao_poly cond;
+};
+
+static struct ao_lisp_stack *
+ao_lisp_poly_stack(ao_poly p)
+{
+ return ao_lisp_ref(p);
+}
+
+static ao_poly
+ao_lisp_stack_poly(struct ao_lisp_stack *stack)
+{
+ return ao_lisp_poly(stack, AO_LISP_OTHER);
+}
+
+static int
+stack_size(void *addr)
+{
+ (void) addr;
+ return sizeof (struct ao_lisp_stack);
+}
+
+static void
+stack_mark(void *addr)
+{
+ struct ao_lisp_stack *stack = addr;
+ for (;;) {
+ ao_lisp_poly_mark(stack->actuals);
+ ao_lisp_poly_mark(stack->formals);
+ ao_lisp_poly_mark(stack->frame);
+ ao_lisp_poly_mark(stack->cond);
+ stack = ao_lisp_poly_stack(stack->next);
+ if (ao_lisp_mark_memory(stack, sizeof (struct ao_lisp_stack)))
+ break;
+ }
+}
+
+static void
+stack_move(void *addr)
+{
+ struct ao_lisp_stack *stack = addr;
+
+ for (;;) {
+ struct ao_lisp_stack *next;
+ stack->actuals = ao_lisp_poly_move(stack->actuals);
+ stack->formals = ao_lisp_poly_move(stack->formals);
+ stack->frame = ao_lisp_poly_move(stack->frame);
+ stack->cond = ao_lisp_poly_move(stack->cond);
+ next = ao_lisp_ref(stack->next);
+ next = ao_lisp_move_memory(next, sizeof (struct ao_lisp_stack));
+ stack->next = ao_lisp_stack_poly(next);
+ stack = next;
+ }
+}
+
+static const struct ao_lisp_type ao_lisp_stack_type = {
+ .size = stack_size,
+ .mark = stack_mark,
+ .move = stack_move
+};
+
+
+static struct ao_lisp_stack *stack;
+static struct ao_lisp_cons *actuals;
+static struct ao_lisp_cons *formals;
+static struct ao_lisp_cons *formals_tail;
+static struct ao_lisp_cons *cond;
+struct ao_lisp_frame *next_frame;
+static uint8_t been_here;
+
+ao_poly
+ao_lisp_set_cond(struct ao_lisp_cons *c)
+{
+ cond = c;
+ return AO_LISP_NIL;
+}
+
+static int
+ao_lisp_stack_push(void)
+{
+ struct ao_lisp_stack *n = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
+ if (!n)
+ return 0;
+ n->next = ao_lisp_stack_poly(stack);
+ n->actuals = ao_lisp_cons_poly(actuals);
+ n->formals = ao_lisp_cons_poly(formals);
+ n->cond = ao_lisp_cons_poly(cond);
+ n->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
+ DBG("push frame %d\n", OFFSET(ao_lisp_frame_current));
+ stack = n;
+ return 1;
+}
+
+static void
+ao_lisp_stack_pop(void)
+{
+ actuals = ao_lisp_poly_cons(stack->actuals);
+ formals = ao_lisp_poly_cons(stack->formals);
+ cond = ao_lisp_poly_cons(stack->cond);
+ ao_lisp_frame_current = ao_lisp_poly_frame(stack->frame);
+ DBG("pop frame %d\n", OFFSET(ao_lisp_frame_current));
+ formals_tail = 0;
+
+ /* Recompute the tail of the formals list */
+ if (formals) {
+ struct ao_lisp_cons *formal;
+ for (formal = formals; formal->cdr != AO_LISP_NIL; formal = ao_lisp_poly_cons(formal->cdr));
+ formals_tail = formal;
+ }
+ stack = ao_lisp_poly_stack(stack->next);
+}
+
+static void
+ao_lisp_stack_clear(void)
+{
+ stack = 0;
+ actuals = formals = formals_tail = 0;
+ cond = 0;
+ ao_lisp_frame_current = 0;
+}
+
+
+static ao_poly
+func_type(ao_poly func)
+{
+ struct ao_lisp_cons *cons;
+ struct ao_lisp_cons *args;
+ int f;
+
+ DBG("func type "); DBG_POLY(func); DBG("\n");
+ if (func == AO_LISP_NIL)
+ return ao_lisp_error(AO_LISP_INVALID, "func is nil");
+ if (ao_lisp_poly_type(func) != AO_LISP_CONS)
+ return ao_lisp_error(AO_LISP_INVALID, "func is not list");
+ cons = ao_lisp_poly_cons(func);
+ if (!ao_lisp_check_argc(_ao_lisp_atom_lambda, cons, 3, 3))
+ return AO_LISP_NIL;
+ if (!ao_lisp_check_argt(_ao_lisp_atom_lambda, cons, 0, AO_LISP_ATOM, 0))
+ return AO_LISP_NIL;
+ if (!ao_lisp_check_argt(_ao_lisp_atom_lambda, cons, 1, AO_LISP_CONS, 1))
+ return AO_LISP_NIL;
+ args = ao_lisp_poly_cons(ao_lisp_arg(cons, 1));
+ f = 0;
+ while (args) {
+ if (ao_lisp_poly_type(args->car) != AO_LISP_ATOM) {
+ return ao_lisp_error(ao_lisp_arg(cons, 0), "formal %d is not an atom", f);
+ }
+ args = ao_lisp_poly_cons(args->cdr);
+ f++;
+ }
+ return ao_lisp_arg(cons, 0);
+}
+
+static int
+ao_lisp_cons_length(struct ao_lisp_cons *cons)
+{
+ int len = 0;
+ while (cons) {
+ len++;
+ cons = ao_lisp_poly_cons(cons->cdr);
+ }
+ return len;
+}
+
+static ao_poly
+ao_lisp_lambda(struct ao_lisp_cons *cons)
+{
+ ao_poly type;
+ struct ao_lisp_cons *lambda;
+ struct ao_lisp_cons *args;
+ int args_wanted;
+ int args_provided;
+
+ lambda = ao_lisp_poly_cons(ao_lisp_arg(cons, 0));
+ DBG("lambda "); DBG_CONS(lambda); DBG("\n");
+ type = ao_lisp_arg(lambda, 0);
+ args = ao_lisp_poly_cons(ao_lisp_arg(lambda, 1));
+
+ args_wanted = ao_lisp_cons_length(args);
+
+ /* Create a frame to hold the variables
+ */
+ if (type == _ao_lisp_atom_lambda)
+ args_provided = ao_lisp_cons_length(cons) - 1;
+ else
+ args_provided = 1;
+ if (args_wanted != args_provided)
+ return ao_lisp_error(AO_LISP_INVALID, "need %d args, not %d", args_wanted, args_provided);
+ next_frame = ao_lisp_frame_new(args_wanted, 0);
+ DBG("new frame %d\n", OFFSET(next_frame));
+ switch (type) {
+ case _ao_lisp_atom_lambda: {
+ int f;
+ struct ao_lisp_cons *vals = ao_lisp_poly_cons(cons->cdr);
+
+ for (f = 0; f < args_wanted; f++) {
+ next_frame->vals[f].atom = args->car;
+ next_frame->vals[f].val = vals->car;
+ args = ao_lisp_poly_cons(args->cdr);
+ vals = ao_lisp_poly_cons(vals->cdr);
+ }
+ break;
+ }
+ case _ao_lisp_atom_lexpr:
+ case _ao_lisp_atom_nlambda:
+ next_frame->vals[0].atom = args->car;
+ next_frame->vals[0].val = cons->cdr;
+ break;
+ case _ao_lisp_atom_macro:
+ next_frame->vals[0].atom = args->car;
+ next_frame->vals[0].val = ao_lisp_cons_poly(cons);
+ break;
+ }
+ return ao_lisp_arg(lambda, 2);
+}
+