#include "env.h" #include #include 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; } }