tisp

tiny lisp
git clone git://edryd.org/tisp
Log | Files | Refs | LICENSE

commit f53803f3cb3acfa29a6339c4a1ed54fb3e3f564d
parent 5271b4a8b8969b33404dff0bf2f32a6abe5b900c
Author: Ed van Bruggen <edvb@uw.edu>
Date:   Sun, 15 Sep 2019 17:22:20 -0700

Compartmentalize function scopes with linked hashs

Fixes various issues with macros and functions using old overlapping
variables from different scopes. Each time a function or macro is run a
new environment hash is created to hold that procedure's arguments,
which then links to the old hash. The last hash in this list is the
global namespace where define creates new variables. Variable look up
goes through all hashes start with the most recently created one. At the
end of a function this new hash is simply removed from the front of the
list.

Diffstat:
tibs/lib.tsp | 14+++++++-------
tisp.c | 40+++++++++++++++++-----------------------
2 files changed, 24 insertions(+), 30 deletions(-)

diff --git a/tibs/lib.tsp b/tibs/lib.tsp @@ -88,15 +88,15 @@ (define (list . lst) lst) (define (last lst) - (cond - ((cdr lst) (last (cdr lst))) - (else (car lst)))) + (if (cdr lst) + (last (cdr lst)) + (car lst))) -(define (nth i l) - (when (pair? l) +(define (nth i lst) + (when (pair? lst) (if (<= i 0) - (car l) - (nth (- i 1) (cdr l))))) + (car lst) + (nth (- i 1) (cdr lst))))) (define (apply fn args) (eval (cons fn args))) diff --git a/tisp.c b/tisp.c @@ -35,8 +35,6 @@ /* functions */ static void hash_add(Hash ht, char *key, Val val); -static Hash hash_extend(Hash ht, Val args, Val vals); -static void hash_merge(Hash ht, Hash ht2); /* general utility wrappers */ @@ -217,14 +215,14 @@ hash(char *key) /* create new empty hash table with given capacity */ static Hash -hash_new(size_t cap) +hash_new(size_t cap, Hash next) { if (cap < 1) return NULL; Hash ht = emalloc(sizeof(struct Hash)); ht->size = 0; ht->cap = cap; ht->items = ecalloc(cap, sizeof(struct Entry)); - ht->next = NULL; + ht->next = next; return ht; } @@ -309,17 +307,6 @@ hash_extend(Hash ht, Val args, Val vals) return ht; } -/* add everything from ht2 into ht */ -static void -hash_merge(Hash ht, Hash ht2) -{ - int i; - for (; ht2; ht2 = ht2->next) - for (i = 0; i < ht2->cap; i++) - if (ht2->items[i].key) - hash_add(ht, ht2->items[i].key, ht2->items[i].val); -} - /* clean up hash table */ static void hash_free(Hash ht) @@ -689,6 +676,7 @@ tisp_eval_list(Env env, Val v) static Val eval_proc(Env env, Val v, Val f, Val args) { + Val ret; switch (f->t) { case PRIMITIVE: return (*f->v.pr)(env, args); @@ -699,12 +687,14 @@ eval_proc(Env env, Val v, Val f, Val args) /* FALLTHROUGH */ case MACRO: tsp_arg_num(args, v->t == SYMBOL ? v->v.s : "lambda", list_len(f->v.f.args)); - if (!(hash_extend(f->v.f.env->h, f->v.f.args, args))) + env->h = hash_new(32, env->h); + if (!(hash_extend(env->h, f->v.f.args, args))) return NULL; - hash_merge(f->v.f.env->h, env->h); + ret = list_last(tisp_eval_list(env, f->v.f.body)); if (f->t == MACRO) - return tisp_eval(env, list_last(tisp_eval_list(f->v.f.env, f->v.f.body))); - return list_last(tisp_eval_list(f->v.f.env, f->v.f.body)); + ret = tisp_eval(env, ret); + env->h = env->h->next; + return ret; default: tsp_warnf("attempt to evaluate non procedural type %s", type_str(f->t)); } @@ -941,6 +931,7 @@ static Val prim_define(Env env, Val args) { Val sym, val; + Hash h; if (list_len(args) < 2) tsp_warnf("define: expected 2 or more arguments, received %d", list_len(args)); if (car(args)->t == PAIR) { @@ -953,7 +944,9 @@ prim_define(Env env, Val args) tsp_warn("define: incorrect format, no variable name found"); if (!val) return NULL; - hash_add(env->h, sym->v.s, val); + /* last linked hash is global namespace */ + for (h = env->h; h->next; h = h->next) ; + hash_add(h, sym->v.s, val); return env->none; } @@ -1046,7 +1039,7 @@ tisp_env_init(size_t cap) env->t->t = SYMBOL; env->t->v.s = "t"; - env->h = hash_new(cap); + env->h = hash_new(cap, NULL); tisp_env_add(env, "t", env->t); tsp_env_fn(car); tsp_env_fn(cdr); @@ -1064,11 +1057,12 @@ tisp_env_init(size_t cap) tsp_env_fn(load); tsp_env_fn(version); - env->strs = hash_new(cap); - env->syms = hash_new(cap); + env->strs = hash_new(cap, NULL); + env->syms = hash_new(cap, NULL); env->libh = NULL; env->libhc = 0; + return env; }