add primitive lazy-eval (STILL BROKEN!)

3 files changed, 67 insertions, 10 deletions

diff --git a/lisp.c b/lisp.c
index 3ef42ce..cbb54ed 100644
--- a/lisp.c
+++ b/lisp.c
@@ -69,6 +69,43 @@ value *make_error(const char *s) {
 	return val;
 }
 
+value *make_thunk(env *e, value *expr) {
+	// don't thunk self-evaluating expressions
+	if (expr->type == VT_INT || 
+            expr->type == VT_DOUBLE || 
+            expr->type == VT_STRING ||
+            expr->type == VT_NIL) {
+		return expr;
+	}
+
+	value *val = malloc(sizeof(value));
+	val->type = VT_THUNK;
+	val->as.thunk.expr = expr;
+	val->as.thunk.cached = NULL;
+	val->as.thunk.env = e;
+	return val;
+}
+
+value *force_thunk(value *v) {
+	if(v->type != VT_THUNK) {
+		return v;
+	}
+	if(v->as.thunk.cached) {
+		printf("\nDEBUG: thunk ");
+		print_value(v->as.thunk.expr);
+		printf(" was already cached as: ");
+		println_value(v->as.thunk.cached);
+		return v->as.thunk.cached;
+	}
+	printf("\nDEBUG: thunk ");
+	print_value(v->as.thunk.expr);
+	printf(" is now cached as: ");
+	println_value(v->as.thunk.cached);
+	
+	v->as.thunk.cached = eval(v->as.thunk.env, v->as.thunk.expr);
+	return v;
+}
+
 value *cons(value *car, value *cdr) {
 	value *val = malloc(sizeof(value));
 	val->type = VT_PAIR;
@@ -170,9 +207,13 @@ void print_value(value *val) {
 		case VT_ERROR:
 			printf("(error \"%s\")", val->as.err);
 			break;
+
+		case VT_THUNK:
+			print_value(force_thunk(val));
+			break;
 		default:
-			fprintf(stderr, "<unknown>[as str:%s][as f:%f][as int:%d]\n", val->as.str, val->as.d, val->as.i);
-			fprintf(stderr, "<unknown>[as pair: (%s . %s)\n", val->as.pair.car, val->as.pair.cdr);
+			printf("\n<unknown>[as str:%s][as f:%f][as int:%d]\n", val->as.str, val->as.d, val->as.i);
+			printf("<unknown>[as pair: (%s . %s)\n", val->as.pair.car, val->as.pair.cdr);
 			break;
 	}
 }
@@ -236,7 +277,7 @@ value *eval(env *e, value *v) {
 			return make_error("symbol not found");
 			///return list(make_symbol("quote"), v); //TODO: return error
 		}
-		return found;
+		return force_thunk(found);
 	}
 
 	//pairs get special treatment
@@ -254,6 +295,7 @@ value *eval_pair(env *e, value *v) {
 	value *head = car(v);
 	value *tail = cdr(v);
 
+	// special forms
 	if (head->type == VT_SYMBOL && !strcmp(head->as.sym, "quote")) {
 		return car(tail);
 	}
@@ -282,7 +324,7 @@ value *eval_pair(env *e, value *v) {
 	}
 
 	if (head->type == VT_SYMBOL && !strcmp(head->as.sym, "if")) {
-		value *test = eval(e, car(tail));
+		value *test = force_thunk(eval(e, car(tail)));
 		if(test->type != VT_NIL) {
 			return eval(e, car(cdr(tail)));
 		} else {
@@ -296,18 +338,18 @@ value *eval_pair(env *e, value *v) {
 		return v;
 	}
 
-	value *head_eval = eval(e, head);
+	value *head_eval = force_thunk(eval(e, head));
 	if (head_eval->type == VT_PROCEDURE) {
 		return head_eval->as.procedure.fn(e, tail);
 	}
 
 	if (head_eval->type == VT_LAMBDA) {
-		//evaluate arguments first, then apply
-		value *args_eval = make_nil();
+		//wrap arguments as thunks
+		value *args_thunks = make_nil();
 		for(value *a = tail; a->type == VT_PAIR; a = cdr(a)) {
-			args_eval = cons(eval(e, car(a)), args_eval);
+			args_thunks = cons(make_thunk(e, car(a)), args_thunks);
 		}
-		return apply(head_eval, reverse(args_eval));
+		return apply(head_eval, reverse(args_thunks));
 	}
 	
 	// else evaluate the list recursively
diff --git a/lisp_api.h b/lisp_api.h
index 77e8d93..90e05e1 100644
--- a/lisp_api.h
+++ b/lisp_api.h
@@ -18,7 +18,8 @@ typedef enum {
 	VT_PAIR,
 	VT_LAMBDA,
 	VT_PROCEDURE,
-	VT_ERROR
+	VT_ERROR,
+	VT_THUNK
 } val_type;
 
 struct value {
@@ -41,6 +42,11 @@ struct value {
 		struct {
 			value *(*fn) (env *, value *);
 		} procedure;
+		struct {
+			value *expr;
+			value *cached;
+			env *env;
+		} thunk;
 	} as;
 };
 
@@ -52,6 +58,8 @@ value *make_nil();
 value *make_lambda(env *e, value *params, value *body);
 value *make_procedure(value *(*fn) (env *, value *));
 value *make_error(const char *str);
+value *make_thunk(env *e, value *expr);
+value *force_thunk(value *v);
 value *cons(value *car, value *cdr);
 value *car(value *cons);
 value *cdr(value *cons);
diff --git a/modules/std_lib.c b/modules/std_lib.c
index f87f2db..a38c5ff 100644
--- a/modules/std_lib.c
+++ b/modules/std_lib.c
@@ -22,6 +22,7 @@ value *procedure_reverse(env *e, value *args) {
 
 value *procedure_isnull(env *e, value *args) {
 	value *v = eval(e, car(args));
+	v = force_thunk(v); 
 	if(v->type == VT_NIL) {
 		return make_int(1);
 	}
@@ -29,6 +30,8 @@ value *procedure_isnull(env *e, value *args) {
 }
 
 int value_eq(value *a, value *b) {
+	a = force_thunk(a); 
+	b = force_thunk(b); 
 	if(a->type != b->type){
 		return 0;
 	}
@@ -54,10 +57,12 @@ int value_eq(value *a, value *b) {
 
 value *procedure_equal(env *e, value *args) {
 	value *v_prev = eval(e, car(args));
+	v_prev = force_thunk(v_prev); 
 
 	args = cdr(args);
 	while (args->type == VT_PAIR) {
 		value *v_cur = eval(e, car(args));
+		v_cur = force_thunk(v_cur); 
 		if (!value_eq(v_prev, v_cur)) {
 			return make_nil();
 		}
@@ -71,6 +76,7 @@ value *procedure_equal(env *e, value *args) {
 value *apply_to_nums(env *e, value *args, double (*fn)(double, double)) {
 	double result;
 	value *v = eval(e, car(args));
+	v = force_thunk(v);
 	if (v->type == VT_INT) {
 		result = v->as.i;
 	} else if (v->type == VT_DOUBLE) {
@@ -125,6 +131,7 @@ value *procedure_div(env *e, value *args) {
 value *procedure_lt(env *e, value *args) {
 	double prev_num;
 	value *v = eval(e, car(args));
+	v = force_thunk(v);
 
 	if (v->type == VT_INT) {
 		prev_num = v->as.i;