peter
/
universalservice
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

uns_lisp: cps transformation of K abstraction

This commit is contained in:
Peter McGoron 2024-07-14 18:42:57 -04:00
parent 63ba63c776
commit 7120703a1e
1 changed files with 39 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
examples/lisp/uns_lisp.c
View File

@ -837,7 +837,7 @@ static void gensym(struct uns_ctr *id)
char buf[64]; char buf[64];
int len; int len;
len = sprintf(buf, "__%08lx", l); len = sprintf(buf, "__%lx", l);
alloc_symbol_from_cstring(id, buf, len); alloc_symbol_from_cstring(id, buf, len);
l++; l++;
@ -932,6 +932,7 @@ enum cps_return {
CPS_LIST_UNDERFLOW, CPS_LIST_UNDERFLOW,
CPS_LIST_IMPROPER_LIST, CPS_LIST_IMPROPER_LIST,
CPS_EXEC_INVALID_APPL_LIST, CPS_EXEC_INVALID_APPL_LIST,
CPS_APP_UNDERFLOW,
CPS_RETURN_LEN CPS_RETURN_LEN
}; };
@ -964,6 +965,7 @@ static const char *cps_return_to_string[CPS_RETURN_LEN] = {
"CPS_LIST_INCONSISTENT_LIST", "CPS_LIST_INCONSISTENT_LIST",
"CPS_LIST_IMPROPER_LIST", "CPS_LIST_IMPROPER_LIST",
"CPS_EXEC_INVALID_APPL_LIST", "CPS_EXEC_INVALID_APPL_LIST",
"CPS_APP_UNDERFLOW",
"CPS_LIST_UNDERFLOW" "CPS_LIST_UNDERFLOW"
}; };
@ -1654,6 +1656,40 @@ end:
return r; 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, static enum cps_return cps(struct uns_ctr *prevstack,
struct uns_ctr *readstack) struct uns_ctr *readstack)
{ {
@ -1678,6 +1714,8 @@ static enum cps_return cps(struct uns_ctr *prevstack,
r = cps_exec(prevstack, readstack); r = cps_exec(prevstack, readstack);
} else if (strcmp(cmd, "cps-list") == 0) { } else if (strcmp(cmd, "cps-list") == 0) {
r = cps_list(prevstack, readstack); r = cps_list(prevstack, readstack);
} else if (strcmp(cmd, "cps-app") == 0) {
r = cps_app(prevstack, readstack);
} else { } else {
r = CPS_INVALID_CMD; r = CPS_INVALID_CMD;
} }