77 lines
1.5 KiB
C
77 lines
1.5 KiB
C
#include "env.h"
|
|
|
|
#include "prim.h"
|
|
|
|
#include <assert.h>
|
|
#include <string.h>
|
|
|
|
static bool symbol_eq(symbol_t *s, symbol_t *t)
|
|
{
|
|
return s->len == t->len && memcmp(s->buf, t->buf, s->len) == 0;
|
|
}
|
|
|
|
static expr_t **lookup(am_t *am, bool *found)
|
|
{
|
|
assert(AM_EXPR(am) != NULL);
|
|
assert(AM_EXPR(am)->is_atom);
|
|
assert(AM_EXPR(am)->atom.type == ATOM_TYPE_SYMBOL);
|
|
|
|
if (AM_ENV(am)->is_atom) {
|
|
assert(AM_ENV(am)->atom.type == ATOM_TYPE_EMPTY_LIST);
|
|
*found = false;
|
|
return &AM_ENV(am);
|
|
}
|
|
|
|
expr_t *prev;
|
|
for (expr_t *list = AM_ENV(am); !list->is_atom; list = list->pair.cdr) {
|
|
assert(list != NULL);
|
|
|
|
expr_t *entry = list->pair.car;
|
|
assert(!entry->is_atom);
|
|
|
|
expr_t *key = entry->pair.car;
|
|
assert(key != NULL);
|
|
assert(key->is_atom);
|
|
assert(key->atom.type == ATOM_TYPE_SYMBOL);
|
|
|
|
if (symbol_eq(&AM_EXPR(am)->atom.symbol, &key->atom.symbol)) {
|
|
*found = true;
|
|
return &entry->pair.cdr;
|
|
}
|
|
|
|
prev = list;
|
|
}
|
|
|
|
assert(!prev->is_atom);
|
|
assert(prev->pair.cdr->is_atom);
|
|
assert(prev->pair.cdr->atom.type == ATOM_TYPE_EMPTY_LIST);
|
|
*found = false;
|
|
return &prev->pair.cdr;
|
|
}
|
|
|
|
void env_init(am_t *am)
|
|
{
|
|
AM_ENV(am) = expr_empty_list(am);
|
|
prim_load(am);
|
|
}
|
|
|
|
void env_fetch(am_t *am)
|
|
{
|
|
bool found;
|
|
expr_t *val = *lookup(am, &found);
|
|
AM_VAL(am) = found ? val : NULL;
|
|
}
|
|
|
|
void env_set(am_t *am)
|
|
{
|
|
bool found;
|
|
expr_t **loc = lookup(am, &found);
|
|
if (found) {
|
|
*loc = AM_VAL(am);
|
|
} else {
|
|
(*loc)->is_atom = false;
|
|
(*loc)->pair.cdr = expr_empty_list(am);
|
|
(*loc)->pair.car = expr_pair(am, AM_EXPR(am), AM_VAL(am));
|
|
}
|
|
}
|