* General Public License for more details.
*/
-#define DBG_EVAL 0
#include "ao_lisp.h"
#include <assert.h>
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)
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:
}
/* 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;
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_stack_marked(ao_lisp_stack))
+ 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;
break;
case AO_LISP_LAMBDA:
DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
- ao_lisp_stack->state = eval_progn;
+ ao_lisp_stack->state = eval_begin;
v = ao_lisp_lambda_eval();
ao_lisp_stack->sexprs = v;
ao_lisp_stack->values = AO_LISP_NIL;
DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
break;
}
+ 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;
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);
ao_poly c = car->cdr;
if (c) {
- ao_lisp_stack->state = eval_progn;
+ ao_lisp_stack->state = eval_begin;
ao_lisp_stack->sexprs = c;
} else
ao_lisp_stack->state = eval_val;
/*
* 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");
* 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");
- 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;
ao_lisp_stack->state = eval_while;
if (!ao_lisp_stack_push())
return 0;
- ao_lisp_stack->state = eval_progn;
+ ao_lisp_stack->state = eval_begin;
ao_lisp_stack->sexprs = ao_lisp_v;
}
else
[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[] = {
- "sexpr",
- "val",
- "formal",
- "exec",
- "cond",
- "cond_test",
- "progn",
+ [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",
};
/*
{
ao_lisp_v = _v;
+ ao_lisp_frame_init();
+
if (!ao_lisp_stack_push())
return AO_LISP_NIL;