#define DBG_POLY(a)
#endif
-ao_lisp_poly
-ao_lisp_eval(ao_lisp_poly v)
+ao_poly
+ao_lisp_eval(ao_poly v)
{
struct ao_lisp_cons *formal;
int cons = 0;
formals_tail = 0;
for (;;) {
+ restart:
/* Build stack frames for each list */
while (ao_lisp_poly_type(v) == AO_LISP_CONS) {
if (v == AO_LISP_NIL)
if (cons++) {
struct ao_lisp_cons *frame;
- frame = ao_lisp_cons(ao_lisp_cons_poly(actuals), formals);
- stack = ao_lisp_cons(ao_lisp_cons_poly(frame), stack);
+ frame = ao_lisp_cons_cons(ao_lisp_cons_poly(actuals), formals);
+ stack = ao_lisp_cons_cons(ao_lisp_cons_poly(frame), stack);
}
actuals = ao_lisp_poly_cons(v);
formals = NULL;
/* Evaluate primitive types */
+ DBG ("actual: "); DBG_POLY(v); DBG("\n");
+
switch (ao_lisp_poly_type(v)) {
case AO_LISP_INT:
case AO_LISP_STRING:
break;
}
+ if (!cons)
+ break;
+
for (;;) {
DBG("add formal: "); DBG_POLY(v); DBG("\n");
- formal = ao_lisp_cons(v, NULL);
+ if (formals == NULL) {
+ if (ao_lisp_poly_type(v) == AO_LISP_BUILTIN) {
+ struct ao_lisp_builtin *b = ao_lisp_poly_builtin(v);
+ switch (b->args) {
+ case AO_LISP_NLAMBDA:
+ v = ao_lisp_func(b)(ao_lisp_poly_cons(actuals->cdr));
+ goto done_eval;
+
+ case AO_LISP_MACRO:
+ v = ao_lisp_func(b)(ao_lisp_poly_cons(actuals->cdr));
+ if (ao_lisp_poly_type(v) != AO_LISP_CONS) {
+ ao_lisp_exception |= AO_LISP_INVALID;
+ return AO_LISP_NIL;
+ }
+
+ /* Reset frame to the new list */
+ actuals = ao_lisp_poly_cons(v);
+ v = actuals->car;
+ goto restart;
+ }
+ }
+ }
+
+ formal = ao_lisp_cons_cons(v, NULL);
if (formals_tail)
- formals_tail->cdr = formal;
+ formals_tail->cdr = ao_lisp_cons_poly(formal);
else
formals = formal;
formals_tail = formal;
- actuals = actuals->cdr;
+ actuals = ao_lisp_poly_cons(actuals->cdr);
DBG("formals: ");
DBG_CONS(formals);
/* Process all of the arguments */
if (actuals) {
v = actuals->car;
- DBG ("actual: "); DBG_POLY(v); DBG("\n");
break;
}
if (ao_lisp_poly_type(v) == AO_LISP_BUILTIN) {
struct ao_lisp_builtin *b = ao_lisp_poly_builtin(v);
- v = b->func(formals->cdr);
+ v = ao_lisp_func(b) (ao_lisp_poly_cons(formals->cdr));
DBG ("eval: ");
DBG_CONS(formals);
DBG_POLY(v);
DBG ("\n");
} else {
- DBG ("invalid eval\n");
+ ao_lisp_exception |= AO_LISP_INVALID;
+ return AO_LISP_NIL;
}
-
+ done_eval:
if (--cons) {
struct ao_lisp_cons *frame;
/* Pop the previous frame off the stack */
frame = ao_lisp_poly_cons(stack->car);
actuals = ao_lisp_poly_cons(frame->car);
- formals = frame->cdr;
+ formals = ao_lisp_poly_cons(frame->cdr);
/* Recompute the tail of the formals list */
- for (formal = formals; formal->cdr != NULL; formal = formal->cdr);
+ for (formal = formals; formal->cdr != AO_LISP_NIL; formal = ao_lisp_poly_cons(formal->cdr));
formals_tail = formal;
- stack = stack->cdr;
+ stack = ao_lisp_poly_cons(stack->cdr);
DBG("stack pop: stack"); DBG_CONS(stack); DBG("\n");
DBG("stack pop: actuals"); DBG_CONS(actuals); DBG("\n");
DBG("stack pop: formals"); DBG_CONS(formals); DBG("\n");