summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lisp/ao_lisp.h37
-rw-r--r--src/lisp/ao_lisp_atom.c2
-rw-r--r--src/lisp/ao_lisp_error.c5
-rw-r--r--src/lisp/ao_lisp_eval.c105
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 <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;
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 23:32:03 +0000