altos/lisp: macros appear to work now

Needed an extra stack frame to stash the pre-macro state. This
simplified macro processing quite a bit; a macro now just evaluates
the function and then sends that result to be evaluated again.

Signed-off-by: Keith Packard <keithp@keithp.com>

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index 6a35d8ce3f0493104e4dd683a2762bb3f7dd654e..82ba5a20e1ec20f1bad122c31fc408f3b818f413 100644 (file)
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -78,6 +78,7 @@ extern uint16_t               ao_lisp_top;
 #define AO_LISP_OOM            0x01
 #define AO_LISP_DIVIDE_BY_ZERO 0x02
 #define AO_LISP_INVALID                0x04
+#define AO_LISP_UNDEFINED      0x08
 
 extern uint8_t         ao_lisp_exception;
 
@@ -156,28 +157,25 @@ ao_lisp_frame_poly(struct ao_lisp_frame *frame) {
        return ao_lisp_poly(frame, AO_LISP_OTHER);
 }
 
-struct ao_lisp_stack {
-       ao_poly                 prev;
-       uint8_t                 state;
-       uint8_t                 macro;
-       ao_poly                 sexprs;
-       ao_poly                 values;
-       ao_poly                 values_tail;
-       ao_poly                 frame;
-       ao_poly                 macro_frame;
-       ao_poly                 list;
-};
-
 enum eval_state {
-       eval_sexpr,
+       eval_sexpr,             /* Evaluate an sexpr */
        eval_val,
        eval_formal,
        eval_exec,
-       eval_lambda_done,
        eval_cond,
        eval_cond_test
 };
 
+struct ao_lisp_stack {
+       uint8_t                 state;          /* enum eval_state */
+       ao_poly                 prev;           /* previous stack frame */
+       ao_poly                 sexprs;         /* expressions to evaluate */
+       ao_poly                 values;         /* values computed */
+       ao_poly                 values_tail;    /* end of the values list for easy appending */
+       ao_poly                 frame;          /* current lookup frame */
+       ao_poly                 list;           /* most recent function call */
+};
+
 static inline struct ao_lisp_stack *
 ao_lisp_poly_stack(ao_poly p)
 {
@@ -559,6 +557,16 @@ int ao_lisp_stack_depth;
 #define DBG_POLY(a)    ao_lisp_poly_print(a)
 #define OFFSET(a)      ((a) ? (int) ((uint8_t *) a - ao_lisp_pool) : -1)
 #define DBG_STACK()    ao_lisp_stack_print()
+static inline void
+ao_lisp_frames_dump(void)
+{
+       struct ao_lisp_stack *s;
+       DBGI(".. current frame: "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
+       for (s = ao_lisp_stack; s; s = ao_lisp_poly_stack(s->prev)) {
+               DBGI(".. stack frame: "); DBG_POLY(s->frame); DBG("\n");
+       }
+}
+#define DBG_FRAMES()   ao_lisp_frames_dump()
 #else
 #define DBG_DO(a)
 #define DBG_INDENT()
@@ -570,6 +578,7 @@ int ao_lisp_stack_depth;
 #define DBG_POLY(a)
 #define DBG_RESET()
 #define DBG_STACK()
+#define DBG_FRAMES()
 #endif
 
 #endif /* _AO_LISP_H_ */

diff --git a/src/lisp/ao_lisp_atom.c b/src/lisp/ao_lisp_atom.c
index d7cb19960c46b4482cf1fa0cd7e2cef1fa416edb..5c6d5a67dc72bac26d4abb1afd14a955e7165136 100644 (file)
--- a/src/lisp/ao_lisp_atom.c
+++ b/src/lisp/ao_lisp_atom.c
@@ -134,7 +134,7 @@ ao_lisp_atom_get(ao_poly atom)
 #endif
        if (ref)
                return *ref;
-       return AO_LISP_NIL;
+       return ao_lisp_error(AO_LISP_UNDEFINED, "undefined atom %s", ao_lisp_poly_atom(atom)->name);
 }
 
 ao_poly

diff --git a/src/lisp/ao_lisp_error.c b/src/lisp/ao_lisp_error.c
index cedc107cd8d12e9b172cac677345d813ccef7289..8b9fe2d5fd4d6f9e6993d6ba8b79c4ef2710c8d4 100644 (file)
--- a/src/lisp/ao_lisp_error.c
+++ b/src/lisp/ao_lisp_error.c
@@ -80,17 +80,16 @@ ao_lisp_stack_print(void)
 {
        struct ao_lisp_stack *s;
        printf("Value:  "); ao_lisp_poly_print(ao_lisp_v); printf("\n");
-       ao_lisp_error_frame(0, "Frame:  ", ao_lisp_frame_current);
        printf("Stack:\n");
        for (s = ao_lisp_stack; s; s = ao_lisp_poly_stack(s->prev)) {
                printf("\t[\n");
                printf("\t\texpr:   "); ao_lisp_poly_print(s->list); printf("\n");
                printf("\t\tstate:  %s\n", state_names[s->state]);
-               printf("\t\tmacro:  %s\n", s->macro ? "true" : "false");
+//             printf("\t\tmacro:  %s\n", s->macro ? "true" : "false");
                ao_lisp_error_cons ("sexprs: ", ao_lisp_poly_cons(s->sexprs));
                ao_lisp_error_cons ("values: ", ao_lisp_poly_cons(s->values));
                ao_lisp_error_frame(2, "frame:  ", ao_lisp_poly_frame(s->frame));
-               ao_lisp_error_frame(2, "mframe: ", ao_lisp_poly_frame(s->macro_frame));
+//             ao_lisp_error_frame(2, "mframe: ", ao_lisp_poly_frame(s->macro_frame));
                printf("\t]\n");
        }
 }

diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index f41962195ee7bd4227d1ce91e5cbc87138d807ae..f3372f2a4e52ee73c39985ec9cd3584268694d4c 100644 (file)
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -12,7 +12,7 @@
  * General Public License for more details.
  */
 
-#define DBG_EVAL 1
+#define DBG_EVAL 0
 #include "ao_lisp.h"
 #include <assert.h>
 
@@ -32,7 +32,6 @@ stack_mark(void *addr)
                ao_lisp_poly_mark(stack->values, 0);
                /* no need to mark values_tail */
                ao_lisp_poly_mark(stack->frame, 0);
-               ao_lisp_poly_mark(stack->macro_frame, 0);
                stack = ao_lisp_poly_stack(stack->prev);
                if (ao_lisp_mark_memory(stack, sizeof (struct ao_lisp_stack)))
                        break;
@@ -53,7 +52,6 @@ stack_move(void *addr)
                (void) ao_lisp_poly_move(&stack->values, 0);
                (void) ao_lisp_poly_move(&stack->values_tail, 0);
                (void) ao_lisp_poly_move(&stack->frame, 0);
-               (void) ao_lisp_poly_move(&stack->macro_frame, 0);
                prev = ao_lisp_poly_stack(stack->prev);
                ret = ao_lisp_move(&ao_lisp_stack_type, &prev);
                if (prev != ao_lisp_poly_stack(stack->prev))
@@ -85,28 +83,15 @@ static void
 ao_lisp_stack_reset(struct ao_lisp_stack *stack)
 {
        stack->state = eval_sexpr;
-       stack->macro = 0;
        stack->sexprs = AO_LISP_NIL;
        stack->values = AO_LISP_NIL;
        stack->values_tail = AO_LISP_NIL;
 }
 
-static void
-ao_lisp_frames_dump(void)
-{
-       struct ao_lisp_stack *s;
-       DBGI(".. current frame: "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
-       for (s = ao_lisp_stack; s; s = ao_lisp_poly_stack(s->prev)) {
-               DBGI(".. stack frame: "); DBG_POLY(s->frame); DBG("\n");
-               DBGI(".. macro frame: "); DBG_POLY(s->frame); DBG("\n");
-       }
-}
 
 static int
 ao_lisp_stack_push(void)
 {
-       DBGI("stack push\n");
-       DBG_IN();
        struct ao_lisp_stack    *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
        if (!stack)
                return 0;
@@ -115,7 +100,9 @@ ao_lisp_stack_push(void)
        stack->list = AO_LISP_NIL;
        ao_lisp_stack = stack;
        ao_lisp_stack_reset(stack);
-       ao_lisp_frames_dump();
+       DBGI("stack push\n");
+       DBG_IN();
+       DBG_FRAMES();
        return 1;
 }
 
@@ -124,11 +111,14 @@ ao_lisp_stack_pop(void)
 {
        if (!ao_lisp_stack)
                return;
-       ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
        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;
        DBG_OUT();
        DBGI("stack pop\n");
-       ao_lisp_frames_dump();
+       DBG_FRAMES();
 }
 
 static void
@@ -246,19 +236,20 @@ static int
 ao_lisp_eval_val(void)
 {
        DBGI("val: "); DBG_POLY(ao_lisp_v); DBG("\n");
+#if 0
        if (ao_lisp_stack->macro) {
-               DBGI("..macro %d\n", ao_lisp_stack->macro);
-               DBGI("..current frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
-               DBGI("..saved frame   "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
-               DBGI("..macro frame   "); DBG_POLY(ao_lisp_stack->macro_frame); DBG("\n");
-               DBGI("..sexprs       "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
-               DBGI("..values       "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
+               DBGI(".. end macro %d\n", ao_lisp_stack->macro);
+               DBGI(".. sexprs       "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
+               DBGI(".. values       "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
+               ao_lisp_frames_dump();
+
+               ao_lisp_stack_pop();
+#if 0
                /*
                 * Re-use the current stack to evaluate
                 * the value from the macro
                 */
                ao_lisp_stack->state = eval_sexpr;
-//             assert(ao_lisp_stack->frame == ao_lisp_stack->macro_frame);
                ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->macro_frame);
                ao_lisp_stack->frame = ao_lisp_stack->macro_frame;
                ao_lisp_stack->macro = 0;
@@ -266,7 +257,10 @@ ao_lisp_eval_val(void)
                ao_lisp_stack->sexprs = AO_LISP_NIL;
                ao_lisp_stack->values = AO_LISP_NIL;
                ao_lisp_stack->values_tail = AO_LISP_NIL;
-       } else {
+#endif
+       } else
+#endif
+       {
                /*
                 * Value computed, pop the stack
                 * to figure out what to do with the value
@@ -280,22 +274,25 @@ ao_lisp_eval_val(void)
 /*
  * A formal has been computed.
  *
- * If this is the first formal, then
- * check to see if we've got a lamda/lexpr or
- * macro/nlambda.
+ * If this is the first formal, then check to see if we've got a
+ * lamda/lexpr or macro/nlambda.
+ *
+ * For lambda/lexpr, go compute another formal.  This will terminate
+ * when the sexpr state sees nil.
  *
- * For lambda/lexpr, go compute another formal.
- * This will terminate when the sexpr state
- * sees nil.
+ * For macro/nlambda, we're done, so move the sexprs into the values
+ * and go execute it.
  *
- * For macro/nlambda, we're done, so move the
- * sexprs into the values and go execute it.
+ * Macros have an additional step of saving a stack frame holding the
+ * macro value execution context, which then gets the result of the
+ * macro to run
  */
 
 static int
 ao_lisp_eval_formal(void)
 {
-       ao_poly formal;
+       ao_poly                 formal;
+       struct ao_lisp_stack    *prev;
 
        DBGI("formal: "); DBG_POLY(ao_lisp_v); DBG("\n");
 
@@ -307,17 +304,34 @@ ao_lisp_eval_formal(void)
                        DBGI(".. lambda or lexpr\n");
                        break;
                case AO_LISP_FUNC_MACRO:
-                       ao_lisp_stack->macro = 1;
-                       DBGI(".. macro %d\n", ao_lisp_stack->macro);
-                       DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
-                       DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
-                       ao_lisp_stack->macro_frame = ao_lisp_stack->frame;
+                       /* Evaluate the result once more */
+                       prev = ao_lisp_stack;
+                       ao_lisp_stack->state = eval_sexpr;
+                       if (!ao_lisp_stack_push())
+                               return 0;
+
+                       /* After the function returns, take that
+                        * value and re-evaluate it
+                        */
+                       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");
+                       DBGI(".. values       "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
+                       DBG_FRAMES();
+
                        /* fall through ... */
                case AO_LISP_FUNC_NLAMBDA:
                        DBGI(".. nlambda or macro\n");
+
+                       /* use the raw sexprs as values */
                        ao_lisp_stack->values = ao_lisp_stack->sexprs;
                        ao_lisp_stack->values_tail = AO_LISP_NIL;
                        ao_lisp_stack->state = eval_exec;
+
+                       /* ready to execute now */
                        return 1;
                case -1:
                        return 0;
@@ -397,14 +411,6 @@ ao_lisp_eval_exec(void)
        return 1;
 }
 
-static int
-ao_lisp_eval_lambda_done(void)
-{
-       DBGI("lambda_done: "); DBG_POLY(ao_lisp_v); DBG("\n");
-       DBG_STACK();
-       return 1;
-}
-
 /*
  * Start evaluating the next cond clause
  *
@@ -497,7 +503,6 @@ ao_lisp_eval(ao_poly _v)
                return AO_LISP_NIL;
 
        while (ao_lisp_stack) {
-//             DBG_STACK();
                if (!(*evals[ao_lisp_stack->state])() || ao_lisp_exception) {
                        ao_lisp_stack_clear();
                        return AO_LISP_NIL;