60 lines
1.1 KiB
C
60 lines
1.1 KiB
C
#include "eval.h"
|
|
|
|
#include "env.h"
|
|
|
|
#include <assert.h>
|
|
|
|
static void eval_atom(am_t *am)
|
|
{
|
|
switch (AM_EXPR(am)->atom.type) {
|
|
case ATOM_TYPE_EMPTY_LIST:
|
|
case ATOM_TYPE_INTEGER:
|
|
case ATOM_TYPE_PRIM_PROC:
|
|
AM_VAL(am) = AM_EXPR(am);
|
|
break;
|
|
case ATOM_TYPE_SYMBOL:
|
|
env_fetch(am);
|
|
break;
|
|
}
|
|
}
|
|
|
|
static void eval_list(am_t *am)
|
|
{
|
|
AM_ARGL(am) = expr_empty_list(am);
|
|
AM_UNEV(am) = AM_EXPR(am)->pair.cdr;
|
|
AM_EXPR(am) = AM_EXPR(am)->pair.car;
|
|
|
|
while (!AM_UNEV(am)->is_atom) {
|
|
am_push(am, EXPR);
|
|
AM_EXPR(am) = AM_UNEV(am)->pair.cdr;
|
|
am_push(am, EXPR);
|
|
am_push(am, ARGL);
|
|
|
|
AM_EXPR(am) = AM_UNEV(am)->pair.car;
|
|
eval(am);
|
|
|
|
am_pop(am, ARGL);
|
|
am_append(am, ARGL, VAL);
|
|
|
|
am_pop(am, UNEV);
|
|
am_pop(am, EXPR);
|
|
}
|
|
|
|
assert(AM_EXPR(am)->is_atom);
|
|
assert(AM_EXPR(am)->atom.type == ATOM_TYPE_SYMBOL);
|
|
env_fetch(am);
|
|
|
|
assert(AM_VAL(am)->is_atom);
|
|
assert(AM_VAL(am)->atom.type == ATOM_TYPE_PRIM_PROC);
|
|
assert(AM_VAL(am)->atom.prim_proc != NULL);
|
|
AM_VAL(am)->atom.prim_proc(am);
|
|
}
|
|
|
|
void eval(am_t *am)
|
|
{
|
|
if (AM_EXPR(am)->is_atom)
|
|
eval_atom(am);
|
|
else
|
|
eval_list(am);
|
|
}
|