uns_lisp: cps transformation of K abstraction
This commit is contained in:
parent
63ba63c776
commit
7120703a1e
|
@ -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;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue