uns_lisp: change cps-list transformation to make it respect scope

1 files changed, 223 insertions, 275 deletions

diff --git a/examples/lisp/uns_lisp.c b/examples/lisp/uns_lisp.c
index fc53464..f6760a9 100644
--- a/examples/lisp/uns_lisp.c
+++ b/examples/lisp/uns_lisp.c
@@ -891,6 +891,104 @@ static int stack_pop(struct uns_ctr *stack, struct uns_ctr *into)
 	return 1;
 }
 
+static void display(struct uns_ctr *ctr)
+{
+	long indent = 0;
+	long list_part = 0;
+	int add_space = 0;
+	struct uns_ctr stack = {0};
+	struct uns_ctr top = {0};
+	struct uns_ctr ival = {0};
+	struct uns_ctr tmp = {0};
+	struct uns_ctr exprstore = {0};
+	long l;
+	double f;
+
+#define SPC (add_space ? " " : "")
+
+	uns_root_add(gc, &stack);
+	uns_root_add(gc, &top);
+	uns_root_add(gc, &ival);
+	uns_root_add(gc, &tmp);
+	uns_root_add(gc, &exprstore);
+
+	stack.p = empty_list.p;
+	alloc_int(&ival, 0);
+	cons(&top, &ival, ctr); /* (0 . expr) */
+	stack_push(&stack, &top);
+
+	while (stack_pop(&stack, &top)) {
+		ival.p = CAR(top.p);
+		list_part = get_int(&ival);
+		top.p = CDR(top.p);
+
+		switch(get_type(top.p)) {
+		case INTEGER:
+			memcpy(&l, uns_get(gc, top.p, 1, NULL), sizeof(long));
+			printf("%s%ld", SPC, l);
+			break;
+		case FLOAT:
+			memcpy(&f, uns_get(gc, top.p, 1, NULL), sizeof(double));
+			printf("%s%f", SPC, f);
+			break;
+		case STRING:
+			tmp.p = uns_get(gc, top.p, 1, NULL);
+			printf("%s\"%s\"", SPC, uns_string_cstring(gc, &tmp));
+			break;
+		case SYMBOL:
+			tmp.p = uns_get(gc, top.p, 1, NULL);
+			printf("%s%s", SPC, uns_string_cstring(gc, &tmp));
+			break;
+		case EMPTY_LIST:
+			if (list_part) {
+				printf(")");
+				indent--;
+			} else {
+				printf("%s'()", SPC);
+			}
+			break;
+		case LISP_NULL:
+			printf("<undefined>");
+			break;
+		case CELL:
+			alloc_int(&ival, 1);
+			exprstore.p = CDR(top.p);
+			cons(&tmp, &ival, &exprstore);
+			stack_push(&stack, &tmp);
+
+			alloc_int(&ival, 0);
+			exprstore.p = CAR(top.p);
+			cons(&tmp, &ival, &exprstore);
+			stack_push(&stack, &tmp);
+
+			if (!list_part) {
+				if (add_space) {
+					printf("\n");
+					for (l = 0; l < indent; l++) {
+						printf(" ");
+					}
+				} else {
+					printf("%s", SPC);
+				}
+				indent++;
+				printf("(");
+				add_space = 0;
+			}
+			break;
+		}
+
+		if (get_type(top.p) != CELL)
+			add_space = 1;
+	}
+
+	uns_root_remove(gc, &stack);
+	uns_root_remove(gc, &top);
+	uns_root_remove(gc, &ival);
+	uns_root_remove(gc, &tmp);
+	uns_root_remove(gc, &exprstore);
+	printf("\n");
+}
+
 /* Initialize to {__toplevel EXPR} {__cps __return} */
 static void cps_init(struct uns_ctr *prevstack, struct uns_ctr *readstack,
                      struct uns_ctr *expr)
@@ -933,8 +1031,10 @@ enum cps_return {
 	CPS_LIST_INCONSISTENT_LIST,
 	CPS_LIST_UNDERFLOW,
 	CPS_LIST_IMPROPER_LIST,
+	CPS_LIST_BAD_ALIST,
 	CPS_EXEC_INVALID_APPL_LIST,
 	CPS_APP_UNDERFLOW,
+	CPS_FCALL_IMPROPER_LIST,
 
 	CPS_RETURN_LEN
 };
@@ -962,35 +1062,30 @@ static const char *cps_return_to_string[CPS_RETURN_LEN] = {
 	"CPS_IF_OVERFLOW",
 	"CPS_UNQUOTE_INVALID",
 	"CPS_UNQUOTE_LIST_INVALID",
-	"CPS_INVALID_CMD",
 	"CPS_NULL_EXPR",
+	"CPS_INVALID_CMD",
 	"CPS_LIST_INCONSISTENT_LIST",
+	"CPS_LIST_UNDERFLOW",
 	"CPS_LIST_IMPROPER_LIST",
+	"CPS_LIST_BAD_ALIST",
 	"CPS_EXEC_INVALID_APPL_LIST",
 	"CPS_APP_UNDERFLOW",
-	"CPS_LIST_UNDERFLOW"
+	"CPS_FCALL_IMPROPER_LIST",
 };
 
-/* {K (quote QUOTED)} {cps} = {(-> QUOTED K)} */
+/* {K (quote QUOTED)} {cps} = {(-> (quote QUOTED) K)} */
 static enum cps_return cps_exec_quote(struct uns_ctr *prevstack,
                                       struct uns_ctr *K,
-                                      struct uns_ctr *quoted,
+                                      struct uns_ctr *quote,
                                       struct uns_ctr *readstack
                                      )
 {
 	struct uns_ctr wrapped = {0};
 
-	if (get_type(quoted->p) != CELL)
-		return CPS_QUOTE_UNDERFLOW;
-	if (get_type(CDR(quoted->p)) != EMPTY_LIST)
-		return CPS_QUOTE_OVERFLOW;
-
-	quoted->p = CAR(quoted->p);
-
 	uns_root_add(gc, &wrapped);
 	wrapped.p = empty_list.p;
 	stack_push(&wrapped, K);
-	stack_push(&wrapped, quoted);
+	stack_push(&wrapped, quote);
 	stack_push_const(&wrapped, "->");
 
 	stack_push(prevstack, &wrapped);
@@ -999,8 +1094,7 @@ static enum cps_return cps_exec_quote(struct uns_ctr *prevstack,
 	return CPS_CONTINUE;
 }
 
-/* Start quasiquotation:
- * {K (quasiquote E)} {cps} = {K 1 E} {cps-quasiquote}
+/* {K (quasiquote E)} {cps} = {K 1 E} {quasiquote}
  */
 
 static enum cps_return cps_exec_quasiquote(struct uns_ctr *prevstack,
@@ -1205,6 +1299,7 @@ static enum cps_return cps_exec_dynamic_wind(struct uns_ctr *prevstack,
 	return CPS_CONTINUE;
 }
 
+/* {K (call/cc f)} {cps} = {(<- (kappa k (@ f k k)) K)} {} */
 static enum cps_return cps_exec_call_cc(struct uns_ctr *prevstack,
                                         struct uns_ctr *K,
                                         struct uns_ctr *lst,
@@ -1352,94 +1447,99 @@ end:
 	return r;
 }
 
-/* {K (f . L)} {cps} = {(@ f l K) '() [rev L] l} {cps-list} */
-static enum cps_return cps_exec_fcall(struct uns_ctr *prevstack,
-                                      struct uns_ctr *K,
-                                      struct uns_ctr *E,
-                                      struct uns_ctr *readstack
-                                     )
+/* Push to prevstack an assocation list of (gensym . expr), where expr
+ * is evalulated and given the name gensym.
+
+ * combo_in is modified to be a list of symbols, where complex expressions
+ * are replaced with gensyms.
+ */
+static int fcall_lists(struct uns_ctr *prevstack,
+                       struct uns_ctr *combo_in
+                      )
 {
-	/* CAR(E.p) is the symbol */
+	struct uns_ctr revcombo = {0};
+	struct uns_ctr exprs = {0};
 	struct uns_ctr tmp = {0};
-	struct uns_ctr expr = {0};
-	struct uns_ctr l = {0};
+	struct uns_ctr symb = {0};
+	struct uns_ctr alist_cell = {0};
+	int r = 1;
 
-	uns_root_add(gc, &expr);
+	uns_root_add(gc, &revcombo);
+	uns_root_add(gc, &exprs);
 	uns_root_add(gc, &tmp);
-	uns_root_add(gc, &l);
+	uns_root_add(gc, &symb);
+	uns_root_add(gc, &alist_cell);
 
-	gensym(&l);
-	stack_push(prevstack, &l);
+	revcombo.p = exprs.p = empty_list.p;
 
-	tmp.p = CDR(E->p);
-	if (!reverse(&expr, &tmp))
-		return CPS_EXEC_INVALID_APPL_LIST;
-	stack_push(prevstack, &expr);
-	stack_push(prevstack, &empty_list);
+	while (get_type(combo_in->p) != EMPTY_LIST) {
+		if (get_type(combo_in->p) != CELL) {
+			r = 0;
+			goto end;
+		}
 
-	expr.p = empty_list.p;
-	stack_push(&expr, K);
-	stack_push(&expr, &l);
-	tmp.p = CAR(E->p);
-	stack_push(&expr, &tmp);
-	stack_push_const(&expr, "A"); /* (__A f l K) */
-	stack_push(prevstack, &expr);
+		tmp.p = CAR(combo_in->p);
+		if (get_type(tmp.p) == CELL) {
+			gensym(&symb);
+			cons(&alist_cell, &symb, &tmp);
+			stack_push(&exprs, &alist_cell);
+			stack_push(&revcombo, &symb);
+		} else {
+			stack_push(&revcombo, &tmp);
+		}
 
-	stack_push_const(readstack, "cps-list");
+		combo_in->p = CDR(combo_in->p);
+	}
 
-	uns_root_remove(gc, &expr);
+	if (!reverse(combo_in, &revcombo)) {
+		r = 0;
+		goto end;
+	}
+	stack_push(prevstack, &exprs);
+
+end:
+	uns_root_remove(gc, &revcombo);
+	uns_root_remove(gc, &exprs);
 	uns_root_remove(gc, &tmp);
-	uns_root_remove(gc, &l);
-	return CPS_CONTINUE;
+	uns_root_remove(gc, &symb);
+	uns_root_remove(gc, &alist_cell);
+
+	return r;
 }
 
-/* {K (F . L)} {cps} = {(@ f l K) '() [rev L] l f F} {cps-list cps-app} */
-static enum cps_return cps_exec_compound_fcall(struct uns_ctr *prevstack,
-                                               struct uns_ctr *K,
-                                               struct uns_ctr *E,
-                                               struct uns_ctr *readstack
-                                              )
+/* {K (F . L)} {cps} = {(@ (symb1 ... symbn) K) [to-eval L]} {cps-list} */
+static enum cps_return cps_exec_fcall(struct uns_ctr *prevstack,
+                                      struct uns_ctr *K,
+                                      struct uns_ctr *E,
+                                      struct uns_ctr *readstack
+                                     )
 {
-	struct uns_ctr f = {0};
-	struct uns_ctr l = {0};
 	struct uns_ctr tmp = {0};
 	struct uns_ctr expr = {0};
+	enum cps_return r = CPS_CONTINUE;
 
-	uns_root_add(gc, &f);
-	uns_root_add(gc, &l);
-	uns_root_add(gc, &tmp);
 	uns_root_add(gc, &expr);
-	gensym(&f);
-	gensym(&l);
-
-	tmp.p = CAR(E->p);
-	stack_push(prevstack, &tmp);
-	stack_push(prevstack, &f);
-
-	stack_push(prevstack, &l);
+	uns_root_add(gc, &tmp);
 
-	tmp.p = CDR(E->p);
-	if (!reverse(&expr, &tmp))
-		return CPS_EXEC_INVALID_APPL_LIST;
-	stack_push(prevstack, &expr);
-	stack_push(prevstack, &empty_list);
+	tmp.p = E->p;
+	if (!fcall_lists(prevstack, &tmp)) {
+		r = CPS_FCALL_IMPROPER_LIST;
+		goto end;
+	}
+	/* tmp now has simplified combo */
 
 	expr.p = empty_list.p;
 	stack_push(&expr, K);
-	stack_push(&expr, &l);
-	stack_push(&expr, &f);
+	stack_push(&expr, &tmp);
 	stack_push_const(&expr, "A"); /* (__A f l K) */
 	stack_push(prevstack, &expr);
 
-	stack_push_const(readstack, "cps-app");
 	stack_push_const(readstack, "cps-list");
 
-	uns_root_remove(gc, &f);
-	uns_root_remove(gc, &l);
-	uns_root_remove(gc, &tmp);
+end:
 	uns_root_remove(gc, &expr);
-
-	return CPS_CONTINUE;
+	uns_root_remove(gc, &tmp);
+	return r;
 }
 
 static enum cps_return cps_exec_cell(struct uns_ctr *prevstack,
@@ -1462,34 +1562,38 @@ static enum cps_return cps_exec_cell(struct uns_ctr *prevstack,
 	case SYMBOL:
 		symb = get_string(tmp);
 		if (strcmp(symb, "quote") == 0) {
-			tmp->p = CDR(E->p);
-			r = cps_exec_quote(prevstack, K, tmp, readstack);
+			r = cps_exec_quote(prevstack, K, E, readstack);
+			break;
 		} else if (strcmp(symb, "quasiquote") == 0) {
 			tmp->p = CDR(E->p);
 			r = cps_exec_quasiquote(prevstack, K, tmp, readstack);
+			break;
 		} else if (strcmp(symb, "__lambda") == 0) {
 			tmp->p = CDR(E->p);
 			r = cps_exec_lambda(prevstack, K, tmp, readstack);
+			break;
 		} else if (strcmp(symb, "__call/cc") == 0) {
-			/* {K (call/cc f)} {cps} = {(<- (kappa k (@ f k k)) K)} {} */
 			tmp->p = CDR(E->p);
 			r = cps_exec_call_cc(prevstack, K, tmp, readstack);
+			break;
 		} else if (strcmp(symb, "__dynamic-wind") == 0) {
 			tmp->p = CDR(E->p);
 			r = cps_exec_dynamic_wind(prevstack, K, tmp, readstack);
+			break;
 		} else if (strcmp(symb, "unquote") == 0) {
 			r = CPS_UNQUOTE_INVALID;
+			break;
 		} else if (strcmp(symb, "unquote-list") == 0) {
 			r = CPS_UNQUOTE_LIST_INVALID;
+			break;
 		} else if (strcmp(symb, "if") == 0) {
 			 tmp->p = CDR(E->p);
 			 r = cps_exec_if(prevstack, K, tmp, readstack);
-		} else {
-			r = cps_exec_fcall(prevstack, K, E, readstack);
+			break;
 		}
-		break;
+		/* FALLTHROUGH */
 	case CELL:
-		r = cps_exec_compound_fcall(prevstack, K, E, readstack);
+		r = cps_exec_fcall(prevstack, K, E, readstack);
 	}
 
 	return r;
@@ -1544,77 +1648,59 @@ end:
 	return r;
 }
 
-/* {K HEAD '() l} {cps-list} = {(-> HEAD (kappa l K))} {} */
-static enum cps_return cps_list_final(struct uns_ctr *prevstack,
-                                      struct uns_ctr *K,
-                                      struct uns_ctr *head,
-                                      struct uns_ctr *l
-                                     )
-{
-	struct uns_ctr expr = {0};
-	struct uns_ctr tmp = {0};
-
-	uns_root_add(gc, &expr);
-	uns_root_add(gc, &tmp);
-
-	expr.p = empty_list.p;
-	stack_push(&expr, K);
-	stack_push(&expr, l);
-	stack_push_const(&expr, "K");
-
-	tmp.p = expr.p;
-	expr.p = empty_list.p;
-	stack_push(&expr, &tmp);
-	stack_push(&expr, head);
-	stack_push_const(&expr, "->");
-
-	stack_push(prevstack, &expr);
-
-	uns_root_remove(gc, &expr);
-	uns_root_remove(gc, &tmp);
-	return CPS_CONTINUE;
-}
-
-/* {K HEAD (A . B) l} {cps-list} =
-     {(kappa a K) A [cons a HEAD] B l} {cps cps-list}
+/* {K ((symb . E) . B)} {cps-list} =
+     {(kappa symb K) E B} {cps cps-list}
  */
 static enum cps_return cps_list_cell(struct uns_ctr *prevstack,
                                      struct uns_ctr *K,
                                      struct uns_ctr *head,
-                                     struct uns_ctr *args,
                                      struct uns_ctr *readstack
                                     )
 {
 	struct uns_ctr expr = {0};
-	struct uns_ctr atmp = {0};
+	struct uns_ctr alist_elem = {0};
+	struct uns_ctr tmp = {0};
 	enum cps_return r = CPS_CONTINUE;
 
+	uns_root_add(gc, &alist_elem);
+	uns_root_add(gc, &tmp);
 	uns_root_add(gc, &expr);
-	uns_root_add(gc, &atmp);
-	gensym(&atmp);
 
-	expr.p = CDR(args->p);
-	stack_push(prevstack, &expr);
-	cons(&expr, &atmp, head);
-	stack_push(prevstack, &expr);
-	expr.p = CAR(args->p);
-	stack_push(prevstack, &expr);
+	tmp.p = CDR(head->p); /* B */
+	stack_push(prevstack, &tmp);
+
+	alist_elem.p = CAR(head->p);
+	if (get_type(alist_elem.p) != CELL) {
+		r = CPS_LIST_BAD_ALIST;
+		goto end;
+	}
+
+	tmp.p = CDR(alist_elem.p); /* E */
+	stack_push(prevstack, &tmp);
+
+	tmp.p = CAR(alist_elem.p);
+	if (get_type(tmp.p) != SYMBOL) {
+		r = CPS_LIST_BAD_ALIST;
+		goto end;
+	}
 
 	expr.p = empty_list.p;
 	stack_push(&expr, K);
-	stack_push(&expr, &atmp);
+	stack_push(&expr, &tmp);
 	stack_push_const(&expr, "K");
 	stack_push(prevstack, &expr);
 
 	stack_push_const(readstack, "cps-list");
 	stack_push_const(readstack, "cps");
 
+end:
+	uns_root_remove(gc, &alist_elem);
+	uns_root_remove(gc, &tmp);
 	uns_root_remove(gc, &expr);
-	uns_root_remove(gc, &atmp);
 	return r;
 }
 
-/* {K HEAD ARGS l} {cps-list}
+/* {K HEAD} {cps-list}
  */
 static enum cps_return cps_list(struct uns_ctr *prevstack,
                                 struct uns_ctr *readstack
@@ -1622,74 +1708,33 @@ static enum cps_return cps_list(struct uns_ctr *prevstack,
 {
 	struct uns_ctr K = {0};
 	struct uns_ctr head = {0};
-	struct uns_ctr args = {0};
-	struct uns_ctr l = {0};
 	enum cps_return r = CPS_CONTINUE;
 
 	uns_root_add(gc, &K);
 	uns_root_add(gc, &head);
-	uns_root_add(gc, &args);
-	uns_root_add(gc, &l);
 
 	if (!stack_pop(prevstack, &K)
-	    || !stack_pop(prevstack, &head)
-	    || !stack_pop(prevstack, &args)
-	    || !stack_pop(prevstack, &l)) {
+	    || !stack_pop(prevstack, &head)) {
 		r = CPS_LIST_UNDERFLOW;
 		goto end;
 	}
 
-	switch (get_type(args.p)) {
+	switch (get_type(head.p)) {
 	case EMPTY_LIST:
-		r = cps_list_final(prevstack, &K, &head, &l);
+		/* {K '()} {cps-list} = {K} */
+		stack_push(prevstack, &K);
 		break;
 	case CELL:
-		stack_push(prevstack, &l);
-		r = cps_list_cell(prevstack, &K, &head, &args, readstack);
+		r = cps_list_cell(prevstack, &K, &head, readstack);
 		break;
 	default:
 		r = CPS_LIST_IMPROPER_LIST;
 		break;
 	}
-end:
-	uns_root_remove(gc, &K);
-	uns_root_remove(gc, &head);
-	uns_root_remove(gc, &args);
-	uns_root_remove(gc, &l);
-	return r;
-}
-
-/* {K f} {cps-app} = {(kappa f K)} {cps} */
-static enum cps_return cps_app(struct uns_ctr *prevstack,
-                               struct uns_ctr *readstack)
-{
-	struct uns_ctr K = {0};
-	struct uns_ctr fsymb = {0};
-	struct uns_ctr expr = {0};
-	enum cps_return r = CPS_CONTINUE;
-
-	uns_root_add(gc, &K);
-	uns_root_add(gc, &fsymb);
-	uns_root_add(gc, &expr);
-
-	if (!stack_pop(prevstack, &K)
-	    || !stack_pop(prevstack, &fsymb)) {
-		r = CPS_APP_UNDERFLOW;
-		goto end;
-	}
-
-	expr.p = empty_list.p;
-	stack_push(&expr, &K);
-	stack_push(&expr, &fsymb);
-	stack_push_const(&expr, "K");
-	stack_push(prevstack, &expr);
-
-	stack_push_const(readstack, "cps");
 
 end:
 	uns_root_remove(gc, &K);
-	uns_root_remove(gc, &fsymb);
-	uns_root_remove(gc, &expr);
+	uns_root_remove(gc, &head);
 	return r;
 }
 
@@ -1717,8 +1762,6 @@ static enum cps_return cps(struct uns_ctr *prevstack,
 		r = cps_exec(prevstack, readstack);
 	} else if (strcmp(cmd, "cps-list") == 0) {
 		r = cps_list(prevstack, readstack);
-	} else if (strcmp(cmd, "cps-app") == 0) {
-		r = cps_app(prevstack, readstack);
 	} else {
 		r = CPS_INVALID_CMD;
 	}
@@ -1728,104 +1771,6 @@ end:
 	return r;
 }
 
-static void display(struct uns_ctr *ctr)
-{
-	long indent = 0;
-	long list_part = 0;
-	int add_space = 0;
-	struct uns_ctr stack = {0};
-	struct uns_ctr top = {0};
-	struct uns_ctr ival = {0};
-	struct uns_ctr tmp = {0};
-	struct uns_ctr exprstore = {0};
-	long l;
-	double f;
-
-#define SPC (add_space ? " " : "")
-
-	uns_root_add(gc, &stack);
-	uns_root_add(gc, &top);
-	uns_root_add(gc, &ival);
-	uns_root_add(gc, &tmp);
-	uns_root_add(gc, &exprstore);
-
-	stack.p = empty_list.p;
-	alloc_int(&ival, 0);
-	cons(&top, &ival, ctr); /* (0 . expr) */
-	stack_push(&stack, &top);
-
-	while (stack_pop(&stack, &top)) {
-		ival.p = CAR(top.p);
-		list_part = get_int(&ival);
-		top.p = CDR(top.p);
-
-		switch(get_type(top.p)) {
-		case INTEGER:
-			memcpy(&l, uns_get(gc, top.p, 1, NULL), sizeof(long));
-			printf("%s%ld", SPC, l);
-			break;
-		case FLOAT:
-			memcpy(&f, uns_get(gc, top.p, 1, NULL), sizeof(double));
-			printf("%s%f", SPC, f);
-			break;
-		case STRING:
-			tmp.p = uns_get(gc, top.p, 1, NULL);
-			printf("%s\"%s\"", SPC, uns_string_cstring(gc, &tmp));
-			break;
-		case SYMBOL:
-			tmp.p = uns_get(gc, top.p, 1, NULL);
-			printf("%s%s", SPC, uns_string_cstring(gc, &tmp));
-			break;
-		case EMPTY_LIST:
-			if (list_part) {
-				printf(")");
-				indent--;
-			} else {
-				printf("%s'()", SPC);
-			}
-			break;
-		case LISP_NULL:
-			printf("<undefined>");
-			break;
-		case CELL:
-			alloc_int(&ival, 1);
-			exprstore.p = CDR(top.p);
-			cons(&tmp, &ival, &exprstore);
-			stack_push(&stack, &tmp);
-
-			alloc_int(&ival, 0);
-			exprstore.p = CAR(top.p);
-			cons(&tmp, &ival, &exprstore);
-			stack_push(&stack, &tmp);
-
-			if (!list_part) {
-				if (add_space) {
-					printf("\n");
-					for (l = 0; l < indent; l++) {
-						printf(" ");
-					}
-				} else {
-					printf("%s", SPC);
-				}
-				indent++;
-				printf("(");
-				add_space = 0;
-			}
-			break;
-		}
-
-		if (get_type(top.p) != CELL)
-			add_space = 1;
-	}
-
-	uns_root_remove(gc, &stack);
-	uns_root_remove(gc, &top);
-	uns_root_remove(gc, &ival);
-	uns_root_remove(gc, &tmp);
-	uns_root_remove(gc, &exprstore);
-	printf("\n");
-}
-
 static void error(struct location *loc, const char *emsg)
 {
 	fprintf(stderr, "%ld:%ld: ", loc->line, loc->offset);
@@ -1891,12 +1836,15 @@ int main(void)
 			printf("}\n");
 			r = cps(&prevstack, &readstack);
 		} while (r == CPS_CONTINUE);
+		printf("%s\n", cps_return_to_string[r]);
 	}
 
 cleanup:
 	uns_root_remove(gc, &expr);
 	uns_root_remove(gc, &prevstack);
 	uns_root_remove(gc, &readstack);
+	uns_root_remove(gc, &empty_list);
+	uns_collect(gc);
 	uns_deinit(gc);
 	return 0;
 }