tisp

Unnamed repository; edit this file 'description' to name the repository.
git clone git://edryd.org/tisp
Log | Files | Refs | LICENSE

commit a0a2210693fa089417ca5b674384d4387f2e4ae4
parent ec1b1338332e718eb9d7a88d90810a02cdf8af72
Author: Ed van Bruggen <ed@edryd.org>
Date:   Thu, 15 Mar 2018 23:09:31 -0700

Merge pull request #1 from rain-1/master

* Add two functions for extending a hash table with either a list of scheme names and values, or another hash table.
* Add a trampoline for the evaluator to handle proper tail calls.
* Implement closures by extending the environment then handing the body back for the trampoline to continue with.

Diffstat:
tisp.c | 74+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------
1 file changed, 65 insertions(+), 9 deletions(-)

diff --git a/tisp.c b/tisp.c @@ -90,6 +90,8 @@ struct Val { /* functions */ static void hash_add(Hash ht, char *key, Val val); +static void hash_extend(Hash ht, Val args, Val vals); +static void hash_extendh(Hash ht, Hash ht2); Val read_val(Str str); Val read_list(Str str); @@ -202,6 +204,42 @@ hash_add(Hash ht, char *key, Val val) } } +static void +hash_extend(Hash ht, Val args, Val vals) +{ + // add each binding args[i] -> vals[i] + // args and vals are both scheme lists + + Val arg, val; + + while (!nilp(args) && !nilp(vals)) { + arg = car(args); + val = car(vals); + args = cdr(args); + vals = cdr(vals); + if (arg->t != SYMBOL) { + fprintf(stderr, "Error in hash_extend: Argument not a symbol."); + exit(1); + } + hash_add(ht, arg->v.s, val); + } +} + +static void +hash_extendh(Hash ht, Hash ht2) +{ + // add everything from ht2 into ht + + int i; + + while (ht2) { + for (i = 0; i < ht2->cap; i++) { + hash_add(ht, ht2->items[i].key, ht2->items[i].val); + } + ht2 = ht2->next; + } +} + Val mk_val(Type t) { @@ -394,28 +432,50 @@ eval_pair(Hash env, Val v) } static Val -tisp_eval(Hash env, Val v) +tisp_trampoline(Hash env, Val v, int *continu) { - Val f; + Val f, args; switch (v->t) { case NIL: case BOOLEAN: case INTEGER: case RATIONAL: case STRING: + *continu = 0; return v; case SYMBOL: + *continu = 0; return hash_get(env, v->v.s); case PAIR: f = tisp_eval(env, car(v)); - if (f->t != PRIMITIVE) + args = eval_pair(env, cdr(v)); + switch (f->t) { + case PRIMITIVE: + *continu = 0; + return (*f->v.pr)(env, args); + case FUNCTION: + // tail call into the function body with the extended env + hash_extend(env, f->v.f.args, args); + hash_extendh(env, f->v.f.env); + *continu = 1; + return f->v.f.body; + default: die(1, "%s: Attempt to eval non primitive", argv0); - return (*f->v.pr)(env, eval_pair(env, cdr(v))); + } default: break; } return v; } +static Val +tisp_eval(Hash env, Val v) +{ + int continu = 1; + while(continu) + v = tisp_trampoline(env, v, &continu); + return v; +} + /* TODO return str for error msgs? */ static void tisp_print(Val v) @@ -440,11 +500,7 @@ tisp_print(Val v) printf(v->v.s); break; case FUNCTION: - printf("(lambda "); - tisp_print(v->v.f.args); - putchar(' '); - tisp_print(v->v.f.body); - putchar(')'); + printf("#<closure>"); break; case PAIR: putchar('(');