63 lines
1.0 KiB
C
63 lines
1.0 KiB
C
#include "eval.h"
|
|
|
|
#include "env.h"
|
|
|
|
#include <assert.h>
|
|
|
|
static void eval_atom(am_t *am)
|
|
{
|
|
switch (am->expr->atom.type) {
|
|
case ATOM_TYPE_EMPTY_LIST:
|
|
case ATOM_TYPE_INTEGER:
|
|
case ATOM_TYPE_PRIM_PROC:
|
|
am->val = am->expr;
|
|
break;
|
|
case ATOM_TYPE_SYMBOL:
|
|
env_fetch(am);
|
|
break;
|
|
}
|
|
}
|
|
|
|
static void eval_list(am_t *am)
|
|
{
|
|
am->argl = expr_empty_list(am);
|
|
am->unev = am->expr->pair.cdr;
|
|
am->expr = am->expr->pair.car;
|
|
|
|
while (!am->unev->is_atom) {
|
|
am_push(am);
|
|
am->expr = am->unev->pair.cdr;
|
|
am_push(am);
|
|
am->expr = am->argl;
|
|
am_push(am);
|
|
|
|
am->expr = am->unev->pair.car;
|
|
eval(am);
|
|
|
|
am_pop(am);
|
|
am->argl = am->expr;
|
|
am_append_arg(am);
|
|
|
|
am_pop(am);
|
|
am->unev = am->expr;
|
|
am_pop(am);
|
|
}
|
|
|
|
assert(am->expr->is_atom);
|
|
assert(am->expr->atom.type == ATOM_TYPE_SYMBOL);
|
|
env_fetch(am);
|
|
|
|
assert(am->val->is_atom);
|
|
assert(am->val->atom.type == ATOM_TYPE_PRIM_PROC);
|
|
assert(am->val->atom.prim_proc != NULL);
|
|
am->val->atom.prim_proc(am);
|
|
}
|
|
|
|
void eval(am_t *am)
|
|
{
|
|
if (am->expr->is_atom)
|
|
eval_atom(am);
|
|
else
|
|
eval_list(am);
|
|
}
|