uns_lisp: cps transformation of K abstraction

1 files changed, 39 insertions, 1 deletions

diff --git a/examples/lisp/uns_lisp.c b/examples/lisp/uns_lisp.c
index 1d2d28a..cc67959 100644
--- a/examples/lisp/uns_lisp.c
+++ b/examples/lisp/uns_lisp.c
@@ -837,7 +837,7 @@ static void gensym(struct uns_ctr *id)
 	char buf[64];
 	int len;
 
-	len = sprintf(buf, "__%08lx", l);
+	len = sprintf(buf, "__%lx", l);
 	alloc_symbol_from_cstring(id, buf, len);
 
 	l++;
@@ -932,6 +932,7 @@ enum cps_return {
 	CPS_LIST_UNDERFLOW,
 	CPS_LIST_IMPROPER_LIST,
 	CPS_EXEC_INVALID_APPL_LIST,
+	CPS_APP_UNDERFLOW,
 
 	CPS_RETURN_LEN
 };
@@ -964,6 +965,7 @@ static const char *cps_return_to_string[CPS_RETURN_LEN] = {
 	"CPS_LIST_INCONSISTENT_LIST",
 	"CPS_LIST_IMPROPER_LIST",
 	"CPS_EXEC_INVALID_APPL_LIST",
+	"CPS_APP_UNDERFLOW",
 	"CPS_LIST_UNDERFLOW"
 };
 
@@ -1654,6 +1656,40 @@ end:
 	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);
+	return r;
+}
+
 static enum cps_return cps(struct uns_ctr *prevstack,
                            struct uns_ctr *readstack)
 {
@@ -1678,6 +1714,8 @@ 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;
 	}