* General Public License for more details.
*/
-#define DBG_EVAL 1
#include "ao_lisp.h"
#include <assert.h>
-static int
-stack_size(void *addr)
-{
- (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->sexprs, 0);
- ao_lisp_poly_mark(stack->values, 0);
- /* no need to mark values_tail */
- ao_lisp_poly_mark(stack->frame, 0);
- stack = ao_lisp_poly_stack(stack->prev);
- if (ao_lisp_mark_memory(stack, sizeof (struct ao_lisp_stack)))
- break;
- }
-}
-
-static const struct ao_lisp_type ao_lisp_stack_type;
-
-static void
-stack_move(void *addr)
-{
- struct ao_lisp_stack *stack = addr;
-
- while (stack) {
- void *prev;
- int ret;
- (void) ao_lisp_poly_move(&stack->sexprs, 0);
- (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);
- prev = ao_lisp_poly_stack(stack->prev);
- ret = ao_lisp_move(&ao_lisp_stack_type, &prev);
- if (prev != ao_lisp_poly_stack(stack->prev))
- stack->prev = ao_lisp_stack_poly(prev);
- if (ret)
- break;
- stack = ao_lisp_poly_stack(stack->prev);
- }
-}
-
-static const struct ao_lisp_type ao_lisp_stack_type = {
- .size = stack_size,
- .mark = stack_mark,
- .move = stack_move
-};
-
struct ao_lisp_stack *ao_lisp_stack;
ao_poly ao_lisp_v;
+uint8_t ao_lisp_skip_cons_free;
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->sexprs = AO_LISP_NIL;
- stack->values = AO_LISP_NIL;
- stack->values_tail = AO_LISP_NIL;
-}
-
-
-static int
-ao_lisp_stack_push(void)
-{
- struct ao_lisp_stack *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;
- ao_lisp_stack = stack;
- ao_lisp_stack_reset(stack);
- DBGI("stack push\n");
- DBG_IN();
- DBG_FRAMES();
- return 1;
-}
-
-static void
-ao_lisp_stack_pop(void)
-{
- if (!ao_lisp_stack)
- return;
- 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");
- DBG_FRAMES();
-}
-
-static void
-ao_lisp_stack_clear(void)
-{
- ao_lisp_stack = NULL;
- ao_lisp_frame_current = NULL;
- ao_lisp_v = AO_LISP_NIL;
-}
-
static int
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;
+ case AO_LISP_STACK:
+ return AO_LISP_FUNC_LAMBDA;
default:
ao_lisp_error(AO_LISP_INVALID, "not a func");
return -1;
static int
ao_lisp_eval_sexpr(void)
{
- DBGI("sexpr: "); DBG_POLY(ao_lisp_v); DBG("\n");
+ DBGI("sexpr: %v\n", ao_lisp_v);
switch (ao_lisp_poly_type(ao_lisp_v)) {
case AO_LISP_CONS:
if (ao_lisp_v == AO_LISP_NIL) {
DBGI("..frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
ao_lisp_v = ao_lisp_atom_get(ao_lisp_v);
/* fall through */
+ case AO_LISP_BOOL:
case AO_LISP_INT:
+ case AO_LISP_BIGINT:
+ case AO_LISP_FLOAT:
case AO_LISP_STRING:
case AO_LISP_BUILTIN:
case AO_LISP_LAMBDA:
ao_lisp_eval_val(void)
{
DBGI("val: "); DBG_POLY(ao_lisp_v); DBG("\n");
-#if 0
- if (ao_lisp_stack->macro) {
- 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;
- 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;
- ao_lisp_stack->macro_frame = AO_LISP_NIL;
- ao_lisp_stack->sexprs = AO_LISP_NIL;
- ao_lisp_stack->values = AO_LISP_NIL;
- ao_lisp_stack->values_tail = AO_LISP_NIL;
-#endif
- } else
-#endif
- {
- /*
- * Value computed, pop the stack
- * to figure out what to do with the value
- */
- ao_lisp_stack_pop();
- }
+ /*
+ * Value computed, pop the stack
+ * to figure out what to do with the value
+ */
+ ao_lisp_stack_pop();
DBGI("..state %d\n", ao_lisp_stack ? ao_lisp_stack->state : -1);
return 1;
}
break;
case AO_LISP_FUNC_MACRO:
/* Evaluate the result once more */
- prev = ao_lisp_stack;
- ao_lisp_stack->state = eval_sexpr;
+ ao_lisp_stack->state = eval_macro;
if (!ao_lisp_stack_push())
return 0;
/* After the function returns, take that
* value and re-evaluate it
*/
- ao_lisp_stack->state = eval_sexpr;
+ prev = ao_lisp_poly_stack(ao_lisp_stack->prev);
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");
+ DBGI("\t.. sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
+ DBGI("\t.. values "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
DBG_FRAMES();
/* fall through ... */
}
/* Append formal to list of values */
- formal = ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_v, NULL));
+ formal = ao_lisp__cons(ao_lisp_v, AO_LISP_NIL);
if (!formal)
return 0;
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);
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 && builtin->args & AO_LISP_FUNC_FREE_ARGS && !ao_lisp_stack_marked(ao_lisp_stack) && !ao_lisp_skip_cons_free)
+ ao_lisp_cons_free(ao_lisp_poly_cons(ao_lisp_stack->values));
+
ao_lisp_v = v;
+ ao_lisp_stack->values = AO_LISP_NIL;
+ ao_lisp_stack->values_tail = AO_LISP_NIL;
DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG ("\n");
DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
break;
case AO_LISP_LAMBDA:
- ao_lisp_stack->state = eval_sexpr;
DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
- ao_lisp_v = ao_lisp_lambda_eval(ao_lisp_poly_lambda(ao_lisp_v),
- ao_lisp_poly_cons(ao_lisp_stack->values));
- DBGI(".. sexpr "); DBG_POLY(ao_lisp_v); DBG("\n");
+ ao_lisp_stack->state = eval_begin;
+ v = ao_lisp_lambda_eval();
+ ao_lisp_stack->sexprs = v;
+ ao_lisp_stack->values = AO_LISP_NIL;
+ ao_lisp_stack->values_tail = AO_LISP_NIL;
+ DBGI(".. sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
+ DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
+ break;
+ case AO_LISP_STACK:
+ DBGI(".. stack "); DBG_POLY(ao_lisp_v); DBG("\n");
+ ao_lisp_v = ao_lisp_stack_eval();
+ DBGI(".. value "); DBG_POLY(ao_lisp_v); DBG("\n");
DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
break;
}
- ao_lisp_stack->values = AO_LISP_NIL;
- ao_lisp_stack->values_tail = AO_LISP_NIL;
+ ao_lisp_skip_cons_free = 0;
+ return 1;
+}
+
+/*
+ * Finish setting up the apply evaluation
+ *
+ * The value is the list to execute
+ */
+static int
+ao_lisp_eval_apply(void)
+{
+ struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_v);
+ struct ao_lisp_cons *cdr, *prev;
+
+ /* Glue the arguments into the right shape. That's all but the last
+ * concatenated onto the last
+ */
+ cdr = cons;
+ for (;;) {
+ prev = cdr;
+ cdr = ao_lisp_poly_cons(prev->cdr);
+ if (cdr->cdr == AO_LISP_NIL)
+ break;
+ }
+ DBGI("before mangling: "); DBG_POLY(ao_lisp_v); DBG("\n");
+ prev->cdr = cdr->car;
+ ao_lisp_stack->values = ao_lisp_v;
+ ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->values)->car;
+ DBGI("apply: "); DBG_POLY(ao_lisp_stack->values); DBG ("\n");
+ ao_lisp_stack->state = eval_exec;
+ ao_lisp_skip_cons_free = 1;
return 1;
}
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");
if (!ao_lisp_stack->sexprs) {
- ao_lisp_v = AO_LISP_NIL;
+ ao_lisp_v = _ao_lisp_bool_false;
ao_lisp_stack->state = eval_val;
} else {
ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
return 0;
}
ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
+ if (ao_lisp_v == _ao_lisp_atom_else)
+ ao_lisp_v = _ao_lisp_bool_true;
ao_lisp_stack->state = eval_cond_test;
if (!ao_lisp_stack_push())
return 0;
- ao_lisp_stack->state = eval_sexpr;
}
return 1;
}
DBGI("cond_test: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
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");
- if (ao_lisp_v) {
+ if (ao_lisp_v != _ao_lisp_bool_false) {
struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car);
- struct ao_lisp_cons *c = ao_lisp_poly_cons(car->cdr);
+ ao_poly c = car->cdr;
- ao_lisp_stack->state = eval_val;
if (c) {
- ao_lisp_v = c->car;
- if (!ao_lisp_stack_push())
- return 0;
- }
+ ao_lisp_stack->state = eval_begin;
+ ao_lisp_stack->sexprs = c;
+ } else
+ ao_lisp_stack->state = eval_val;
} else {
ao_lisp_stack->sexprs = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
DBGI("next cond: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
/*
* Evaluate a list of sexprs, returning the value from the last one.
*
- * ao_lisp_progn records the list in stack->sexprs, so we just need to
+ * ao_lisp_begin records the list in stack->sexprs, so we just need to
* walk that list. Set ao_lisp_v to the car of the list and jump to
* eval_sexpr. When that's done, it will land in eval_val. For all but
- * the last, leave a stack frame with eval_progn set so that we come
+ * the last, leave a stack frame with eval_begin set so that we come
* back here. For the last, don't add a stack frame so that we can
* just continue on.
*/
static int
-ao_lisp_eval_progn(void)
+ao_lisp_eval_begin(void)
{
- DBGI("progn: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
+ DBGI("begin: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
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");
} else {
ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
ao_lisp_stack->sexprs = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
+
+ /* If there are more sexprs to do, then come back here, otherwise
+ * return the value of the last one by just landing in eval_sexpr
+ */
if (ao_lisp_stack->sexprs) {
- ao_lisp_stack->state = eval_progn;
+ ao_lisp_stack->state = eval_begin;
if (!ao_lisp_stack_push())
return 0;
}
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->values = ao_lisp_v;
if (!ao_lisp_stack->sexprs) {
ao_lisp_v = AO_LISP_NIL;
ao_lisp_stack->state = eval_val;
ao_lisp_stack->state = eval_while_test;
if (!ao_lisp_stack_push())
return 0;
- ao_lisp_stack->state = eval_sexpr;
}
return 1;
}
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");
- if (ao_lisp_v) {
+ if (ao_lisp_v != _ao_lisp_bool_false) {
+ ao_lisp_stack->values = ao_lisp_v;
ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
- if (ao_lisp_v)
- ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
ao_lisp_stack->state = eval_while;
if (!ao_lisp_stack_push())
return 0;
+ ao_lisp_stack->state = eval_begin;
+ ao_lisp_stack->sexprs = ao_lisp_v;
}
else
+ {
ao_lisp_stack->state = eval_val;
+ ao_lisp_v = ao_lisp_stack->values;
+ }
+ 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_v == AO_LISP_NIL)
+ ao_lisp_abort();
+ 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;
}
[eval_val] = ao_lisp_eval_val,
[eval_formal] = ao_lisp_eval_formal,
[eval_exec] = ao_lisp_eval_exec,
+ [eval_apply] = ao_lisp_eval_apply,
[eval_cond] = ao_lisp_eval_cond,
[eval_cond_test] = ao_lisp_eval_cond_test,
- [eval_progn] = ao_lisp_eval_progn,
+ [eval_begin] = ao_lisp_eval_begin,
[eval_while] = ao_lisp_eval_while,
[eval_while_test] = ao_lisp_eval_while_test,
+ [eval_macro] = ao_lisp_eval_macro,
};
+const char *ao_lisp_state_names[] = {
+ [eval_sexpr] = "sexpr",
+ [eval_val] = "val",
+ [eval_formal] = "formal",
+ [eval_exec] = "exec",
+ [eval_apply] = "apply",
+ [eval_cond] = "cond",
+ [eval_cond_test] = "cond_test",
+ [eval_begin] = "begin",
+ [eval_while] = "while",
+ [eval_while_test] = "while_test",
+ [eval_macro] = "macro",
+};
+
+/*
+ * Called at restore time to reset all execution state
+ */
+
+void
+ao_lisp_eval_clear_globals(void)
+{
+ ao_lisp_stack = NULL;
+ ao_lisp_frame_current = NULL;
+ ao_lisp_v = AO_LISP_NIL;
+}
+
+int
+ao_lisp_eval_restart(void)
+{
+ return ao_lisp_stack_push();
+}
+
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);
- }
+
+ ao_lisp_frame_init();
if (!ao_lisp_stack_push())
return AO_LISP_NIL;
projects / fw / altos / blobdiff