+ (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);
+ stack = ao_lisp_poly_stack(stack->prev);
+ 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 *prev;
+ stack->actuals = ao_lisp_poly_move(stack->actuals);
+ stack->formals = ao_lisp_poly_move(stack->formals);
+ stack->frame = ao_lisp_poly_move(stack->frame);
+ prev = ao_lisp_ref(stack->prev);
+ prev = ao_lisp_move_memory(prev, sizeof (struct ao_lisp_stack));
+ stack->prev = ao_lisp_stack_poly(prev);
+ stack = prev;
+ }
+}
+
+static const struct ao_lisp_type ao_lisp_stack_type = {
+ .size = stack_size,
+ .mark = stack_mark,
+ .move = stack_move
+};
+
+
+static struct ao_lisp_stack *ao_lisp_stack;
+static uint8_t been_here;
+
+ao_poly
+ao_lisp_set_cond(struct ao_lisp_cons *c)
+{
+ return AO_LISP_NIL;
+}
+
+static void
+ao_lisp_stack_reset(struct ao_lisp_stack *stack)
+{
+ stack->state = eval_sexpr;
+ stack->macro = 0;
+ stack->actuals = AO_LISP_NIL;
+ stack->formals = AO_LISP_NIL;
+ stack->formals_tail = AO_LISP_NIL;
+ stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
+}
+
+static struct ao_lisp_stack *
+ao_lisp_stack_push(void)
+{
+ struct ao_lisp_stack *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
+ if (!stack)
+ return NULL;
+ stack->prev = ao_lisp_stack_poly(ao_lisp_stack);
+ ao_lisp_stack_reset(stack);
+ ao_lisp_stack = stack;
+ DBGI("stack push\n");
+ DBG_IN();
+ return stack;
+}
+
+static struct ao_lisp_stack *
+ao_lisp_stack_pop(void)
+{
+ if (!ao_lisp_stack)
+ return NULL;
+ DBG_OUT();
+ DBGI("stack pop\n");
+ ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev);
+ if (ao_lisp_stack)
+ ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
+ else
+ ao_lisp_frame_current = NULL;
+ return ao_lisp_stack;
+}
+
+static void
+ao_lisp_stack_clear(void)
+{
+ ao_lisp_stack = NULL;
+ ao_lisp_frame_current = NULL;
+}
+
+
+static ao_poly
+func_type(ao_poly func)
+{
+ struct ao_lisp_cons *cons;
+ struct ao_lisp_cons *args;
+ int f;
+
+ DBGI("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_BUILTIN) {
+ struct ao_lisp_builtin *b = ao_lisp_poly_builtin(func);
+ return b->args;
+ } else if (ao_lisp_poly_type(func) == AO_LISP_CONS) {
+ 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);
+ } else
+ return ao_lisp_error(AO_LISP_INVALID, "not a func");
+}
+
+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;
+ struct ao_lisp_frame *next_frame;
+ int args_wanted;
+ int args_provided;
+
+ lambda = ao_lisp_poly_cons(ao_lisp_arg(cons, 0));
+ DBGI("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);
+ DBGI("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;
+ }
+ next_frame->next = ao_lisp_frame_poly(ao_lisp_frame_current);
+ ao_lisp_frame_current = next_frame;
+ ao_lisp_stack->frame = ao_lisp_frame_poly(next_frame);
+ return ao_lisp_arg(lambda, 2);
+}
+
+ao_poly
+ao_lisp_eval(ao_poly v)
+{
+ struct ao_lisp_stack *stack;
+ ao_poly formal;