static struct ao_lisp_cons *formals_tail;
static uint8_t been_here;
-ao_lisp_poly
-ao_lisp_eval(ao_lisp_poly v)
+#if 0
+#define DBG(...) printf(__VA_ARGS__)
+#define DBG_CONS(a) ao_lisp_cons_print(a)
+#define DBG_POLY(a) ao_lisp_poly_print(a)
+#else
+#define DBG(...)
+#define DBG_CONS(a)
+#define DBG_POLY(a)
+#endif
+
+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;
formals_tail = NULL;
v = actuals->car;
- printf("start: stack"); ao_lisp_cons_print(stack); printf("\n");
- printf("start: actuals"); ao_lisp_cons_print(actuals); printf("\n");
- printf("start: formals"); ao_lisp_cons_print(formals); printf("\n");
+ DBG("start: stack"); DBG_CONS(stack); DBG("\n");
+ DBG("start: actuals"); DBG_CONS(actuals); DBG("\n");
+ DBG("start: formals"); DBG_CONS(formals); DBG("\n");
}
/* 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;
case AO_LISP_ATOM:
- v = ao_lisp_poly_atom(v)->val;
+ v = ao_lisp_atom_get(v);
break;
}
+ if (!cons)
+ break;
+
for (;;) {
- printf("add formal: "); ao_lisp_poly_print(v); printf("\n");
+ DBG("add formal: "); DBG_POLY(v); DBG("\n");
+
+ 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));
+ DBG("macro "); DBG_POLY(ao_lisp_cons_poly(actuals));
+ DBG(" -> "); DBG_POLY(v);
+ DBG("\n");
+ 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(v, NULL);
+ 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);
- printf("formals: ");
- ao_lisp_cons_print(formals);
- printf("\n");
- printf("actuals: ");
- ao_lisp_cons_print(actuals);
- printf("\n");
+ DBG("formals: ");
+ DBG_CONS(formals);
+ DBG("\n");
+ DBG("actuals: ");
+ DBG_CONS(actuals);
+ DBG("\n");
/* Process all of the arguments */
if (actuals) {
v = actuals->car;
- printf ("actual: "); ao_lisp_poly_print(v); printf("\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));
- printf ("eval: ");
- ao_lisp_cons_print(formals);
- printf(" -> ");
- ao_lisp_poly_print(v);
- printf ("\n");
+ DBG ("eval: ");
+ DBG_CONS(formals);
+ DBG(" -> ");
+ DBG_POLY(v);
+ DBG ("\n");
} else {
- printf ("invalid eval\n");
+ ao_lisp_exception |= AO_LISP_INVALID;
}
-
+ if (ao_lisp_exception)
+ 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);
+ formals_tail = NULL;
/* Recompute the tail of the formals list */
- for (formal = formals; formal->cdr != NULL; formal = formal->cdr);
- formals_tail = formal;
-
- stack = stack->cdr;
- printf("stack pop: stack"); ao_lisp_cons_print(stack); printf("\n");
- printf("stack pop: actuals"); ao_lisp_cons_print(actuals); printf("\n");
- printf("stack pop: formals"); ao_lisp_cons_print(formals); printf("\n");
+ if (formals) {
+ for (formal = formals; formal->cdr != AO_LISP_NIL; formal = ao_lisp_poly_cons(formal->cdr));
+ formals_tail = formal;
+ }
+
+ 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");
} else {
- printf("done func\n");
+ actuals = 0;
+ formals = 0;
+ formals_tail = 0;
+ DBG("done func\n");
break;
}
}
projects / fw / altos / blobdiff