Create environment module
This commit is contained in:
80
lib/env.c
Normal file
80
lib/env.c
Normal file
@@ -0,0 +1,80 @@
|
||||
#include "env.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 != NULL);
|
||||
assert(am->expr->is_atom);
|
||||
assert(am->expr->atom.type == ATOM_TYPE_SYMBOL);
|
||||
|
||||
if (am->env->is_atom) {
|
||||
assert(am->env->atom.type == ATOM_TYPE_EMPTY_LIST);
|
||||
*found = false;
|
||||
return &am->env;
|
||||
}
|
||||
|
||||
expr_t *prev;
|
||||
for (expr_t *list = am->env; !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->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, store_t *store)
|
||||
{
|
||||
am->env = store_alloc(store);
|
||||
am->env->is_atom = true;
|
||||
am->env->atom.type = ATOM_TYPE_EMPTY_LIST;
|
||||
}
|
||||
|
||||
void env_fetch(am_t *am)
|
||||
{
|
||||
bool found;
|
||||
expr_t *val = *lookup(am, &found);
|
||||
am->val = found ? val : NULL;
|
||||
}
|
||||
|
||||
void env_set(am_t *am, store_t *store)
|
||||
{
|
||||
bool found;
|
||||
expr_t **loc = lookup(am, &found);
|
||||
if (found) {
|
||||
*loc = am->val;
|
||||
} else {
|
||||
(*loc)->is_atom = false;
|
||||
(*loc)->pair.cdr = store_alloc(store);
|
||||
(*loc)->pair.cdr->is_atom = true;
|
||||
(*loc)->pair.cdr->atom.type = ATOM_TYPE_EMPTY_LIST;
|
||||
|
||||
expr_t *entry = (*loc)->pair.car = store_alloc(store);
|
||||
entry->pair.car = am->expr;
|
||||
entry->pair.cdr = am->val;
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user