altos/lisp: Evaluate macros once, then smash them into place

[fw/altos] / src / lisp / ao_lisp_eval.c

diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index f945bc163a35cbef1925ca6aa1c124e1376af971..3af567964deab8a4f87d13a26d13425e3508e901 100644 (file)
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -16,6 +16,8 @@
 #include "ao_lisp.h"
 #include <assert.h>
 
+const struct ao_lisp_type ao_lisp_stack_type;
+
 static int
 stack_size(void *addr)
 {
@@ -34,13 +36,11 @@ stack_mark(void *addr)
                ao_lisp_poly_mark(stack->frame, 0);
                ao_lisp_poly_mark(stack->list, 0);
                stack = ao_lisp_poly_stack(stack->prev);
-               if (ao_lisp_mark_memory(stack, sizeof (struct ao_lisp_stack)))
+               if (ao_lisp_mark_memory(&ao_lisp_stack_type, stack))
                        break;
        }
 }
 
-static const struct ao_lisp_type ao_lisp_stack_type;
-
 static void
 stack_move(void *addr)
 {
@@ -57,8 +57,7 @@ stack_move(void *addr)
                prev = ao_lisp_poly_stack(stack->prev);
                if (!prev)
                        break;
-               ret = ao_lisp_move_memory((void **) &prev,
-                                         sizeof (struct ao_lisp_stack));
+               ret = ao_lisp_move_memory(&ao_lisp_stack_type, (void **) &prev);
                if (prev != ao_lisp_poly_stack(stack->prev))
                        stack->prev = ao_lisp_stack_poly(prev);
                if (ret)
@@ -67,15 +66,18 @@ stack_move(void *addr)
        }
 }
 
-static const struct ao_lisp_type ao_lisp_stack_type = {
+const struct ao_lisp_type ao_lisp_stack_type = {
        .size = stack_size,
        .mark = stack_mark,
-       .move = stack_move
+       .move = stack_move,
+       .name = "stack"
 };
 
 struct ao_lisp_stack           *ao_lisp_stack;
 ao_poly                                ao_lisp_v;
 
+struct ao_lisp_stack           *ao_lisp_stack_free_list;
+
 ao_poly
 ao_lisp_set_cond(struct ao_lisp_cons *c)
 {
@@ -97,9 +99,15 @@ ao_lisp_stack_reset(struct ao_lisp_stack *stack)
 static int
 ao_lisp_stack_push(void)
 {
-       struct ao_lisp_stack    *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
-       if (!stack)
-               return 0;
+       struct ao_lisp_stack    *stack;
+       if (ao_lisp_stack_free_list) {
+               stack = ao_lisp_stack_free_list;
+               ao_lisp_stack_free_list = ao_lisp_poly_stack(stack->prev);
+       } else {
+               stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
+               if (!stack)
+                       return 0;
+       }
        stack->prev = ao_lisp_stack_poly(ao_lisp_stack);
        stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
        stack->list = AO_LISP_NIL;
@@ -114,9 +122,15 @@ ao_lisp_stack_push(void)
 static void
 ao_lisp_stack_pop(void)
 {
+       ao_poly prev;
+
        if (!ao_lisp_stack)
                return;
-       ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev);
+       prev = ao_lisp_stack->prev;
+       ao_lisp_stack->prev = ao_lisp_stack_poly(ao_lisp_stack_free_list);
+       ao_lisp_stack_free_list = ao_lisp_stack;
+
+       ao_lisp_stack = ao_lisp_poly_stack(prev);
        if (ao_lisp_stack)
                ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
        else
@@ -141,7 +155,7 @@ func_type(ao_poly func)
                return ao_lisp_error(AO_LISP_INVALID, "func is nil");
        switch (ao_lisp_poly_type(func)) {
        case AO_LISP_BUILTIN:
-               return ao_lisp_poly_builtin(func)->args;
+               return ao_lisp_poly_builtin(func)->args & AO_LISP_FUNC_MASK;
        case AO_LISP_LAMBDA:
                return ao_lisp_poly_lambda(func)->args;
        default:
@@ -284,7 +298,7 @@ ao_lisp_eval_formal(void)
                        break;
                case AO_LISP_FUNC_MACRO:
                        /* Evaluate the result once more */
-                       ao_lisp_stack->state = eval_sexpr;
+                       ao_lisp_stack->state = eval_macro;
                        if (!ao_lisp_stack_push())
                                return 0;
 
@@ -294,7 +308,6 @@ ao_lisp_eval_formal(void)
                        prev = ao_lisp_poly_stack(ao_lisp_stack->prev);
                        ao_lisp_stack->state = eval_sexpr;
                        ao_lisp_stack->sexprs = prev->sexprs;
-                       prev->sexprs = AO_LISP_NIL;
 
                        DBGI(".. start macro\n");
                        DBGI(".. sexprs       "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
@@ -359,12 +372,15 @@ static int
 ao_lisp_eval_exec(void)
 {
        ao_poly v;
+       struct ao_lisp_builtin  *builtin;
+
        DBGI("exec: "); DBG_POLY(ao_lisp_v); DBG(" values "); DBG_POLY(ao_lisp_stack->values); DBG ("\n");
        ao_lisp_stack->sexprs = AO_LISP_NIL;
        switch (ao_lisp_poly_type(ao_lisp_v)) {
        case AO_LISP_BUILTIN:
                ao_lisp_stack->state = eval_val;
-               v = ao_lisp_func(ao_lisp_poly_builtin(ao_lisp_v)) (
+               builtin = ao_lisp_poly_builtin(ao_lisp_v);
+               v = ao_lisp_func(builtin) (
                        ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->values)->cdr));
                DBG_DO(if (!ao_lisp_exception && ao_lisp_poly_builtin(ao_lisp_v)->func == builtin_set) {
                                struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_stack->values);
@@ -372,6 +388,10 @@ ao_lisp_eval_exec(void)
                                ao_poly val = ao_lisp_arg(cons, 2);
                                DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n");
                        });
+               builtin = ao_lisp_poly_builtin(ao_lisp_v);
+               if (builtin->args & AO_LISP_FUNC_FREE_ARGS)
+                       ao_lisp_cons_free(ao_lisp_poly_cons(ao_lisp_stack->values));
+
                ao_lisp_v = v;
                DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG ("\n");
                DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
@@ -534,6 +554,25 @@ ao_lisp_eval_while_test(void)
        return 1;
 }
 
+/*
+ * Replace the original sexpr with the macro expansion, then
+ * execute that
+ */
+static int
+ao_lisp_eval_macro(void)
+{
+       DBGI("macro: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
+
+       if (ao_lisp_poly_type(ao_lisp_v) == AO_LISP_CONS) {
+               *ao_lisp_poly_cons(ao_lisp_stack->sexprs) = *ao_lisp_poly_cons(ao_lisp_v);
+               ao_lisp_v = ao_lisp_stack->sexprs;
+               DBGI("sexprs rewritten to: "); DBG_POLY(ao_lisp_v); DBG("\n");
+       }
+       ao_lisp_stack->sexprs = AO_LISP_NIL;
+       ao_lisp_stack->state = eval_sexpr;
+       return 1;
+}
+
 static int (*const evals[])(void) = {
        [eval_sexpr] = ao_lisp_eval_sexpr,
        [eval_val] = ao_lisp_eval_val,
@@ -544,6 +583,7 @@ static int (*const evals[])(void) = {
        [eval_progn] = ao_lisp_eval_progn,
        [eval_while] = ao_lisp_eval_while,
        [eval_while_test] = ao_lisp_eval_while_test,
+       [eval_macro] = ao_lisp_eval_macro,
 };
 
 /*
@@ -567,14 +607,7 @@ ao_lisp_eval_restart(void)
 ao_poly
 ao_lisp_eval(ao_poly _v)
 {
-       static uint8_t been_here;
-
        ao_lisp_v = _v;
-       if (!been_here) {
-               been_here = 1;
-               ao_lisp_root_add(&ao_lisp_stack_type, &ao_lisp_stack);
-               ao_lisp_root_poly_add(&ao_lisp_v);
-       }
 
        if (!ao_lisp_stack_push())
                return AO_LISP_NIL;