From 0ee44c8e4bf5dabe6a97bf76b366c8b767c387f8 Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Wed, 9 Nov 2016 11:13:58 -0800 Subject: [PATCH] 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 --- src/lisp/ao_lisp.h | 37 ++++++++------ src/lisp/ao_lisp_atom.c | 2 +- src/lisp/ao_lisp_error.c | 5 +- src/lisp/ao_lisp_eval.c | 105 ++++++++++++++++++++------------------- 4 files changed, 81 insertions(+), 68 deletions(-) diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index 6a35d8ce..82ba5a20 100644 --- 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 d7cb1996..5c6d5a67 100644 --- 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 cedc107c..8b9fe2d5 100644 --- 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 f4196219..f3372f2a 100644 --- 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 @@ -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; -- 2.30.2