tisp

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('(');