uns_lisp: quasiquote parserHEADmaster

2 files changed, 493 insertions, 38 deletions

diff --git a/examples/lisp/prelude.scm b/examples/lisp/prelude.scm
index b181e34..c2a606a 100644
--- a/examples/lisp/prelude.scm
+++ b/examples/lisp/prelude.scm
@@ -74,7 +74,7 @@
 (__define-macro cond body
  (let ((cases (car body)))
   (if (null? body)
-      <undefined>
+      (null)
       (let* ((branch (car cases))
              (rest (cdr cases))
              (test (car branch))
diff --git a/examples/lisp/uns_lisp.c b/examples/lisp/uns_lisp.c
index aa450a1..f714259 100644
--- a/examples/lisp/uns_lisp.c
+++ b/examples/lisp/uns_lisp.c
@@ -69,7 +69,7 @@ static const char *token2string_repr[TOKEN_NUM] = {
 	"quote",
 	"quasiquote",
 	"unquote",
-	"unquote-list",
+	"unquote-splice",
 	"'ident",
 	"'number",
 	"'float",
@@ -392,6 +392,8 @@ static const char *get_string(struct uns_ctr *ctr)
 	case STRING: case SYMBOL:
 		break;
 	default:
+		abort();
+		uns_root_remove(gc, &s);
 		return NULL;
 	}
 
@@ -1011,8 +1013,8 @@ enum cps_return {
 	CPS_CANNOT_CALL_TYPE,
 	CPS_QUOTE_UNDERFLOW,
 	CPS_QUOTE_OVERFLOW,
-	CPS_QUASIQUOTE_UNDERFLOW,
-	CPS_QUASIQUOTE_OVERFLOW,
+	CPS_EXEC_QUASIQUOTE_UNDERFLOW,
+	CPS_EXEC_QUASIQUOTE_OVERFLOW,
 	CPS_EXEC_LAMBDA_UNDERFLOW,
 	CPS_EXEC_LAMBDA_OVERFLOW,
 	CPS_INVALID_LAMBDA_FORMAL,
@@ -1038,6 +1040,13 @@ enum cps_return {
 	CPS_SWAP_UNDERFLOW,
 	CPS_IF_UNDERFLOW,
 	CPS_LAMBDA_UNDERFLOW,
+	CPS_QUASIQUOTE_UNQUOTE_UNDERFLOW,
+	CPS_QUASIQUOTE_UNQUOTE_OVERFLOW,
+	CPS_QUASIQUOTE_SPLICE_UNDERFLOW,
+	CPS_QUASIQUOTE_SPLICE_OVERFLOW,
+	CPS_QUASIQUOTE_UNDERFLOW,
+	CPS_WRAP_SPLICE_UNDERFLOW,
+	CPS_WRAP_UNDERFLOW,
 
 	CPS_RETURN_LEN
 };
@@ -1050,8 +1059,8 @@ static const char *cps_return_to_string[CPS_RETURN_LEN] = {
 	"CPS_CANNOT_CALL_TYPE",
 	"CPS_QUOTE_UNDERFLOW",
 	"CPS_QUOTE_OVERFLOW",
-	"CPS_QUASIQUOTE_UNDERFLOW",
-	"CPS_QUASIQUOTE_OVERFLOW",
+	"CPS_EXEC_QUASIQUOTE_UNDERFLOW",
+	"CPS_EXEC_QUASIQUOTE_OVERFLOW",
 	"CPS_EXEC_LAMBDA_UNDERFLOW",
 	"CPS_EXEC_LAMBDA_OVERFLOW",
 	"CPS_INVALID_LAMBDA_FORMAL",
@@ -1076,13 +1085,20 @@ static const char *cps_return_to_string[CPS_RETURN_LEN] = {
 	"CPS_FCALL_IMPROPER_LIST",
 	"CPS_SWAP_UNDERFLOW",
 	"CPS_IF_UNDERFLOW",
-	"CPS_LAMBDA_UNDERFLOW"
+	"CPS_LAMBDA_UNDERFLOW",
+	"CPS_QUASIQUOTE_UNQUOTE_UNDERFLOW",
+	"CPS_QUASIQUOTE_UNQUOTE_OVERFLOW",
+	"CPS_QUASIQUOTE_SPLICE_UNDERFLOW",
+	"CPS_QUASIQUOTE_SPLICE_OVERFLOW",
+	"CPS_QUASIQUOTE_UNDERFLOW",
+	"CPS_WRAP_SPLICE_UNDERFLOW",
+	"CPS_WRAP_UNDERFLOW"
 };
 
-/* {K (quote QUOTED)} {cps} = {(-> (quote 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 *quote,
+                                      struct uns_ctr *quoted,
                                       struct uns_ctr *readstack
                                      )
 {
@@ -1090,9 +1106,10 @@ static enum cps_return cps_exec_quote(struct uns_ctr *prevstack,
 
 	uns_root_add(gc, &wrapped);
 	wrapped.p = empty_list.p;
+
 	stack_push(&wrapped, K);
-	stack_push(&wrapped, quote);
-	stack_push_const(&wrapped, "->");
+	stack_push(&wrapped, quoted);
+	stack_push_const(&wrapped, "quote->");
 
 	stack_push(prevstack, &wrapped);
 
@@ -1100,7 +1117,7 @@ static enum cps_return cps_exec_quote(struct uns_ctr *prevstack,
 	return CPS_CONTINUE;
 }
 
-/* {K (quasiquote E)} {cps} = {K 1 E} {quasiquote}
+/* {K (quasiquote E)} {cps} = {K E n} {quasiquote}
  */
 
 static enum cps_return cps_exec_quasiquote(struct uns_ctr *prevstack,
@@ -1110,32 +1127,22 @@ static enum cps_return cps_exec_quasiquote(struct uns_ctr *prevstack,
                                           )
 {
 	struct uns_ctr tmp = {0};
-	struct uns_ctr tmpint = {0};
-	const long i = 1;
 
 	if (get_type(quoted->p) != CELL)
-		return CPS_QUASIQUOTE_UNDERFLOW;
+		return CPS_EXEC_QUASIQUOTE_UNDERFLOW;
 	if (get_type(CDR(quoted->p)) != EMPTY_LIST)
-		return CPS_QUASIQUOTE_OVERFLOW;
+		return CPS_EXEC_QUASIQUOTE_OVERFLOW;
 	quoted->p = CAR(quoted->p);
 
-	stack_push(prevstack, quoted);
-
 	uns_root_add(gc, &tmp);
-	alloc_of_type(&tmp, INTEGER);
-
-	uns_root_add(gc, &tmpint);
-	tmpint.p = uns_alloc(gc, sizeof(i), 0);
-	memcpy(tmpint.p, &i, sizeof(i));
-
-	uns_set(gc, tmp.p, 1, UNS_POINTER, tmpint.p);
 
+	alloc_int(&tmp, 1);
 	stack_push(prevstack, &tmp);
+	stack_push(prevstack, quoted);
 	stack_push(prevstack, K);
 
-	stack_push_const(readstack, "quasiquote");
+	stack_push_const(readstack, "qq");
 
-	uns_root_remove(gc, &tmpint);
 	uns_root_remove(gc, &tmp);
 
 	return CPS_CONTINUE;
@@ -1372,6 +1379,7 @@ static enum cps_return cps_exec_if(struct uns_ctr *prevstack,
 	struct uns_ctr b1 = {0};
 	struct uns_ctr b2 = {0};
 	struct uns_ctr e = {0};
+	enum cps_return r = CPS_CONTINUE;
 
 	uns_root_add(gc, &newk);
 	uns_root_add(gc, &e);
@@ -1380,21 +1388,31 @@ static enum cps_return cps_exec_if(struct uns_ctr *prevstack,
 
 	gensym(&newk);
 
-	if (get_type(lst->p) != CELL)
-		return CPS_EXEC_IF_UNDERFLOW;
+	if (get_type(lst->p) != CELL) {
+		r = CPS_EXEC_IF_UNDERFLOW;
+		goto end;
+	}
+
 	e.p = CAR(lst->p);
 	lst->p = CDR(lst->p);
 
-	if (get_type(lst->p) != CELL)
-		return CPS_EXEC_IF_UNDERFLOW;
+	if (get_type(lst->p) != CELL) {
+		r = CPS_EXEC_IF_UNDERFLOW;
+		goto end;
+	}
 	b1.p = CAR(lst->p);
 	lst->p = CDR(lst->p);
 
-	if (get_type(lst->p) != CELL)
-		return CPS_EXEC_IF_UNDERFLOW;
+	if (get_type(lst->p) != CELL) {
+		r = CPS_EXEC_IF_UNDERFLOW;
+		goto end;
+	}
+
 	b2.p = CAR(lst->p);
-	if (get_type(CDR(lst->p)) != EMPTY_LIST)
-		return CPS_EXEC_IF_OVERFLOW;
+	if (get_type(CDR(lst->p)) != EMPTY_LIST) {
+		r =  CPS_EXEC_IF_OVERFLOW;
+		goto end;
+	}
 
 	stack_push(prevstack, &e);
 	stack_push(prevstack, K);
@@ -1414,7 +1432,8 @@ static enum cps_return cps_exec_if(struct uns_ctr *prevstack,
 	uns_root_remove(gc, &b1);
 	uns_root_remove(gc, &b2);
 
-	return CPS_CONTINUE;
+end:
+	return r;
 }
 
 static int reverse(struct uns_ctr *into, struct uns_ctr *from)
@@ -1566,7 +1585,8 @@ static enum cps_return cps_exec_cell(struct uns_ctr *prevstack,
 	case SYMBOL:
 		symb = get_string(tmp);
 		if (strcmp(symb, "quote") == 0) {
-			r = cps_exec_quote(prevstack, K, E, readstack);
+			tmp-> p = CDR(E->p);
+			r = cps_exec_quote(prevstack, K, tmp, readstack);
 			break;
 		} else if (strcmp(symb, "quasiquote") == 0) {
 			tmp->p = CDR(E->p);
@@ -1587,7 +1607,7 @@ static enum cps_return cps_exec_cell(struct uns_ctr *prevstack,
 		} else if (strcmp(symb, "unquote") == 0) {
 			r = CPS_UNQUOTE_INVALID;
 			break;
-		} else if (strcmp(symb, "unquote-list") == 0) {
+		} else if (strcmp(symb, "unquote-splice") == 0) {
 			r = CPS_UNQUOTE_LIST_INVALID;
 			break;
 		} else if (strcmp(symb, "if") == 0) {
@@ -1912,6 +1932,435 @@ end:
 	return r;
 }
 
+enum cps_quasiquote_unquote {
+	CPS_QUASIQUOTE_NONE = 0,
+	CPS_QUASIQUOTE_UNQUOTE = 1,
+	CPS_QUASIQUOTE_UNQUOTE_SPLICE = 2
+};
+
+static enum cps_quasiquote_unquote is_unquote(struct uns_ctr *E)
+{
+	struct uns_ctr carptr = {0};
+	const char *s;
+	enum cps_quasiquote_unquote r = CPS_QUASIQUOTE_NONE;
+
+	uns_root_add(gc, &carptr);
+	carptr.p = CAR(E->p);
+
+	if (get_type(carptr.p) == SYMBOL) {
+		s = get_string(&carptr);
+		if (!s)
+			r = CPS_QUASIQUOTE_NONE;
+		else if (strcmp(s, "unquote") == 0)
+			r = CPS_QUASIQUOTE_UNQUOTE;
+	} else if (get_type(carptr.p) == CELL) {
+		carptr.p = CAR(carptr.p);
+
+		if (get_type(carptr.p) != SYMBOL)
+			goto end;
+		s = get_string(&carptr);
+		if (!s)
+			r = CPS_QUASIQUOTE_NONE;
+		else if (strcmp(s, "unquote-splice") == 0)
+			r = CPS_QUASIQUOTE_UNQUOTE_SPLICE;
+	}
+
+end:
+	uns_root_remove(gc, &carptr);
+	return r;
+}
+
+/*
+   {K (,@A . B) 1} {qq}
+   = {(kappa b (append-> a b K))
+      B 1 a A} {qq wrap cps}
+
+   {K (,@A . B) n} {qq}
+   = { (kappa b (cons-> aquote b K))
+      
+      B n aquote a A [- n 1]} {qq wrap-splice qq}
+ */
+
+static enum cps_return cps_quasiquote_splice(struct uns_ctr *prevstack,
+                                             struct uns_ctr *K,
+                                             struct uns_ctr *E,
+                                             struct uns_ctr *nptr,
+                                             struct uns_ctr *readstack
+                                            )
+{
+	struct uns_ctr A = {0};
+	struct uns_ctr asymb = {0};
+	struct uns_ctr aquote = {0};
+	struct uns_ctr bsymb = {0};
+	struct uns_ctr expr = {0};
+	struct uns_ctr tmp = {0};
+	long n;
+	enum cps_return r = CPS_CONTINUE;
+
+	uns_root_add(gc, &A);
+	uns_root_add(gc, &asymb);
+	uns_root_add(gc, &aquote);
+	uns_root_add(gc, &bsymb);
+	uns_root_add(gc, &expr);
+	uns_root_add(gc, &tmp);
+
+	A.p = CAR(E->p);
+	if (get_type(CDR(A.p)) != CELL) {
+		r = CPS_QUASIQUOTE_SPLICE_UNDERFLOW;
+		goto end;
+	}
+	if (get_type(CDR(CDR(A.p))) != EMPTY_LIST) {
+		r = CPS_QUASIQUOTE_SPLICE_OVERFLOW;
+		goto end;
+	}
+
+	A.p = CAR(CDR(A.p));
+
+	n = get_int(nptr);
+	if (n == 1) {
+		gensym(&asymb);
+		gensym(&bsymb);
+		stack_push(prevstack, &A);
+		stack_push(prevstack, &asymb);
+		stack_push(prevstack, nptr);
+		A.p = CDR(E->p);
+		stack_push(prevstack, &A);
+
+		expr.p = empty_list.p;
+		stack_push(&expr, K);
+		stack_push(&expr, &bsymb);
+		stack_push(&expr, &asymb);
+		stack_push_const(&expr, "append->");
+
+		tmp.p = expr.p;
+		expr.p = empty_list.p;
+		stack_push(&expr, &tmp);
+		stack_push(&expr, &bsymb);
+		stack_push_const(&expr, "K");
+
+		stack_push(prevstack, &expr);
+		stack_push_const(readstack, "cps");
+		stack_push_const(readstack, "wrap");
+		stack_push_const(readstack, "qq");
+	} else {
+		alloc_int(&tmp, n - 1);
+		stack_push(prevstack, &tmp);
+		stack_push(prevstack, &A);
+
+		gensym(&asymb);
+		gensym(&bsymb);
+		gensym(&aquote);
+
+		A.p = CDR(E->p);
+		stack_push(prevstack, nptr);
+		stack_push(prevstack, &aquote);
+		stack_push(prevstack, &asymb);
+		stack_push(prevstack, &A);
+
+		expr.p = empty_list.p;
+		stack_push(&expr, K);
+		stack_push(&expr, &bsymb);
+		stack_push(&expr, &aquote);
+		stack_push_const(&expr, "cons->");
+
+		tmp.p = expr.p;
+		expr.p = empty_list.p;
+		stack_push(&expr, &tmp);
+		stack_push(&expr, &bsymb);
+		stack_push_const(&expr, "K");
+
+		stack_push(prevstack, &expr);
+		stack_push_const(readstack, "qq");
+		stack_push_const(readstack, "wrap-splice");
+		stack_push_const(readstack, "qq");
+	}
+end:
+	uns_root_remove(gc, &A);
+	uns_root_remove(gc, &asymb);
+	uns_root_remove(gc, &aquote);
+	uns_root_remove(gc, &bsymb);
+	uns_root_remove(gc, &expr);
+	uns_root_remove(gc, &tmp);
+	return r;
+}
+
+/*
+  {K ,A 1} {qq} = {K A} {cps}
+  {K ,A n} {qq} = {(kappa a (unquote-> a K)) A [- n 1]} {qq}
+*/
+static enum cps_return cps_quasiquote_unquote(struct uns_ctr *prevstack,
+                                              struct uns_ctr *K,
+                                              struct uns_ctr *E,
+                                              struct uns_ctr *nptr,
+                                              struct uns_ctr *readstack
+                                             )
+{
+	long n;
+	struct uns_ctr expr = {0};
+	struct uns_ctr tmp = {0};
+	struct uns_ctr asym = {0};
+	enum cps_return r = CPS_CONTINUE;
+
+	uns_root_add(gc, &expr);
+	uns_root_add(gc, &tmp);
+	uns_root_add(gc, &asym);
+
+	if (get_type(CDR(E->p)) != CELL) {
+		r = CPS_QUASIQUOTE_UNQUOTE_UNDERFLOW;
+		goto end;
+	}
+	if (get_type(CDR(CDR(E->p))) != EMPTY_LIST) {
+		r = CPS_QUASIQUOTE_UNQUOTE_OVERFLOW;
+		goto end;
+	}
+
+	expr.p = CAR(CDR(E->p));
+
+	n = get_int(nptr);
+	if (n == 1) {
+		stack_push(prevstack, &expr);
+		stack_push(prevstack, K);
+		stack_push_const(readstack, "cps");
+	} else {
+		gensym(&asym);
+		alloc_int(nptr, n - 1);
+		stack_push(prevstack, nptr);
+		stack_push(prevstack, &expr);
+
+		expr.p = empty_list.p;
+		stack_push(&expr, K);
+		stack_push(&expr, &asym);
+		stack_push_const(&expr, "unquote->");
+
+		tmp.p = expr.p;
+		expr.p = empty_list.p;
+		stack_push(&expr, &tmp);
+		stack_push(&expr, &asym);
+		stack_push_const(&expr, "K");
+		stack_push_const(readstack, "qq");
+	}
+
+end:
+	uns_root_remove(gc, &expr);
+	uns_root_remove(gc, &tmp);
+	uns_root_remove(gc, &asym);
+	return r;
+}
+
+/* {K (A . B) n} {qq}
+   = {(kappa b (cons-> a b K))
+      B n a A n} {qq wrap qq}
+ */
+static enum cps_return cps_quasiquote_cons(struct uns_ctr *prevstack,
+                                           struct uns_ctr *K,
+                                           struct uns_ctr *E,
+                                           struct uns_ctr *n,
+                                           struct uns_ctr *readstack
+                                          )
+{
+	struct uns_ctr tmp = {0};
+	struct uns_ctr expr = {0};
+	struct uns_ctr asym = {0};
+	struct uns_ctr bsym = {0};
+
+	uns_root_add(gc, &expr);
+	uns_root_add(gc, &tmp);
+	uns_root_add(gc, &asym);
+	uns_root_add(gc, &bsym);
+	gensym(&asym);
+	gensym(&bsym);
+
+	tmp.p = CAR(E->p);
+	stack_push(prevstack, n);
+	stack_push(prevstack, &tmp);
+	stack_push(prevstack, &asym);
+
+	tmp.p = CDR(E->p);
+	stack_push(prevstack, n);
+	stack_push(prevstack, &tmp);
+
+	expr.p = empty_list.p;
+	stack_push(&expr, K);
+	stack_push(&expr, &bsym);
+	stack_push(&expr, &asym);
+	stack_push_const(&expr, "cons->");
+
+	tmp.p = expr.p;
+	expr.p = empty_list.p;
+	stack_push(&expr, &tmp);
+	stack_push(&expr, &bsym);
+	stack_push_const(&expr, "K");
+
+	stack_push(prevstack, &expr);
+	stack_push_const(readstack, "qq");
+	stack_push_const(readstack, "wrap");
+	stack_push_const(readstack, "qq");
+
+	uns_root_remove(gc, &expr);
+	uns_root_remove(gc, &tmp);
+	uns_root_remove(gc, &asym);
+	uns_root_remove(gc, &bsym);
+
+	return CPS_CONTINUE;
+}
+
+static enum cps_return cps_quasiquote_cell(struct uns_ctr *prevstack,
+                                           struct uns_ctr *K,
+                                           struct uns_ctr *E,
+                                           struct uns_ctr *n,
+                                           struct uns_ctr *readstack
+                                          )
+{
+	switch (is_unquote(E)) {
+	case CPS_QUASIQUOTE_NONE:
+		return cps_quasiquote_cons(prevstack, K, E, n, readstack);
+	case CPS_QUASIQUOTE_UNQUOTE:
+		return cps_quasiquote_unquote(prevstack, K, E, n, readstack);
+	case CPS_QUASIQUOTE_UNQUOTE_SPLICE:
+		return cps_quasiquote_splice(prevstack, K, E, n, readstack);
+	}
+	return CPS_QUASIQUOTE_UNDERFLOW;
+}
+
+/* {K E _} {qq} = {(quote-> E K} */
+static enum cps_return cps_quasiquote_simple(struct uns_ctr *prevstack,
+                                             struct uns_ctr *K,
+                                             struct uns_ctr *quoted
+                                            )
+{
+	struct uns_ctr expr = {0};
+
+	uns_root_add(gc, &expr);
+
+	expr.p = empty_list.p;
+	stack_push(&expr, K);
+	stack_push(&expr, quoted);
+	stack_push_const(&expr, "quote->");
+
+	stack_push(prevstack, &expr);
+
+	uns_root_remove(gc, &expr);
+	return CPS_CONTINUE;
+}
+
+static enum cps_return cps_quasiquote(struct uns_ctr *prevstack,
+                                      struct uns_ctr *readstack
+                                     )
+{
+	struct uns_ctr K = {0};
+	struct uns_ctr expr = {0};
+	struct uns_ctr number = {0};
+	enum cps_return r = CPS_CONTINUE;
+
+	uns_root_add(gc, &K);
+	uns_root_add(gc, &expr);
+	uns_root_add(gc, &number);
+
+	if (!stack_pop(prevstack, &K)
+	    || !stack_pop(prevstack, &expr)
+	    || !stack_pop(prevstack, &number)) {
+		r = CPS_QUASIQUOTE_UNDERFLOW;
+		goto end;
+	}
+
+	switch (get_type(expr.p)) {
+	case CELL:
+		r = cps_quasiquote_cell(prevstack, &K, &expr, &number, readstack);
+		break;
+	default:
+		r = cps_quasiquote_simple(prevstack, &K, &expr);
+	}
+
+end:
+	uns_root_remove(gc, &K);
+	uns_root_remove(gc, &expr);
+	uns_root_remove(gc, &number);
+	return r;
+}
+
+/* {K a} {wrap} = {(kappa a K)} {} */
+static enum cps_return cps_wrap(struct uns_ctr *prevstack)
+{
+	struct uns_ctr K = {0};
+	struct uns_ctr a = {0};
+	struct uns_ctr expr = {0};
+	enum cps_return r = CPS_CONTINUE;
+
+	uns_root_add(gc, &K);
+	uns_root_add(gc, &a);
+	uns_root_add(gc, &expr);
+
+	if (!stack_pop(prevstack, &K)
+	    || !stack_pop(prevstack, &a)) {
+		r = CPS_WRAP_UNDERFLOW;
+		goto end;
+	}
+
+	expr.p = empty_list.p;
+	stack_push(&expr, &K);
+	stack_push(&expr, &a);
+	stack_push_const(&expr, "K");
+
+	stack_push(prevstack, &expr);
+
+end:
+	
+	uns_root_remove(gc, &K);
+	uns_root_remove(gc, &a);
+	uns_root_remove(gc, &expr);
+	return r;
+}
+
+/* {K aquote a} {wrap-splice}
+ = {(kappa a (unquote-splice-> a (kappa aquote K)))}
+ */
+static enum cps_return cps_wrap_splice(struct uns_ctr *prevstack)
+{
+	struct uns_ctr expr = {0};
+	struct uns_ctr tmp = {0};
+	struct uns_ctr K = {0};
+	struct uns_ctr aquote = {0};
+	struct uns_ctr a = {0};
+	enum cps_return r = CPS_CONTINUE;
+
+	uns_root_add(gc, &expr);
+	uns_root_add(gc, &tmp);
+	uns_root_add(gc, &K);
+	uns_root_add(gc, &aquote);
+	uns_root_add(gc, &a);
+
+	if (!stack_pop(prevstack, &K)
+	    || !stack_pop(prevstack, &aquote)
+	    || !stack_pop(prevstack, &a)) {
+		r = CPS_WRAP_SPLICE_UNDERFLOW;
+		goto end;
+	}
+
+	expr.p = empty_list.p;
+	stack_push(&expr, &K);
+	stack_push(&expr, &aquote);
+	stack_push_const(&expr, "K");
+
+	tmp.p = expr.p;
+	expr.p = empty_list.p;
+	stack_push(&expr, &tmp);
+	stack_push(&expr, &a);
+	stack_push_const(&expr, "unquote-splice->");
+
+	tmp.p = expr.p;
+	expr.p = empty_list.p;
+	stack_push(&expr, &tmp);
+	stack_push(&expr, &a);
+	stack_push_const(&expr, "K");
+end:
+	uns_root_remove(gc, &expr);
+	uns_root_remove(gc, &tmp);
+	uns_root_remove(gc, &K);
+	uns_root_remove(gc, &aquote);
+	uns_root_remove(gc, &a);
+	return r;
+}
+
 static enum cps_return cps(struct uns_ctr *prevstack,
                            struct uns_ctr *readstack)
 {
@@ -1942,6 +2391,12 @@ static enum cps_return cps(struct uns_ctr *prevstack,
 		r = cps_if(prevstack, readstack);
 	} else if (strcmp(cmd, "cps-lambda") == 0) {
 		r = cps_lambda(prevstack);
+	} else if (strcmp(cmd, "qq") == 0) {
+		r = cps_quasiquote(prevstack, readstack);
+	} else if (strcmp(cmd, "wrap") == 0) {
+		r = cps_wrap(prevstack);
+	} else if (strcmp(cmd, "wrap-splice") == 0) {
+		r = cps_wrap_splice(prevstack);
 	} else {
 		r = CPS_INVALID_CMD;
 	}