commit 2e270bab7649ed63acb904dd69fa13d773739683
parent 284712943f8c46e8709e91f78da2365d3aa61ff9
Author: Andres Navarro <canavarro82@gmail.com>
Date: Tue, 22 Nov 2011 18:05:12 -0300
Refactored all operative underlying functions to just take a klisp state pointer.
Diffstat:
61 files changed, 1309 insertions(+), 604 deletions(-)
diff --git a/src/kcontinuation.c b/src/kcontinuation.c
@@ -12,7 +12,7 @@
#include "kmem.h"
#include "kgc.h"
-TValue kmake_continuation(klisp_State *K, TValue parent, klisp_Cfunc fn,
+TValue kmake_continuation(klisp_State *K, TValue parent, klisp_CFunction fn,
int32_t xcount, ...)
{
va_list argp;
diff --git a/src/kcontinuation.h b/src/kcontinuation.h
@@ -11,7 +11,7 @@
#include "kstate.h"
/* TODO: make some specialized constructors for 0, 1 and 2 parameters */
-TValue kmake_continuation(klisp_State *K, TValue parent, klisp_Cfunc fn,
+TValue kmake_continuation(klisp_State *K, TValue parent, klisp_CFunction fn,
int xcount, ...);
#endif
diff --git a/src/keval.c b/src/keval.c
@@ -144,22 +144,29 @@ void do_combine(klisp_State *K)
}
/* the underlying function of the eval operative */
-void keval_ofn(klisp_State *K, TValue *xparams, TValue obj, TValue env)
+void keval_ofn(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+
UNUSED(xparams);
+ TValue obj = ptree;
+
switch(ttype(obj)) {
case K_TPAIR: {
TValue new_cont =
kmake_continuation(K, kget_cc(K), do_combine, 3, kcdr(obj),
- env, ktry_get_si(K, obj));
+ denv, ktry_get_si(K, obj));
kset_cc(K, new_cont);
- ktail_eval(K, kcar(obj), env);
+ ktail_eval(K, kcar(obj), denv);
break;
}
case K_TSYMBOL:
/* error handling happens in kget_binding */
- kapply_cc(K, kget_binding(K, env, obj));
+ kapply_cc(K, kget_binding(K, denv, obj));
break;
default:
kapply_cc(K, obj);
diff --git a/src/keval.h b/src/keval.h
@@ -11,7 +11,7 @@
#include "kstate.h"
#include "kobject.h"
-void keval_ofn(klisp_State *K, TValue *xparams, TValue obj, TValue env);
+void keval_ofn(klisp_State *K);
void do_eval_ls(klisp_State *K);
void do_combine(klisp_State *K);
diff --git a/src/kgbooleans.c b/src/kgbooleans.c
@@ -23,8 +23,12 @@
/* uses typep */
/* 6.1.1 not? */
-void notp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void notp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -38,8 +42,12 @@ void notp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
bool kbooleanp(TValue obj) { return ttisboolean(obj); }
/* 6.1.2 and? */
-void andp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void andp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
/* don't care about cycle pairs */
@@ -59,8 +67,12 @@ void andp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 6.1.3 or? */
-void orp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void orp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
/* don't care about cycle pairs */
@@ -144,8 +156,12 @@ void do_Sandp_Sorp(klisp_State *K)
}
}
-void Sandp_Sorp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Sandp_Sorp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: symbol name
** xparams[1]: termination boolean
diff --git a/src/kgbooleans.h b/src/kgbooleans.h
@@ -22,17 +22,17 @@
/* uses typep */
/* 6.1.1 not? */
-void notp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void notp(klisp_State *K);
/* 6.1.2 and? */
-void andp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void andp(klisp_State *K);
/* 6.1.3 or? */
-void orp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void orp(klisp_State *K);
/* Helpers for $and? & $or? */
void do_Sandp_Sorp(klisp_State *K);
-void Sandp_Sorp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Sandp_Sorp(klisp_State *K);
/* 6.1.4 $and? */
/* uses Sandp_Sorp */
diff --git a/src/kgbytevectors.c b/src/kgbytevectors.c
@@ -30,9 +30,12 @@
/* use ftypep */
/* 13.1.2? make-bytevector */
-void make_bytevector(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void make_bytevector(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_al1tp(K, ptree, "exact integer", keintegerp, tv_s,
@@ -55,9 +58,12 @@ void make_bytevector(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 13.1.3? bytevector-length */
-void bytevector_length(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void bytevector_length(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "bytevector", ttisbytevector, bytevector);
@@ -67,9 +73,12 @@ void bytevector_length(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 13.1.4? bytevector-u8-ref */
-void bytevector_u8_ref(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void bytevector_u8_ref(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_2tp(K, ptree, "bytevector", ttisbytevector, bytevector,
@@ -93,9 +102,12 @@ void bytevector_u8_ref(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 13.1.5? bytevector-u8-set! */
-void bytevector_u8_setS(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void bytevector_u8_setS(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_3tp(K, ptree, "bytevector", ttisbytevector, bytevector,
@@ -124,9 +136,12 @@ void bytevector_u8_setS(klisp_State *K, TValue *xparams, TValue ptree,
/* 13.2.8? bytevector-copy */
/* TEMP: at least for now this always returns mutable bytevectors */
-void bytevector_copy(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void bytevector_copy(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "bytevector", ttisbytevector, bytevector);
@@ -143,9 +158,12 @@ void bytevector_copy(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 13.2.9? bytevector-copy! */
-void bytevector_copyS(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void bytevector_copyS(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_2tp(K, ptree, "bytevector", ttisbytevector, bytevector1,
@@ -170,9 +188,12 @@ void bytevector_copyS(klisp_State *K, TValue *xparams, TValue ptree,
/* 13.2.10? bytevector-copy-partial */
/* TEMP: at least for now this always returns mutable bytevectors */
-void bytevector_copy_partial(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void bytevector_copy_partial(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_3tp(K, ptree, "bytevector", ttisbytevector, bytevector,
@@ -215,9 +236,12 @@ void bytevector_copy_partial(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 13.2.11? bytevector-copy-partial! */
-void bytevector_copy_partialS(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void bytevector_copy_partialS(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_al3tp(K, ptree, "bytevector", ttisbytevector, bytevector1,
@@ -284,9 +308,12 @@ void bytevector_copy_partialS(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 13.2.12? bytevector->immutable-bytevector */
-void bytevector_to_immutable_bytevector(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void bytevector_to_immutable_bytevector(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "bytevector", ttisbytevector, bytevector);
diff --git a/src/kgbytevectors.h b/src/kgbytevectors.h
@@ -22,40 +22,31 @@
/* uses typep */
/* ??.1.2? make-bytevector */
-void make_bytevector(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void make_bytevector(klisp_State *K);
/* ??.1.3? bytevector-length */
-void bytevector_length(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void bytevector_length(klisp_State *K);
/* ??.1.4? bytevector-u8-ref */
-void bytevector_u8_ref(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void bytevector_u8_ref(klisp_State *K);
/* ??.1.5? bytevector-u8-set! */
-void bytevector_u8_setS(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void bytevector_u8_setS(klisp_State *K);
/* ??.2.?? bytevector-copy */
-void bytevector_copy(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void bytevector_copy(klisp_State *K);
/* ??.2.?? bytevector-copy! */
-void bytevector_copyS(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void bytevector_copyS(klisp_State *K);
/* ??.2.?? bytevector-copy-partial */
-void bytevector_copy_partial(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void bytevector_copy_partial(klisp_State *K);
/* ??.2.?? bytevector-copy-partial! */
-void bytevector_copy_partialS(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void bytevector_copy_partialS(klisp_State *K);
/* ??.2.?? bytevector->immutable-bytevector */
-void bytevector_to_immutable_bytevector(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv);
+void bytevector_to_immutable_bytevector(klisp_State *K);
/* init ground */
void kinit_bytevectors_ground_env(klisp_State *K);
diff --git a/src/kgchars.c b/src/kgchars.c
@@ -39,9 +39,12 @@ bool kchar_upper_casep(TValue ch) { return isupper(chvalue(ch)) != 0; }
bool kchar_lower_casep(TValue ch) { return islower(chvalue(ch)) != 0; }
/* 14.1.4? char->integer, integer->char */
-void kchar_to_integer(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kchar_to_integer(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "character", ttischar, ch);
@@ -49,9 +52,12 @@ void kchar_to_integer(klisp_State *K, TValue *xparams, TValue ptree,
kapply_cc(K, i2tv((int32_t) chvalue(ch)));
}
-void kinteger_to_char(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kinteger_to_char(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "exact integer", ttiseinteger, itv);
@@ -71,9 +77,12 @@ void kinteger_to_char(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 14.1.4? char-upcase, char-downcase */
-void kchar_upcase(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kchar_upcase(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "character", ttischar, chtv);
@@ -82,9 +91,12 @@ void kchar_upcase(klisp_State *K, TValue *xparams, TValue ptree,
kapply_cc(K, ch2tv(ch));
}
-void kchar_downcase(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kchar_downcase(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "character", ttischar, chtv);
diff --git a/src/kgchars.h b/src/kgchars.h
@@ -38,16 +38,12 @@ bool kchar_upper_casep(TValue ch);
bool kchar_lower_casep(TValue ch);
/* 14.1.4? char->integer, integer->char */
-void kchar_to_integer(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
-void kinteger_to_char(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void kchar_to_integer(klisp_State *K);
+void kinteger_to_char(klisp_State *K);
/* 14.1.4? char-upcase, char-downcase */
-void kchar_upcase(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
-void kchar_downcase(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void kchar_upcase(klisp_State *K);
+void kchar_downcase(klisp_State *K);
/* 14.2.1? char=? */
/* uses ftyped_bpredp */
diff --git a/src/kgcombiners.c b/src/kgcombiners.c
@@ -27,7 +27,7 @@
#include "kgcombiners.h"
/* Helper (used by $vau & $lambda) */
-void do_vau(klisp_State *K, TValue *xparams, TValue obj, TValue denv);
+void do_vau(klisp_State *K);
/* 4.10.1 operative? */
/* uses typep */
@@ -37,8 +37,12 @@ void do_vau(klisp_State *K, TValue *xparams, TValue obj, TValue denv);
/* 4.10.3 $vau */
/* 5.3.1 $vau */
-void Svau(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Svau(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) xparams;
bind_al2p(K, ptree, vptree, vpenv, vbody);
@@ -71,15 +75,22 @@ void Svau(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kapply_cc(K, new_op);
}
-void do_vau(klisp_State *K, TValue *xparams, TValue obj, TValue denv)
+void do_vau(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+
+ UNUSED(denv);
+
/*
- ** xparams[0]: ptree
+ ** xparams[0]: op_ptree
** xparams[1]: penv
** xparams[2]: body
** xparams[3]: senv
*/
- TValue ptree = xparams[0];
+ TValue op_ptree = xparams[0];
TValue penv = xparams[1];
TValue body = xparams[2];
TValue senv = xparams[3];
@@ -91,7 +102,7 @@ void do_vau(klisp_State *K, TValue *xparams, TValue obj, TValue denv)
krooted_tvs_push(K, env);
/* TODO use name from operative */
- match(K, "[user-operative]", env, ptree, obj);
+ match(K, "[user-operative]", env, op_ptree, ptree);
if (!ttisignore(penv))
kadd_binding(K, env, penv, denv);
@@ -120,8 +131,12 @@ void do_vau(klisp_State *K, TValue *xparams, TValue obj, TValue denv)
}
/* 4.10.4 wrap */
-void wrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void wrap(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -141,8 +156,12 @@ void wrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 4.10.5 unwrap */
-void unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void unwrap(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) denv;
(void) xparams;
bind_1tp(K, ptree, "applicative", ttisapplicative, app);
@@ -153,8 +172,12 @@ void unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 5.3.1 $vau */
/* DONE: above, together with 4.10.4 */
/* 5.3.2 $lambda */
-void Slambda(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Slambda(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) xparams;
bind_al1p(K, ptree, vptree, vbody);
@@ -188,9 +211,12 @@ void Slambda(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 5.5.1 apply */
-void apply(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void apply(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -474,6 +500,7 @@ void do_map(klisp_State *K)
TValue last_pair = xparams[2];
int32_t n = ivalue(xparams[3]);
TValue denv = xparams[4];
+ /* XXX */ klisp_assert(ttisenvironment(denv));
bool dummyp = bvalue(xparams[5]);
/* this case is used to kick start the mapping of both
@@ -498,6 +525,7 @@ void do_map(klisp_State *K)
/* have to unwrap the applicative to avoid extra evaluation of first */
TValue new_expr = kcons(K, kunwrap(app), first_ptree);
krooted_tvs_push(K, new_expr);
+ /* XXX */ klisp_assert(ttisenvironment(denv));
TValue new_cont =
kmake_continuation(K, kget_cc(K), do_map, 6, app,
ls, last_pair, i2tv(n), denv, KFALSE);
@@ -524,6 +552,7 @@ void do_map_cycle(klisp_State *K)
TValue dummy = xparams[1];
int32_t cpairs = ivalue(xparams[2]);
TValue denv = xparams[3];
+ /* XXX */ klisp_assert(ttisenvironment(denv));
/* obj: (cycle-part . last-result-pair) */
TValue ls = kcar(obj);
@@ -538,6 +567,7 @@ void do_map_cycle(klisp_State *K)
/* schedule the mapping of the elements of the cycle,
signal dummyp = true to avoid creating a pair for
the inert value passed to the first continuation */
+ /* XXX */ klisp_assert(ttisenvironment(denv));
TValue new_cont =
kmake_continuation(K, encycle_cont, do_map, 6, app, ls,
last_apair, cpairs, denv, KTRUE);
@@ -548,8 +578,12 @@ void do_map_cycle(klisp_State *K)
}
/* 5.9.1 map */
-void map(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void map(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
bind_al1tp(K, ptree, "applicative", ttisapplicative, app, lss);
@@ -595,6 +629,7 @@ void map(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* schedule the mapping of the elements of the acyclic part.
signal dummyp = true to avoid creating a pair for
the inert value passed to the first continuation */
+ /* XXX */ klisp_assert(ttisenvironment(denv));
TValue new_cont =
kmake_continuation(K, ret_cont, do_map, 6, app, lss, dummy,
i2tv(res_apairs), denv, KTRUE);
diff --git a/src/kgcombiners.h b/src/kgcombiners.h
@@ -26,23 +26,22 @@
/* 4.10.3 $vau */
/* 5.3.1 $vau */
-void Svau(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Svau(klisp_State *K);
/* 4.10.4 wrap */
-void wrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void wrap(klisp_State *K);
/* 4.10.5 unwrap */
-void unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void unwrap(klisp_State *K);
/* 5.3.1 $vau */
/* DONE: above, together with 4.10.4 */
/* 5.3.2 $lambda */
-void Slambda(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Slambda(klisp_State *K);
/* 5.5.1 apply */
-void apply(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void apply(klisp_State *K);
/* Helpers for map (also used by for each) */
@@ -69,7 +68,7 @@ TValue map_for_each_transpose(klisp_State *K, TValue lss,
int32_t res_apairs, int32_t res_cpairs);
/* 5.9.1 map */
-void map(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void map(klisp_State *K);
/* 6.2.1 combiner? */
/* uses ftypedp */
@@ -78,7 +77,7 @@ void map(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
bool kcombinerp(TValue obj);
-void do_vau(klisp_State *K, TValue *xparams, TValue obj, TValue denv);
+void do_vau(klisp_State *K);
void do_map_ret(klisp_State *K);
void do_map_encycle(klisp_State *K);
void do_map(klisp_State *K);
diff --git a/src/kgcontinuations.c b/src/kgcontinuations.c
@@ -28,8 +28,12 @@
/* uses typep */
/* 7.2.2 call/cc */
-void call_cc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void call_cc(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
bind_1tp(K, ptree, "combiner", ttiscombiner, comb);
@@ -56,9 +60,12 @@ void do_extended_cont(klisp_State *K)
}
/* 7.2.3 extend-continuation */
-void extend_continuation(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void extend_continuation(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -164,9 +171,12 @@ TValue check_copy_guards(klisp_State *K, char *name, TValue obj)
}
/* 7.2.4 guard-continuation */
-void guard_continuation(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void guard_continuation(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
bind_3tp(K, ptree, "any", anytype, entry_guards,
@@ -200,10 +210,16 @@ void guard_continuation(klisp_State *K, TValue *xparams, TValue ptree,
/* 7.2.5 continuation->applicative */
-void continuation_applicative(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void continuation_applicative(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+
UNUSED(xparams);
+ UNUSED(denv);
+
bind_1tp(K, ptree, "continuation",
ttiscontinuation, cont);
/* cont_app is from kstate, it handles dynamic vars &
@@ -223,9 +239,12 @@ void continuation_applicative(klisp_State *K, TValue *xparams, TValue ptree,
*/
/* 7.3.1 apply-continuation */
-void apply_continuation(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void apply_continuation(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -238,9 +257,12 @@ void apply_continuation(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 7.3.2 $let/cc */
-void Slet_cc(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void Slet_cc(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
/* from the report: #ignore is not ok, only symbol */
bind_al1tp(K, ptree, "symbol", ttissymbol, sym, objs);
@@ -278,9 +300,12 @@ void Slet_cc(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 7.3.3 guard-dynamic-extent */
-void guard_dynamic_extent(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void guard_dynamic_extent(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
bind_3tp(K, ptree, "any", anytype, entry_guards,
@@ -316,9 +341,12 @@ void guard_dynamic_extent(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 7.3.4 exit */
-void kgexit(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kgexit(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
diff --git a/src/kgcontinuations.h b/src/kgcontinuations.h
@@ -25,19 +25,16 @@ void do_pass_value(klisp_State *K);
/* uses typep */
/* 7.2.2 call/cc */
-void call_cc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void call_cc(klisp_State *K);
/* 7.2.3 extend-continuation */
-void extend_continuation(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void extend_continuation(klisp_State *K);
/* 7.2.4 guard-continuation */
-void guard_continuation(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void guard_continuation(klisp_State *K);
/* 7.2.5 continuation->applicative */
-void continuation_applicative(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void continuation_applicative(klisp_State *K);
/* 7.2.6 root-continuation */
/* done in kground.c/krepl.c */
@@ -46,20 +43,16 @@ void continuation_applicative(klisp_State *K, TValue *xparams, TValue ptree,
/* done in kground.c/krepl.c */
/* 7.3.1 apply-continuation */
-void apply_continuation(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void apply_continuation(klisp_State *K);
/* 7.3.2 $let/cc */
-void Slet_cc(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void Slet_cc(klisp_State *K);
/* 7.3.3 guard-dynamic-extent */
-void guard_dynamic_extent(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void guard_dynamic_extent(klisp_State *K);
/* 7.3.4 exit */
-void kgexit(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void kgexit(klisp_State *K);
void do_extended_cont(klisp_State *K);
diff --git a/src/kgcontrol.c b/src/kgcontrol.c
@@ -29,8 +29,12 @@
void do_select_clause(klisp_State *K);
/* ASK JOHN: both clauses should probably be copied (copy-es-immutable) */
-void Sif(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Sif(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) denv;
(void) xparams;
@@ -69,8 +73,12 @@ void do_select_clause(klisp_State *K)
}
/* 5.1.1 $sequence */
-void Ssequence(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Ssequence(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
if (ttisnil(ptree)) {
@@ -270,8 +278,12 @@ void do_cond(klisp_State *K)
}
/* 5.6.1 $cond */
-void Scond(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Scond(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) xparams;
TValue bodies;
@@ -344,8 +356,12 @@ void do_for_each(klisp_State *K)
}
/* 6.9.1 for-each */
-void for_each(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void for_each(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) xparams;
bind_al1tp(K, ptree, "applicative", ttisapplicative, app, lss);
diff --git a/src/kgcontrol.h b/src/kgcontrol.h
@@ -23,10 +23,10 @@
/* 4.5.2 $if */
-void Sif(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Sif(klisp_State *K);
/* 5.1.1 $sequence */
-void Ssequence(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Ssequence(klisp_State *K);
/* Helpers for $cond */
TValue split_check_cond_clauses(klisp_State *K, TValue clauses,
@@ -34,10 +34,10 @@ TValue split_check_cond_clauses(klisp_State *K, TValue clauses,
/* 5.6.1 $cond */
-void Scond(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Scond(klisp_State *K);
/* 6.9.1 for-each */
-void for_each(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void for_each(klisp_State *K);
void do_seq(klisp_State *K);
void do_cond(klisp_State *K);
diff --git a/src/kgencapsulations.c b/src/kgencapsulations.c
@@ -23,8 +23,12 @@
/* Helpers for make-encapsulation-type */
/* Type predicate for encapsulations */
-void enc_typep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void enc_typep(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
/*
** xparams[0]: encapsulation key
@@ -54,8 +58,12 @@ void enc_typep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Constructor for encapsulations */
-void enc_wrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void enc_wrap(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
bind_1p(K, ptree, obj);
UNUSED(denv);
/*
@@ -67,8 +75,12 @@ void enc_wrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Accessor for encapsulations */
-void enc_unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void enc_unwrap(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
bind_1p(K, ptree, enc);
UNUSED(denv);
/*
@@ -86,9 +98,12 @@ void enc_unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 8.1.1 make-encapsulation-type */
-void make_encapsulation_type(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void make_encapsulation_type(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
check_0p(K, ptree);
UNUSED(denv);
UNUSED(xparams);
diff --git a/src/kgencapsulations.h b/src/kgencapsulations.h
@@ -19,11 +19,10 @@
#include "kghelpers.h"
/* needed by kgffi.c */
-void enc_typep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void enc_typep(klisp_State *K);
/* 8.1.1 make-encapsulation-type */
-void make_encapsulation_type(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void make_encapsulation_type(klisp_State *K);
/* init ground */
void kinit_encapsulations_ground_env(klisp_State *K);
diff --git a/src/kgenv_mut.c b/src/kgenv_mut.c
@@ -23,8 +23,12 @@
#include "kgcontrol.h" /* for do_seq */
/* 4.9.1 $define! */
-void SdefineB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void SdefineB(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0] = define symbol
*/
@@ -64,8 +68,12 @@ void do_match(klisp_State *K)
}
/* 6.8.1 $set! */
-void SsetB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void SsetB(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
TValue sname = xparams[0];
@@ -204,8 +212,12 @@ void do_import(klisp_State *K)
}
/* 6.8.2 $provide! */
-void SprovideB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void SprovideB(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: name as symbol
*/
@@ -260,8 +272,12 @@ void SprovideB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 6.8.3 $import! */
-void SimportB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void SimportB(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/* ASK John: The report says that symbols can have repeated symbols
and even be cyclical (cf $provide!) however this doesn't work
in the derivation (that uses $set! and so needs a ptree, which are
diff --git a/src/kgenv_mut.h b/src/kgenv_mut.h
@@ -26,7 +26,7 @@ inline void ptree_clear_all(klisp_State *K, TValue sym_ls);
inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree,
TValue penv);
/* 4.9.1 $define! */
-void SdefineB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void SdefineB(klisp_State *K);
/* MAYBE: don't make these inline */
/*
@@ -235,7 +235,7 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree,
}
/* 6.8.1 $set! */
-void SsetB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void SsetB(klisp_State *K);
/* Helper for $set! */
void do_set_eval_obj(klisp_State *K);
@@ -245,10 +245,10 @@ TValue check_copy_symbol_list(klisp_State *K, char *name, TValue obj);
void do_import(klisp_State *K);
/* 6.8.2 $provide! */
-void SprovideB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void SprovideB(klisp_State *K);
/* 6.8.3 $import! */
-void SimportB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void SimportB(klisp_State *K);
/* init ground */
void kinit_env_mut_ground_env(klisp_State *K);
diff --git a/src/kgenvironments.c b/src/kgenvironments.c
@@ -32,9 +32,12 @@
/* uses typep */
/* 4.8.3 eval */
-void eval(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void eval(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -45,9 +48,12 @@ void eval(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 4.8.4 make-environment */
-void make_environment(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void make_environment(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -215,8 +221,12 @@ void do_let(klisp_State *K)
/* 5.10.1 $let */
/* REFACTOR: reuse code in other members of the $let family */
-void Slet(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Slet(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: symbol name
*/
@@ -284,8 +294,12 @@ void do_bindsp(klisp_State *K)
}
/* 6.7.1 $binds? */
-void Sbindsp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Sbindsp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
bind_al1p(K, ptree, env_expr, symbols);
@@ -303,18 +317,24 @@ void Sbindsp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 6.7.2 get-current-environment */
-void get_current_environment(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void get_current_environment(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
check_0p(K, ptree);
kapply_cc(K, denv);
}
/* 6.7.3 make-kernel-standard-environment */
-void make_kernel_standard_environment(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void make_kernel_standard_environment(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
check_0p(K, ptree);
@@ -326,8 +346,12 @@ void make_kernel_standard_environment(klisp_State *K, TValue *xparams,
}
/* 6.7.4 $let* */
-void SletS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void SletS(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: symbol name
*/
@@ -375,8 +399,12 @@ void SletS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 6.7.5 $letrec */
-void Sletrec(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Sletrec(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: symbol name
*/
@@ -412,8 +440,12 @@ void Sletrec(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 6.7.6 $letrec* */
-void SletrecS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void SletrecS(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: symbol name
*/
@@ -496,8 +528,12 @@ void do_let_redirect(klisp_State *K)
}
/* 6.7.7 $let-redirect */
-void Slet_redirect(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Slet_redirect(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: symbol name
*/
@@ -531,8 +567,12 @@ void Slet_redirect(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 6.7.8 $let-safe */
-void Slet_safe(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Slet_safe(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: symbol name
*/
@@ -570,8 +610,12 @@ void Slet_safe(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 6.7.9 $remote-eval */
-void Sremote_eval(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Sremote_eval(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -618,9 +662,12 @@ void do_b_to_env(klisp_State *K)
}
/* 6.7.10 $bindings->environment */
-void Sbindings_to_environment(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void Sbindings_to_environment(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
TValue exprs;
TValue bptree = split_check_let_bindings(K, "$bindings->environment",
diff --git a/src/kgenvironments.h b/src/kgenvironments.h
@@ -25,53 +25,49 @@
/* uses typep */
/* 4.8.3 eval */
-void eval(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void eval(klisp_State *K);
/* 4.8.4 make-environment */
-void make_environment(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void make_environment(klisp_State *K);
/* Helpers for all $let family */
TValue split_check_let_bindings(klisp_State *K, char *name, TValue bindings,
TValue *exprs, bool starp);
/* 5.10.1 $let */
-void Slet(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Slet(klisp_State *K);
/* Helper for $binds? */
void do_bindsp(klisp_State *K);
/* 6.7.1 $binds? */
-void Sbindsp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Sbindsp(klisp_State *K);
/* 6.7.2 get-current-environment */
-void get_current_environment(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void get_current_environment(klisp_State *K);
/* 6.7.3 make-kernel-standard-environment */
-void make_kernel_standard_environment(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv);
+void make_kernel_standard_environment(klisp_State *K);
/* 6.7.4 $let* */
-void SletS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void SletS(klisp_State *K);
/* 6.7.5 $letrec */
-void Sletrec(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Sletrec(klisp_State *K);
/* 6.7.6 $letrec* */
-void SletrecS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void SletrecS(klisp_State *K);
/* Helper for $let-redirect */
void do_let_redirect(klisp_State *K);
/* 6.7.7 $let-redirect */
-void Slet_redirect(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Slet_redirect(klisp_State *K);
/* 6.7.8 $let-safe */
-void Slet_safe(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Slet_safe(klisp_State *K);
/* 6.7.9 $remote-eval */
-void Sremote_eval(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Sremote_eval(klisp_State *K);
/* Helper for $remote-eval */
void do_remote_eval(klisp_State *K);
@@ -80,8 +76,7 @@ void do_remote_eval(klisp_State *K);
void do_b_to_env(klisp_State *K);
/* 6.7.10 $bindings->environment */
-void Sbindings_to_environment(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void Sbindings_to_environment(klisp_State *K);
void do_let(klisp_State *K);
diff --git a/src/kgeqp.c b/src/kgeqp.c
@@ -22,8 +22,12 @@
/* 4.2.1 eq? */
/* 6.5.1 eq? */
/* NOTE: this does 2 passes but could do it in one */
-void eqp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void eqp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
diff --git a/src/kgeqp.h b/src/kgeqp.h
@@ -23,7 +23,7 @@
/* 4.2.1 eq? */
/* 6.5.1 eq? */
-void eqp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void eqp(klisp_State *K);
/* Helper (also used in equal?) */
inline bool eq2p(klisp_State *K, TValue obj1, TValue obj2)
diff --git a/src/kgequalp.c b/src/kgequalp.c
@@ -34,8 +34,12 @@
** Idea to look up these papers from srfi 85:
** "Recursive Equivalence Predicates" by William D. Clinger
*/
-void equalp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void equalp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
diff --git a/src/kgequalp.h b/src/kgequalp.h
@@ -20,7 +20,7 @@
/* 4.3.1 equal? */
/* 6.6.1 equal? */
-void equalp(klisp_State *K, TValue *xparas, TValue ptree, TValue denv);
+void equalp(klisp_State *K);
/* Helper (may be used in assoc and member) */
/* compare two objects and check to see if they are "equal?". */
diff --git a/src/kgerror.c b/src/kgerror.c
@@ -16,9 +16,12 @@
#include "kghelpers.h"
#include "kgerror.h"
-void r7rs_error(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void r7rs_error(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
if (ttispair(ptree) && ttisstring(kcar(ptree))) {
@@ -28,9 +31,12 @@ void r7rs_error(klisp_State *K, TValue *xparams, TValue ptree,
}
}
-void error_object_message(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void error_object_message(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "error object", ttiserror, error_tv);
@@ -39,9 +45,12 @@ void error_object_message(klisp_State *K, TValue *xparams, TValue ptree,
kapply_cc(K, err_obj->msg);
}
-void error_object_irritants(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void error_object_irritants(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "error object", ttiserror, error_tv);
diff --git a/src/kgffi.c b/src/kgffi.c
@@ -394,9 +394,12 @@ static TValue ffi_win32_error_message(klisp_State *K, DWORD dwMessageId)
}
#endif
-void ffi_load_library(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void ffi_load_library(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
/*
** xparams[0]: encapsulation key denoting loaded library
@@ -478,9 +481,12 @@ inline size_t align(size_t offset, size_t alignment)
return offset + (alignment - offset % alignment) % alignment;
}
-void ffi_make_call_interface(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void ffi_make_call_interface(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
/*
** xparams[0]: encapsulation key denoting call interface
@@ -552,8 +558,12 @@ void ffi_make_call_interface(klisp_State *K, TValue *xparams,
kapply_cc(K, enc);
}
-void do_ffi_call(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void do_ffi_call(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
/*
** xparams[0]: function pointer
@@ -596,9 +606,12 @@ void do_ffi_call(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kapply_cc(K, result);
}
-void ffi_make_applicative(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void ffi_make_applicative(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
/*
** xparams[0]: encapsulation key denoting dynamically loaded library
@@ -687,7 +700,7 @@ static TValue ffi_callback_pop(ffi_callback_t *cb)
return v;
}
-static TValue ffi_callback_guard(ffi_callback_t *cb, klisp_Ofunc fn)
+static TValue ffi_callback_guard(ffi_callback_t *cb, klisp_CFunction fn)
{
TValue app = kmake_applicative(cb->K, fn, 1, p2tv(cb));
krooted_tvs_push(cb->K, app);
@@ -714,9 +727,12 @@ void do_ffi_callback_encode_result(klisp_State *K)
kapply_cc(K, KINERT);
}
-void do_ffi_callback_decode_arguments(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void do_ffi_callback_decode_arguments(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: p2tv(ffi_callback_t)
** xparams[1]: p2tv(libffi return buffer)
@@ -783,11 +799,15 @@ void do_ffi_callback_return(klisp_State *K)
K->next_func = NULL;
}
-void do_ffi_callback_entry_guard(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void do_ffi_callback_entry_guard(klisp_State *K)
{
- UNUSED(denv);
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
+ UNUSED(ptree);
+ UNUSED(denv);
/* The entry guard is invoked only if the user captured
* the continuation under foreign callback and applied
* it later after the foreign callback terminated.
@@ -799,9 +819,13 @@ void do_ffi_callback_entry_guard(klisp_State *K, TValue *xparams,
klispE_throw_simple(K, "tried to re-enter continuation under FFI callback");
}
-void do_ffi_callback_exit_guard(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void do_ffi_callback_exit_guard(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(ptree);
UNUSED(denv);
/*
** xparams[0]: p2tv(ffi_callback_t)
@@ -850,7 +874,10 @@ static void ffi_callback_entry(ffi_cif *cif, void *ret, void **args, void *user_
krooted_tvs_pop(K);
krooted_tvs_pop(K);
- guard_dynamic_extent(K, NULL, ptree, K->next_env);
+ K->next_xparams = NULL;
+ K->next_value = ptree;
+ /* K->next_env already has the correct value */
+ guard_dynamic_extent(K);
/* Enter new "inner" trampoline loop. */
@@ -883,9 +910,12 @@ static void ffi_callback_entry(ffi_cif *cif, void *ret, void **args, void *user_
}
-void ffi_make_callback(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void ffi_make_callback(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
/*
** xparams[0]: encapsulation key denoting call interface
@@ -1001,9 +1031,12 @@ static uint8_t * ffi_memory_location(klisp_State *K, bool allow_nesting,
}
}
-void ffi_memmove(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void ffi_memmove(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -1023,10 +1056,14 @@ void ffi_memmove(klisp_State *K, TValue *xparams,
kapply_cc(K, KINERT);
}
-static void ffi_type_ref(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+static void ffi_type_ref(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
+
/*
** xparams[0]: pointer to ffi_codec_t
*/
@@ -1043,10 +1080,14 @@ static void ffi_type_ref(klisp_State *K, TValue *xparams,
kapply_cc(K, result);
}
-static void ffi_type_set(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+static void ffi_type_set(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
+
/*
** xparams[0]: pointer to ffi_codec_t
*/
@@ -1065,9 +1106,16 @@ static void ffi_type_set(klisp_State *K, TValue *xparams,
kapply_cc(K, KINERT);
}
-void ffi_type_suite(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void ffi_type_suite(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+
+ UNUSED(xparams);
+ UNUSED(denv);
+
bind_1tp(K, ptree, "string", ttisstring, type_tv);
ffi_codec_t *codec = tv2ffi_codec(K, type_tv);
@@ -1099,9 +1147,12 @@ void ffi_type_suite(klisp_State *K, TValue *xparams,
kapply_cc(K, suite_tv);
}
-void ffi_klisp_state(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void ffi_klisp_state(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
check_0p(K, ptree);
diff --git a/src/kgffi.h b/src/kgffi.h
@@ -21,8 +21,7 @@
#include "kstate.h"
#include "kghelpers.h"
-void ffi_load_library(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv);
+void ffi_load_library(klisp_State *K);
/* init ground */
void kinit_ffi_ground_env(klisp_State *K);
diff --git a/src/kghelpers.c b/src/kghelpers.c
@@ -17,8 +17,12 @@
#include "kerror.h"
#include "ksymbol.h"
-void typep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void typep(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: name symbol
** xparams[1]: type tag (as by i2tv)
@@ -47,8 +51,12 @@ void typep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
}
-void ftypep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void ftypep(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) denv;
/*
** xparams[0]: name symbol
@@ -80,8 +88,12 @@ void ftypep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/*
** REFACTOR: Change this to make it a single pass
*/
-void ftyped_predp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void ftyped_predp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) denv;
/*
** xparams[0]: name symbol
@@ -120,8 +132,12 @@ void ftyped_predp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/*
** REFACTOR: Change this to make it a single pass
*/
-void ftyped_bpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void ftyped_bpredp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) denv;
/*
** xparams[0]: name symbol
@@ -176,8 +192,12 @@ void ftyped_bpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* This is the same, but the comparison predicate takes a klisp_State */
/* TODO unify them */
-void ftyped_kbpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void ftyped_kbpredp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) denv;
/*
** xparams[0]: name symbol
diff --git a/src/kghelpers.h b/src/kghelpers.h
@@ -363,13 +363,13 @@ inline TValue check_copy_env_list(klisp_State *K, char *name, TValue obj)
** Generic function for type predicates
** It can only be used by types that have a unique tag
*/
-void typep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void typep(klisp_State *K);
/*
** Generic function for type predicates
** It takes an arbitrary function pointer of type bool (*fn)(TValue o)
*/
-void ftypep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void ftypep(klisp_State *K);
/*
** Generic function for typed predicates (like char-alphabetic? or finite?)
@@ -378,7 +378,7 @@ void ftypep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
** both of the same type: bool (*fn)(TValue o).
** On zero operands this return true
*/
-void ftyped_predp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void ftyped_predp(klisp_State *K);
/*
** Generic function for typed binary predicates (like =? & char<?)
@@ -388,11 +388,11 @@ void ftyped_predp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
** This assumes the predicate is transitive and works even in cyclic lists
** On zero and one operand this return true
*/
-void ftyped_bpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void ftyped_bpredp(klisp_State *K);
/* This is the same, but the comparison predicate takes a klisp_State */
/* TODO unify them */
-void ftyped_kbpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void ftyped_kbpredp(klisp_State *K);
/*
diff --git a/src/kgkd_vars.c b/src/kgkd_vars.c
@@ -32,9 +32,12 @@
/* Helpers for make-keyed-dynamic-variable */
/* accesor returned */
-void do_access(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void do_access(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: dynamic key
*/
@@ -73,9 +76,12 @@ void do_unbind(klisp_State *K)
}
/* operative for setting the key to the new/old flag/value */
-void do_set_pass(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void do_set_pass(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: dynamic key
** xparams[1]: flag
@@ -152,9 +158,12 @@ inline TValue make_bind_continuation(klisp_State *K, TValue key,
}
/* binder returned */
-void do_bind(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void do_bind(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: dynamic key
*/
@@ -189,9 +198,12 @@ void do_bind(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 10.1.1 make-keyed-dynamic-variable */
-void make_keyed_dynamic_variable(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void make_keyed_dynamic_variable(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
diff --git a/src/kgkd_vars.h b/src/kgkd_vars.h
@@ -19,14 +19,11 @@
#include "kghelpers.h"
/* This is also used by kgports.c */
-void do_bind(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
-void do_access(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void do_bind(klisp_State *K);
+void do_access(klisp_State *K);
/* 10.1.1 make-keyed-dynamic-variable */
-void make_keyed_dynamic_variable(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv);
+void make_keyed_dynamic_variable(klisp_State *K);
void do_unbind(klisp_State *K);
diff --git a/src/kgks_vars.c b/src/kgks_vars.c
@@ -25,9 +25,12 @@
/* Helpers for make-static-dynamic-variable */
/* accesor returned */
-void do_sv_access(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void do_sv_access(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: static key
*/
@@ -40,9 +43,12 @@ void do_sv_access(klisp_State *K, TValue *xparams, TValue ptree,
}
/* binder returned */
-void do_sv_bind(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void do_sv_bind(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: static key
*/
@@ -56,9 +62,12 @@ void do_sv_bind(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 11.1.1 make-static-dynamic-variable */
-void make_keyed_static_variable(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void make_keyed_static_variable(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
diff --git a/src/kgks_vars.h b/src/kgks_vars.h
@@ -19,8 +19,7 @@
#include "kghelpers.h"
/* 11.1.1 make-static-dynamic-variable */
-void make_keyed_static_variable(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv);
+void make_keyed_static_variable(klisp_State *K);
/* init ground */
void kinit_kgks_vars_ground_env(klisp_State *K);
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -898,8 +898,12 @@ TValue knum_rationalize(klisp_State *K, TValue n1, TValue n2)
}
/* 12.5.4 + */
-void kplus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void kplus(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
/* cycles are allowed, loop counting pairs */
@@ -965,8 +969,12 @@ void kplus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 12.5.5 * */
-void ktimes(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void ktimes(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
/* cycles are allowed, loop counting pairs */
@@ -1043,8 +1051,12 @@ void ktimes(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 12.5.6 - */
-void kminus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void kminus(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
/* cycles are allowed, loop counting pairs */
@@ -1195,8 +1207,12 @@ int32_t kfixint_div0_mod0(int32_t n, int32_t d, int32_t *res_mod)
}
/* flags are FDIV_DIV, FDIV_MOD, FDIV_ZERO */
-void kdiv_mod(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void kdiv_mod(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: name symbol
** xparams[1]: div_mod_flags
@@ -1436,8 +1452,12 @@ bool kevenp(TValue n)
}
/* 12.5.12 abs */
-void kabs(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void kabs(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -1450,8 +1470,12 @@ void kabs(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 12.5.13 min, max */
/* NOTE: this does two passes, one for error checking and one for doing
the actual work */
-void kmin_max(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void kmin_max(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: symbol name
** xparams[1]: bool: true min, false max
@@ -1488,8 +1512,12 @@ void kmin_max(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 12.5.14 gcm, lcm */
-void kgcd(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void kgcd(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
/* cycles are allowed, loop counting pairs */
@@ -1522,8 +1550,12 @@ void kgcd(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
arith_kapply_cc(K, res);
}
-void klcm(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void klcm(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
/* cycles are allowed, loop counting pairs */
@@ -1551,9 +1583,16 @@ void klcm(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* use fyped_predp */
/* 12.6.2 get-real-internal-bounds, get-real-exact-bounds */
-void kget_real_internal_bounds(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kget_real_internal_bounds(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+
+ UNUSED(denv);
+ UNUSED(xparams);
+
bind_1tp(K, ptree, "real", krealp, tv_n);
/* TEMP: do it here directly, for now all inexact objects have
[-inf, +inf] bounds */
@@ -1566,9 +1605,15 @@ void kget_real_internal_bounds(klisp_State *K, TValue *xparams, TValue ptree,
kapply_cc(K, res);
}
-void kget_real_exact_bounds(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kget_real_exact_bounds(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(denv);
+ UNUSED(xparams);
+
bind_1tp(K, ptree, "real", krealp, tv_n);
/* TEMP: do it here directly, for now all inexact objects have
[-inf, +inf] bounds, when bounded reals are implemented this
@@ -1584,9 +1629,15 @@ void kget_real_exact_bounds(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 12.6.3 get-real-internal-primary, get-real-exact-primary */
-void kget_real_internal_primary(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void kget_real_internal_primary(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(denv);
+ UNUSED(xparams);
+
bind_1tp(K, ptree, "real", krealp, tv_n);
/* TEMP: do it here directly */
if (ttisrwnpv(tv_n)) {
@@ -1597,9 +1648,15 @@ void kget_real_internal_primary(klisp_State *K, TValue *xparams,
}
}
-void kget_real_exact_primary(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void kget_real_exact_primary(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ UNUSED(denv);
+ UNUSED(xparams);
+
+ klisp_assert(ttisenvironment(K->next_env));
bind_1tp(K, ptree, "real", krealp, tv_n);
/* NOTE: this handles no primary value errors & exact cases just fine */
@@ -1608,8 +1665,15 @@ void kget_real_exact_primary(klisp_State *K, TValue *xparams,
}
/* 12.6.4 make-inexact */
-void kmake_inexact(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void kmake_inexact(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(denv);
+ UNUSED(xparams);
+
bind_3tp(K, ptree, "real", krealp, real1,
"real", krealp, real2, "real", krealp, real3);
@@ -1627,9 +1691,12 @@ void kmake_inexact(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 12.6.5 real->inexact, real->exact */
-void kreal_to_inexact(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kreal_to_inexact(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -1640,9 +1707,12 @@ void kreal_to_inexact(klisp_State *K, TValue *xparams, TValue ptree,
kapply_cc(K, res);
}
-void kreal_to_exact(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kreal_to_exact(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -1653,9 +1723,14 @@ void kreal_to_exact(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 12.6.6 with-strict-arithmetic, get-strict-arithmetic? */
-void kwith_strict_arithmetic(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kwith_strict_arithmetic(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(xparams);
+
bind_2tp(K, ptree, "bool", ttisboolean, strictp,
"combiner", ttiscombiner, comb);
@@ -1671,9 +1746,12 @@ void kwith_strict_arithmetic(klisp_State *K, TValue *xparams, TValue ptree,
ktail_call(K, op, args, denv);
}
-void kget_strict_arithmeticp(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kget_strict_arithmeticp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -1688,8 +1766,12 @@ void kget_strict_arithmeticp(klisp_State *K, TValue *xparams, TValue ptree,
/* uses ftypep */
/* 12.8.2 / */
-void kdivided(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void kdivided(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
/* cycles are allowed, loop counting pairs */
@@ -1783,8 +1865,12 @@ void kdivided(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 12.8.3 numerator, denominator */
-void knumerator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void knumerator(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -1794,8 +1880,12 @@ void knumerator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kapply_cc(K, res);
}
-void kdenominator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void kdenominator(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -1806,9 +1896,12 @@ void kdenominator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 12.8.4 floor, ceiling, truncate, round */
-void kreal_to_integer(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void kreal_to_integer(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: symbol name
** xparams[1]: bool: true min, false max
@@ -1823,9 +1916,12 @@ void kreal_to_integer(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 12.8.5 rationalize, simplest-rational */
-void krationalize(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void krationalize(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -1836,9 +1932,12 @@ void krationalize(klisp_State *K, TValue *xparams, TValue ptree,
kapply_cc(K, res);
}
-void ksimplest_rational(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void ksimplest_rational(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -1849,8 +1948,12 @@ void ksimplest_rational(klisp_State *K, TValue *xparams, TValue ptree,
kapply_cc(K, res);
}
-void kexp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void kexp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -1886,8 +1989,12 @@ void kexp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kapply_cc(K, res);
}
-void klog(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void klog(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -1933,8 +2040,12 @@ void klog(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kapply_cc(K, res);
}
-void ktrig(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void ktrig(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
/*
** xparams[0]: trig function
@@ -1973,8 +2084,12 @@ void ktrig(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
arith_kapply_cc(K, res);
}
-void katrig(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void katrig(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
/*
** xparams[0]: trig function
@@ -2018,8 +2133,12 @@ void katrig(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
arith_kapply_cc(K, res);
}
-void katan(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void katan(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -2105,8 +2224,12 @@ void katan(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
arith_kapply_cc(K, res);
}
-void ksqrt(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void ksqrt(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
@@ -2146,8 +2269,12 @@ void ksqrt(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
arith_kapply_cc(K, res);
}
-void kexpt(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void kexpt(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -56,15 +56,15 @@ bool knum_gep(klisp_State *K, TValue n1, TValue n2);
/* 12.5.4 + */
/* TEMP: for now only accept two arguments */
-void kplus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void kplus(klisp_State *K);
/* 12.5.5 * */
/* TEMP: for now only accept two arguments */
-void ktimes(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void ktimes(klisp_State *K);
/* 12.5.6 - */
/* TEMP: for now only accept two arguments */
-void kminus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void kminus(klisp_State *K);
/* 12.5.7 zero? */
/* uses ftyped_predp */
@@ -101,11 +101,11 @@ bool kevenp(TValue n);
#define FDIV_MOD 2
#define FDIV_ZERO 4
-void kdiv_mod(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void kdiv_mod(klisp_State *K);
/* 12.5.12 abs */
-void kabs(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void kabs(klisp_State *K);
/* 12.5.13 min, max */
/* use kmin_max */
@@ -113,84 +113,73 @@ void kabs(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
/* Helper */
#define FMIN (true)
#define FMAX (false)
-void kmin_max(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void kmin_max(klisp_State *K);
/* 12.5.14 gcm, lcm */
-void kgcd(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
-void klcm(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void kgcd(klisp_State *K);
+void klcm(klisp_State *K);
/* 12.6.1 exact?, inexact?, robust?, undefined? */
/* use fyped_predp */
/* 12.6.2 get-real-internal-bounds, get-real-exact-bounds */
-void kget_real_internal_bounds(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
-void kget_real_exact_bounds(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void kget_real_internal_bounds(klisp_State *K);
+void kget_real_exact_bounds(klisp_State *K);
/* 12.6.3 get-real-internal-primary, get-real-exact-primary */
-void kget_real_internal_primary(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv);
-void kget_real_exact_primary(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv);
+void kget_real_internal_primary(klisp_State *K);
+void kget_real_exact_primary(klisp_State *K);
/* 12.6.4 make-inexact */
-void kmake_inexact(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void kmake_inexact(klisp_State *K);
/* 12.6.5 real->inexact, real->exact */
-void kreal_to_inexact(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
-void kreal_to_exact(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void kreal_to_inexact(klisp_State *K);
+void kreal_to_exact(klisp_State *K);
/* 12.6.6 with-strict-arithmetic, get-strict-arithmetic? */
-void kwith_strict_arithmetic(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void kwith_strict_arithmetic(klisp_State *K);
-void kget_strict_arithmeticp(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void kget_strict_arithmeticp(klisp_State *K);
/* 12.8.1 rational? */
/* uses ftypep */
/* 12.8.2 / */
-void kdivided(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void kdivided(klisp_State *K);
/* 12.8.3 numerator, denominator */
-void knumerator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
-void kdenominator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void knumerator(klisp_State *K);
+void kdenominator(klisp_State *K);
/* 12.8.4 floor, ceiling, truncate, round */
-void kreal_to_integer(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void kreal_to_integer(klisp_State *K);
/* 12.8.5 rationalize, simplest-rational */
-void krationalize(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void krationalize(klisp_State *K);
-void ksimplest_rational(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void ksimplest_rational(klisp_State *K);
/* 12.9.1 real? */
/* uses ftypep */
/* 12.9.2 exp, log */
-void kexp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
-void klog(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void kexp(klisp_State *K);
+void klog(klisp_State *K);
/* 12.9.3 sin, cos, tan */
-void ktrig(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void ktrig(klisp_State *K);
/* 12.9.4 asin, acos, atan */
-void katrig(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
-void katan(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void katrig(klisp_State *K);
+void katan(klisp_State *K);
/* 12.9.5 sqrt */
-void ksqrt(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void ksqrt(klisp_State *K);
/* 12.9.6 expt */
-void kexpt(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void kexpt(klisp_State *K);
/* REFACTOR: These should be in a knumber.h header */
diff --git a/src/kgpair_mut.c b/src/kgpair_mut.c
@@ -23,8 +23,12 @@
#include "kgnumbers.h" /* for kpositivep and keintegerp */
/* 4.7.1 set-car!, set-cdr! */
-void set_carB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void set_carB(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) denv;
(void) xparams;
bind_2tp(K, ptree, "pair", ttispair, pair,
@@ -38,8 +42,12 @@ void set_carB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kapply_cc(K, KINERT);
}
-void set_cdrB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void set_cdrB(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
(void) denv;
(void) xparams;
bind_2tp(K, ptree, "pair", ttispair, pair,
@@ -54,9 +62,15 @@ void set_cdrB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Helper for copy-es-immutable & copy-es */
-void copy_es(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void copy_es(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+
+ UNUSED(denv);
+
/*
** xparams[0]: copy-es-immutable symbol
** xparams[1]: boolean (#t: use mutable pairs, #f: use immutable pairs)
@@ -154,9 +168,12 @@ TValue copy_es_immutable_h(klisp_State *K, char *name, TValue obj,
}
/* 5.8.1 encycle! */
-void encycleB(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void encycleB(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/* ASK John: can the object be a cyclic list of length less than k1+k2?
the wording of the report seems to indicate that can't be the case,
and here it makes sense to forbid it because otherwise the list-metrics
@@ -400,9 +417,12 @@ TValue appendB_get_lss_endpoints(klisp_State *K, TValue lss, int32_t apairs,
}
/* 6.4.1 append! */
-void appendB(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void appendB(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
if (ttisnil(ptree)) {
@@ -444,8 +464,12 @@ void appendB(klisp_State *K, TValue *xparams, TValue ptree,
/* 6.4.3 assq */
/* REFACTOR: do just one pass, maybe use generalized accum function */
-void assq(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void assq(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -469,8 +493,12 @@ void assq(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 6.4.3 memq? */
/* REFACTOR: do just one pass, maybe use generalized accum function */
-void memqp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void memqp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
diff --git a/src/kgpair_mut.h b/src/kgpair_mut.h
@@ -23,33 +23,31 @@ TValue copy_es_immutable_h(klisp_State *K, char *name, TValue ptree,
bool mut_flag);
/* 4.7.1 set-car!, set-cdr! */
-void set_carB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void set_carB(klisp_State *K);
-void set_cdrB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void set_cdrB(klisp_State *K);
/* Helper for copy-es & copy-es-immutable */
-void copy_es(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void copy_es(klisp_State *K);
/* 4.7.2 copy-es-immutable */
/* uses copy_es helper */
/* 5.8.1 encycle! */
-void encycleB(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void encycleB(klisp_State *K);
/* 6.4.1 append! */
-void appendB(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void appendB(klisp_State *K);
/* 6.4.2 copy-es */
/* uses copy_es helper */
/* 6.4.3 assq */
-void assq(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void assq(klisp_State *K);
/* 6.4.3 memq? */
-void memqp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void memqp(klisp_State *K);
/* ?.? immutable-pair?, mutable-pair */
/* use ftypep */
diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c
@@ -32,8 +32,12 @@
/* uses typep */
/* 4.6.3 cons */
-void cons(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void cons(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
bind_2p(K, ptree, car, cdr);
@@ -44,8 +48,12 @@ void cons(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 5.2.1 list */
-void list(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void list(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/* the underlying combiner of list return the complete ptree, the only list
checking is implicit in the applicative evaluation */
UNUSED(xparams);
@@ -54,8 +62,12 @@ void list(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 5.2.2 list* */
-void listS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void listS(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/* TODO:
OPTIMIZE: if this call is a result of a call to eval, we could get away
with just setting the kcdr of the next to last pair to the car of
@@ -103,8 +115,14 @@ void listS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 5.4.1 car, cdr */
/* 5.4.2 caar, cadr, ... cddddr */
-void c_ad_r(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void c_ad_r(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+
+ UNUSED(denv);
/*
** xparams[0]: name as symbol
@@ -177,9 +195,12 @@ void get_list_metrics_aux(klisp_State *K, TValue obj, int32_t *p, int32_t *n,
}
/* 5.7.1 get-list-metrics */
-void get_list_metrics(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void get_list_metrics(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -230,9 +251,12 @@ int32_t ksmallest_index(klisp_State *K, char *name, TValue obj,
/* 5.7.2 list-tail */
-void list_tail(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void list_tail(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/* ASK John: can the object be a cyclic list? the wording of the report
seems to indicate that can't be the case, but it makes sense here
(cf $encycle!) to allow cyclic lists, so that's what I do */
@@ -262,8 +286,12 @@ void list_tail(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 6.3.1 length */
-void length(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void length(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -283,8 +311,12 @@ void length(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 6.3.2 list-ref */
-void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void list_ref(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/* ASK John: can the object be an improper list? the wording of the report
seems to indicate that can't be the case, but it makes sense
(cf list-tail) For now we allow it. */
@@ -358,8 +390,12 @@ TValue append_check_copy_list(klisp_State *K, char *name, TValue obj,
}
/* 6.3.3 append */
-void append(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void append(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -420,9 +456,12 @@ void append(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 6.3.4 list-neighbors */
-void list_neighbors(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void list_neighbors(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -611,8 +650,12 @@ void do_filter_cycle(klisp_State *K)
}
/* 6.3.5 filter */
-void filter(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void filter(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_2tp(K, ptree, "applicative", ttisapplicative, app,
@@ -652,8 +695,12 @@ void filter(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 6.3.6 assoc */
-void assoc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void assoc(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -676,8 +723,12 @@ void assoc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 6.3.7 member? */
-void memberp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void memberp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -700,8 +751,12 @@ void memberp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 6.3.8 finite-list? */
/* NOTE: can't use ftypep because the predicate marks pairs too */
-void finite_listp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void finite_listp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
int32_t pairs = check_list(K, "finite-list?", true, ptree, NULL);
@@ -728,9 +783,12 @@ void finite_listp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 6.3.9 countable-list? */
/* NOTE: can't use ftypep because the predicate marks pairs too */
-void countable_listp(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void countable_listp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
int32_t pairs = check_list(K, "countable-list?", true, ptree, NULL);
@@ -947,8 +1005,12 @@ void do_reduce(klisp_State *K)
srfi-1 also defines reduce-left/reduce-right that work as in
kernel. The difference is the use or not of the id value if the list
is not null */
-void reduce(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void reduce(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
bind_al3tp(K, ptree, "any", anytype, ls, "applicative",
diff --git a/src/kgpairs_lists.h b/src/kgpairs_lists.h
@@ -25,17 +25,17 @@
/* uses typep */
/* 4.6.3 cons */
-void cons(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void cons(klisp_State *K);
/* 5.2.1 list */
-void list(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void list(klisp_State *K);
/* 5.2.2 list* */
-void listS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void listS(klisp_State *K);
/* 5.4.1 car, cdr */
/* 5.4.2 caar, cadr, ... cddddr */
-void c_ad_r(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void c_ad_r(klisp_State *K);
/* Helper macros to construct xparams[1] for c[ad]{1,4}r */
#define C_AD_R_PARAM(len_, br_) \
@@ -48,43 +48,40 @@ void c_ad_r(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
(br_ & 0x1000? 0x8 : 0))
/* 5.7.1 get-list-metrics */
-void get_list_metrics(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void get_list_metrics(klisp_State *K);
/* 5.7.2 list-tail */
-void list_tail(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void list_tail(klisp_State *K);
/* 6.3.1 length */
-void length(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void length(klisp_State *K);
/* 6.3.2 list-ref */
-void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void list_ref(klisp_State *K);
/* 6.3.3 append */
-void append(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void append(klisp_State *K);
/* 6.3.4 list-neighbors */
-void list_neighbors(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void list_neighbors(klisp_State *K);
/* 6.3.5 filter */
-void filter(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void filter(klisp_State *K);
/* 6.3.6 assoc */
-void assoc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void assoc(klisp_State *K);
/* 6.3.7 member? */
-void memberp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void memberp(klisp_State *K);
/* 6.3.8 finite-list? */
-void finite_listp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void finite_listp(klisp_State *K);
/* 6.3.9 countable-list? */
-void countable_listp(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void countable_listp(klisp_State *K);
/* 6.3.10 reduce */
-void reduce(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void reduce(klisp_State *K);
void do_ret_cdr(klisp_State *K);
diff --git a/src/kgports.c b/src/kgports.c
@@ -73,9 +73,12 @@ void do_close_file_ret(klisp_State *K)
the dynamic environment can be captured in the construction of the combiner
ASK John
*/
-void with_file(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void with_file(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
bool writep = bvalue(xparams[1]);
TValue key = xparams[2];
@@ -103,9 +106,12 @@ void with_file(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 15.1.4 get-current-input-port, get-current-output-port */
-void get_current_port(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void get_current_port(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: symbol name
** xparams[1]: dynamic key
@@ -123,8 +129,14 @@ void get_current_port(klisp_State *K, TValue *xparams, TValue ptree,
/* 15.1.5 open-input-file, open-output-file */
/* 15.1.? open-binary-input-file, open-binary-output-file */
-void open_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void open_file(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(denv);
+
/*
** xparams[0]: write?
** xparams[1]: binary?
@@ -140,8 +152,12 @@ void open_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 15.1.? open-input-string, open-output-string */
/* 15.1.? open-input-bytevector, open-output-bytevector */
-void open_mport(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void open_mport(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: write?
** xparams[1]: binary?
@@ -171,8 +187,12 @@ void open_mport(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 15.1.? open-output-string, open-output-bytevector */
/* 15.1.6 close-input-file, close-output-file */
-void close_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void close_file(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: write?
*/
@@ -193,8 +213,12 @@ void close_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 15.1.? close-input-port, close-output-port, close-port */
-void close_port(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void close_port(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: read?
** xparams[1]: write?
@@ -218,9 +242,12 @@ void close_port(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 15.1.? get-output-string, get-output-bytevector */
-void get_output_buffer(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void get_output_buffer(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: binary?
*/
@@ -248,8 +275,12 @@ void get_output_buffer(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 15.1.7 read */
-void gread(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void gread(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -275,8 +306,12 @@ void gread(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 15.1.8 write */
-void gwrite(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void gwrite(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -307,8 +342,12 @@ void gwrite(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* uses typep */
/* 15.1.? newline */
-void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void newline(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -333,8 +372,12 @@ void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 15.1.? write-char */
-void write_char(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void write_char(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -361,9 +404,12 @@ void write_char(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Helper for read-char and peek-char */
-void read_peek_char(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void read_peek_char(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: ret-char-after-readp
*/
@@ -403,8 +449,12 @@ void read_peek_char(klisp_State *K, TValue *xparams, TValue ptree,
specific code (probably select for posix & a thread for windows
(at least for files & consoles, I think pipes and sockets may
have something) */
-void char_readyp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void char_readyp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -429,8 +479,12 @@ void char_readyp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 15.1.? write-u8 */
-void write_u8(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void write_u8(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -456,9 +510,12 @@ void write_u8(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Helper for read-u8 and peek-u8 */
-void read_peek_u8(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void read_peek_u8(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: ret-u8-after-readp
*/
@@ -498,8 +555,12 @@ void read_peek_u8(klisp_State *K, TValue *xparams, TValue ptree,
specific code (probably select for posix & a thread for windows
(at least for files & consoles, I think pipes and sockets may
have something) */
-void u8_readyp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void u8_readyp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -528,9 +589,12 @@ void u8_readyp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
the dynamic environment can be captured in the construction of the combiner
ASK John
*/
-void call_with_file(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void call_with_file(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
bool writep = bvalue(xparams[1]);
UNUSED(denv);
@@ -555,9 +619,12 @@ void call_with_file(klisp_State *K, TValue *xparams, TValue ptree,
/* helpers for load */
/* interceptor for errors during reading */
-void do_int_close_file(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void do_int_close_file(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: port
*/
@@ -617,8 +684,12 @@ TValue make_guarded_read_cont(klisp_State *K, TValue parent, TValue port)
applicative.
ASK John: maybe we should return the result of the last expression.
*/
-void load(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void load(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
bind_1tp(K, ptree, "string", ttisstring, filename);
@@ -668,8 +739,12 @@ void load(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 15.2.3 get-module */
-void get_module(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void get_module(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_al1tp(K, ptree, "string", ttisstring, filename,
@@ -729,8 +804,12 @@ void get_module(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 15.2.? display */
-void display(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void display(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -758,8 +837,12 @@ void display(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 15.1.? flush-output-port */
-void flush(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void flush(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -784,8 +867,12 @@ void flush(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 15.1.? file-exists? */
-void file_existsp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void file_existsp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -803,8 +890,12 @@ void file_existsp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 15.1.? delete-file */
-void delete_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void delete_file(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -824,8 +915,12 @@ void delete_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 15.1.? rename-file */
-void rename_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void rename_file(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
diff --git a/src/kgports.h b/src/kgports.h
@@ -35,49 +35,45 @@
/* 15.1.3 with-input-from-file, with-ouput-to-file */
/* 15.1.? with-error-to-file */
-void with_file(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void with_file(klisp_State *K);
/* 15.1.4 get-current-input-port, get-current-output-port */
/* 15.1.? get-current-error-port */
-void get_current_port(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void get_current_port(klisp_State *K);
/* 15.1.5 open-input-file, open-output-file */
-void open_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void open_file(klisp_State *K);
/* 15.1.? open-input-string, open-output-string */
/* 15.1.? open-input-bytevector, open-output-bytevector */
-void open_mport(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void open_mport(klisp_State *K);
/* 15.1.6 close-input-file, close-output-file */
-void close_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void close_file(klisp_State *K);
/* 15.1.? close-port, close-input-port, close-output-port */
-void close_port(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void close_port(klisp_State *K);
/* 15.1.? get-output-string, get-output-bytevector */
-void get_output_buffer(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void get_output_buffer(klisp_State *K);
/* 15.1.7 read */
-void gread(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void gread(klisp_State *K);
/* 15.1.8 write */
-void gwrite(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void gwrite(klisp_State *K);
/* 15.1.? eof-object? */
/* uses typep */
/* 15.1.? newline */
-void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void newline(klisp_State *K);
/* 15.1.? write-char */
-void write_char(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void write_char(klisp_State *K);
/* Helper for read-char and peek-char */
-void read_peek_char(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void read_peek_char(klisp_State *K);
/* 15.1.? read-char */
/* uses read_peek_char */
@@ -90,34 +86,33 @@ void read_peek_char(klisp_State *K, TValue *xparams, TValue ptree,
specific code (probably select for posix, a thread for windows
(at least for files & consoles), I think pipes and sockets may
have something */
-void char_readyp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void char_readyp(klisp_State *K);
/* 15.2.1 call-with-input-file, call-with-output-file */
-void call_with_file(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void call_with_file(klisp_State *K);
/* 15.2.2 load */
-void load(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void load(klisp_State *K);
/* 15.2.3 get-module */
-void get_module(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void get_module(klisp_State *K);
/* 15.2.? display */
-void display(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void display(klisp_State *K);
void do_close_file_ret(klisp_State *K);
/* 15.1.? flush-output-port */
-void flush(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void flush(klisp_State *K);
/* 15.1.? file-exists? */
-void file_existsp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void file_existsp(klisp_State *K);
/* 15.1.? delete-file */
-void delete_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void delete_file(klisp_State *K);
/* 15.1.? rename-file */
-void rename_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void rename_file(klisp_State *K);
/* init ground */
void kinit_ports_ground_env(klisp_State *K);
diff --git a/src/kgpromises.c b/src/kgpromises.c
@@ -67,8 +67,12 @@ void do_handle_result(klisp_State *K)
}
/* 9.1.2 force */
-void force(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void force(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1p(K, ptree, obj);
@@ -89,8 +93,12 @@ void force(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 9.1.3 $lazy */
-void Slazy(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void Slazy(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
bind_1p(K, ptree, exp);
@@ -99,8 +107,12 @@ void Slazy(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 9.1.4 memoize */
-void memoize(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void memoize(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
diff --git a/src/kgpromises.h b/src/kgpromises.h
@@ -22,13 +22,13 @@
/* uses typep */
/* 9.1.2 force */
-void force(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void force(klisp_State *K);
/* 9.1.3 $lazy */
-void Slazy(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void Slazy(klisp_State *K);
/* 9.1.4 memoize */
-void memoize(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void memoize(klisp_State *K);
void do_handle_result(klisp_State *K);
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -33,8 +33,12 @@
/* use ftypep */
/* 13.1.2? make-string */
-void make_string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void make_string(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_al1tp(K, ptree, "exact integer", keintegerp, tv_s,
@@ -57,9 +61,12 @@ void make_string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 13.1.3? string-length */
-void string_length(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void string_length(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "string", ttisstring, str);
@@ -69,8 +76,12 @@ void string_length(klisp_State *K, TValue *xparams, TValue ptree,
}
/* 13.1.4? string-ref */
-void string_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void string_ref(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_2tp(K, ptree, "string", ttisstring, str,
@@ -94,8 +105,12 @@ void string_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 13.1.5? string-set! */
-void string_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void string_setS(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_3tp(K, ptree, "string", ttisstring, str,
@@ -148,8 +163,12 @@ inline TValue list_to_string_h(klisp_State *K, char *name, TValue ls)
}
/* 13.2.1? string */
-void string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void string(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -245,8 +264,12 @@ bool kstring_ci_gep(TValue str1, TValue str2)
/* TEMP: at least for now this always returns mutable strings (like in Racket and
following the Kernel Report where it says that object returned should be mutable
unless stated) */
-void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void substring(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_3tp(K, ptree, "string", ttisstring, str,
@@ -291,9 +314,12 @@ void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 13.2.6? string-append */
/* TEMP: at least for now this always returns mutable strings */
/* TEMP: this does 3 passes over the list */
-void string_append(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void string_append(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
int32_t dummy;
@@ -340,9 +366,12 @@ void string_append(klisp_State *K, TValue *xparams, TValue ptree,
/* 13.2.7? string->list, list->string */
-void string_to_list(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void string_to_list(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -361,9 +390,12 @@ void string_to_list(klisp_State *K, TValue *xparams, TValue ptree,
kapply_cc(K, kcutoff_dummy1(K));
}
-void list_to_string(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void list_to_string(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
@@ -376,8 +408,12 @@ void list_to_string(klisp_State *K, TValue *xparams, TValue ptree,
/* 13.2.8? string-copy */
/* TEMP: at least for now this always returns mutable strings */
-void string_copy(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void string_copy(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "string", ttisstring, str);
@@ -393,9 +429,12 @@ void string_copy(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* 13.2.9? string->immutable-string */
-void string_to_immutable_string(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void string_to_immutable_string(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "string", ttisstring, str);
@@ -410,8 +449,12 @@ void string_to_immutable_string(klisp_State *K, TValue *xparams,
}
/* 13.2.10? string-fill! */
-void string_fillS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void string_fillS(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_2tp(K, ptree, "string", ttisstring, str,
diff --git a/src/kgstrings.h b/src/kgstrings.h
@@ -25,20 +25,19 @@
/* use ftypep */
/* 13.1.2? make-string */
-void make_string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void make_string(klisp_State *K);
/* 13.1.3? string-length */
-void string_length(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void string_length(klisp_State *K);
/* 13.1.4? string-ref */
-void string_ref (klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void string_ref (klisp_State *K);
/* 13.1.5? string-set! */
-void string_setS (klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void string_setS (klisp_State *K);
/* 13.2.1? string */
-void string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void string(klisp_State *K);
/* 13.2.2? string=?, string-ci=? */
/* use ftyped_bpredp */
@@ -66,27 +65,23 @@ bool kstring_ci_gep(TValue str1, TValue str2);
/* 13.2.5? substring */
-void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void substring(klisp_State *K);
/* 13.2.6? string-append */
-void string_append(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void string_append(klisp_State *K);
/* 13.2.7? string->list, list->string */
-void list_to_string(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
-void string_to_list(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void list_to_string(klisp_State *K);
+void string_to_list(klisp_State *K);
/* 13.2.8? string-copy */
-void string_copy(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void string_copy(klisp_State *K);
/* 13.2.9? string->immutable-string */
-void string_to_immutable_string(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv);
+void string_to_immutable_string(klisp_State *K);
/* 13.2.10? string-fill! */
-void string_fillS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void string_fillS(klisp_State *K);
/* Helpers */
bool kstringp(TValue obj);
diff --git a/src/kgsymbols.c b/src/kgsymbols.c
@@ -27,9 +27,12 @@
/* 13.3.1? symbol->string */
/* The strings in symbols are immutable so we can just return that */
-void symbol_to_string(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void symbol_to_string(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "symbol", ttissymbol, sym);
@@ -48,9 +51,12 @@ void symbol_to_string(klisp_State *K, TValue *xparams, TValue ptree,
again must be equal? which happens here
*/
/* If the string is mutable it is copied */
-void string_to_symbol(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void string_to_symbol(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "string", ttisstring, str);
diff --git a/src/kgsymbols.h b/src/kgsymbols.h
@@ -22,8 +22,7 @@
/* uses typep */
/* ?.?.1? symbol->string */
-void symbol_to_string(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void symbol_to_string(klisp_State *K);
/* ?.?.2? string->symbol */
/* TEMP: for now this can create symbols with no external representation
@@ -35,8 +34,7 @@ void symbol_to_string(klisp_State *K, TValue *xparams, TValue ptree,
because the report only says that read objects when written and read
again must be equal? which happens here
*/
-void string_to_symbol(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void string_to_symbol(klisp_State *K);
/* init ground */
void kinit_symbols_ground_env(klisp_State *K);
diff --git a/src/kgsystem.c b/src/kgsystem.c
@@ -23,9 +23,16 @@
*/
/* ??.?.? current-second */
-void current_second(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void current_second(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(xparams);
+ UNUSED(denv);
+
+ check_0p(K, ptree);
time_t now = time(NULL);
if (now == -1) {
klispE_throw_simple(K, "couldn't get time");
@@ -43,9 +50,16 @@ void current_second(klisp_State *K, TValue *xparams, TValue ptree,
}
/* ??.?.? current-jiffy */
-void current_jiffy(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void current_jiffy(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(xparams);
+ UNUSED(denv);
+
+ check_0p(K, ptree);
/* TODO, this may wrap around... use time+clock to a better number */
/* XXX doesn't seem to work... should probably use gettimeofday
in posix anyways */
@@ -66,9 +80,16 @@ void current_jiffy(klisp_State *K, TValue *xparams, TValue ptree,
}
/* ??.?.? jiffies-per-second */
-void jiffies_per_second(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void jiffies_per_second(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(xparams);
+ UNUSED(denv);
+
+ check_0p(K, ptree);
if (CLOCKS_PER_SEC > INT32_MAX) {
/* XXX/TODO create bigint */
klispE_throw_simple(K, "integer too big");
diff --git a/src/kgsystem.h b/src/kgsystem.h
@@ -19,11 +19,9 @@
#include "kghelpers.h"
/* ??.?.? current-second */
-void current_second(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void current_second(klisp_State *K);
/* ??.?.? current-jiffy */
-void current_jiffy(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void current_jiffy(klisp_State *K);
/* init ground */
void kinit_system_ground_env(klisp_State *K);
diff --git a/src/klisp.c b/src/klisp.c
@@ -195,9 +195,12 @@ void do_str_read(klisp_State *K)
kapply_cc(K, obj1);
}
-void do_int_mark_error(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void do_int_mark_error(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: errorp pointer
*/
diff --git a/src/koperative.c b/src/koperative.c
@@ -13,7 +13,7 @@
#include "kgc.h"
/* GC: Assumes all argps are rooted */
-TValue kmake_operative(klisp_State *K, klisp_Ofunc fn, int32_t xcount, ...)
+TValue kmake_operative(klisp_State *K, klisp_CFunction fn, int32_t xcount, ...)
{
va_list argp;
diff --git a/src/koperative.h b/src/koperative.h
@@ -13,6 +13,7 @@
/* TODO: make some specialized constructors for 0, 1 and 2 parameters */
/* GC: Assumes all argps are rooted */
-TValue kmake_operative(klisp_State *K, klisp_Ofunc fn, int xcount, ...);
+TValue kmake_operative(klisp_State *K, klisp_CFunction fn, int32_t xcount,
+ ...);
#endif
diff --git a/src/krepl.c b/src/krepl.c
@@ -83,8 +83,7 @@ void do_repl_eval(klisp_State *K)
}
void do_repl_loop(klisp_State *K);
-void do_int_repl_error(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void do_int_repl_error(klisp_State *K);
/* this is called from both do_repl_loop and do_repl_error */
/* GC: assumes denv is NOT rooted */
@@ -155,9 +154,12 @@ void do_repl_loop(klisp_State *K)
}
/* the underlying function of the error cont */
-void do_int_repl_error(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void do_int_repl_error(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
/*
** xparams[0]: dynamic environment
*/
diff --git a/src/kstate.c b/src/kstate.c
@@ -504,8 +504,12 @@ inline TValue create_interception_list(klisp_State *K, TValue src_cont,
}
/* this passes the operand tree to the continuation */
-void cont_app(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void cont_app(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
TValue cont = xparams[0];
/* guards and dynamic variables are handled in kcall_cont() */
@@ -604,15 +608,9 @@ void klispS_run(klisp_State *K)
} else {
/* all ok, continue with next func */
while (K->next_func) {
- if (ttisnil(K->next_env)) {
- /* continuation application */
- klisp_Cfunc fn = (klisp_Cfunc) K->next_func;
- (*fn)(K);
- } else {
- /* operative calling */
- klisp_Ofunc fn = (klisp_Ofunc) K->next_func;
- (*fn)(K, K->next_xparams, K->next_value, K->next_env);
- }
+ /* next_func is either operative or continuation
+ but in any case the call is the same */
+ (*(K->next_func))(K);
}
/* K->next_func is NULL, this means we should exit already */
break;
diff --git a/src/kstate.h b/src/kstate.h
@@ -21,6 +21,12 @@
#include "ktoken.h"
#include "kmem.h"
+/*
+** prototype for underlying c functions of continuations &
+** operatives
+*/
+typedef void (*klisp_CFunction) (klisp_State *K);
+
/* XXX: for now, lines and column names are fixints */
/* MAYBE: this should be in tokenizer */
typedef struct {
@@ -51,13 +57,13 @@ struct klisp_State {
TValue curr_cont;
/*
- ** If next_env is NIL, then the next_func is of type klisp_Cfunc
- ** (from a continuation) and otherwise next_func is of type
- ** klisp_Ofunc (from an operative)
+ ** If next_env is NIL, then the next_func from a continuation
+ ** and otherwise next_func is from an operative
*/
TValue next_obj; /* this is the operative or continuation to call
must be here to protect it from gc */
- void *next_func; /* the next function to call (operative or cont) */
+ klisp_CFunction next_func; /* the next function to call
+ (operative or continuation) */
TValue next_value; /* the value to be passed to the next function */
TValue next_env; /* either NIL or an environment for next operative */
TValue *next_xparams;
@@ -348,14 +354,6 @@ inline void krooted_vars_clear(klisp_State *K) { K->rooted_vars_top = 0; }
/* dummy functions will be in kpair.h, because we can't include
it from here */
-/*
-** prototypes for underlying c functions of continuations &
-** operatives
-*/
-typedef void (*klisp_Cfunc) (klisp_State *K);
-typedef void (*klisp_Ofunc) (klisp_State *K, TValue *ud, TValue ptree,
- TValue env);
-
/* XXX: this is ugly but we can't include kpair.h here so... */
/* MAYBE: move car & cdr to kobject.h */
#define kstate_car(p_) (tv2pair(p_)->car)
@@ -485,12 +483,13 @@ inline void klispS_tail_call_si(klisp_State *K, TValue top, TValue ptree,
#define ktail_eval(K_, p_, e_) \
{ klisp_State *K__ = (K_); \
TValue p__ = (p_); \
+ /* XXX */ klisp_assert(ttisenvironment(e_)); \
klispS_tail_call_si(K__, K__->eval_op, p__, (e_), \
ktry_get_si(K__, p__)); \
return; }
/* helper for continuation->applicative & kcall_cont */
-void cont_app(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void cont_app(klisp_State *K);
void kcall_cont(klisp_State *K, TValue dst_cont, TValue obj);
void klispS_init_repl(klisp_State *K);
void klispS_run(klisp_State *K);
diff --git a/src/rep_cont_c.sed b/src/rep_cont_c.sed
@@ -1,43 +0,0 @@
-# This is a collection of sed commands to refactor continuation underlying
-# functions to just take a kernel state pointer (instead of also taking extra
-# params and value object.
-
-# All these tests are run one at a time with sed -n
-
-# detect lonely parens
-# /[(] /P
-# none remaining
-
-# detect klisp_State pointer without open parens on the same line
-# /[^(]klisp_State \*K, /P
-# none remaining
-
-# detect single line function definition (trailing ;)
-# There are 3
-#/[(]klisp_State \*K, TValue \*xparams, TValue obj[)];/P
-# use the rep_cont_h.sed script to replace them
-# There are 0 now
-
-# detect single line function definition (no trailing ;)
-#/[(]klisp_State \*K, TValue \*xparams, TValue obj[)]/P
-# There are 48, that is one for each of the 3 we just did, 44 for
-# the ones defined in .h and probably 1 with no definition
-
-# All are single line, detect them with the opening brace
-#/[(]klisp_State \*K, TValue \*xparams, TValue obj[)]/{
-#N
-#/[(]klisp_State \*K, TValue \*xparams, TValue obj[)].*\n[{]/P
-#}
-
-# All function definition are one line, just replace them in the .c
-# This is used to modify in place with sed -i -f <this-file> *.c
-# The only problem was do_ffi_callback_decode_arguments (was two lines)
-/[(]klisp_State \*K, TValue \*xparams, TValue obj[)]/{
-N
-s/^void \(.*\)[(]klisp_State \*K, TValue \*xparams, TValue obj[)].*\n[{]/void \1(klisp_State *K)\
-\{\
- TValue *xparams = K->next_xparams;\
- TValue obj = K->next_value;\
- klisp_assert(ttisnil(K->next_env));/
-}
-
diff --git a/src/rep_cont_h.sed b/src/rep_cont_h.sed
@@ -1,25 +0,0 @@
-# This is a collection of sed commands to refactor continuation underlying
-# functions to just take a kernel state pointer (instead of also taking extra
-# params and value object.
-
-# All these tests are run one at a time with sed -n
-
-# detect lonely parens
-# /[(] /P
-# none remaining
-
-# detect klisp_State pointer without open parens on the same line
-# /[^(]klisp_State \*K, /P
-# none remaining
-
-# detect single line function definition
-# There are 44, all starting with do_
-#/[(]klisp_State \*K, TValue \*xparams, TValue obj[)];/P
-
-#detect functions names starting with do_
-# There are 47, do_access, do_bind and do_vau are not continuation
-#/void do_/P
-
-# All function definition are one line, just replace them in the .h
-# This is used to modify in place with sed -i -f <this-file> *.h
-s/^void \(.*\)[(]klisp_State \*K, TValue \*xparams, TValue obj[)];/void \1(klisp_State *K);/
diff --git a/src/rep_op_c.sed b/src/rep_op_c.sed
@@ -0,0 +1,78 @@
+# This is a collection of sed commands to refactor operatives underlying
+# functions to just take a kernel state pointer (instead of also taking extra
+# params, ptree and denv).
+
+# All these tests are run one at a time with sed -n
+
+# This is a collection of sed commands to refactor operatives underlying
+# functions to just take a kernel state pointer (instead of also taking extra
+# params, ptree and denv).
+
+# All these tests are run one at a time with sed -n
+
+# detect single line function definition
+# There are 0
+#/^void \(.*\)[(]klisp_State \*K, TValue \*xparams, TValue ptree, TValue denv[)];/P
+
+# All the single line definitions done
+
+# try to detect multi line function definition
+# There are 1, do_int_repl_error
+#/^void \(.*\)[(]klisp_State \*K,/{
+#N
+#/^void \(.*\)[(]klisp_State \*K,[[:space:]]*TValue \*xparams,[[:space:]]*TValue ptree,[[:space:]]*TValue denv);/P
+#}
+
+# replace it
+#/^void \(.*\)[(]klisp_State \*K,/{
+#N
+#s/^void \(.*\)[(]klisp_State \*K,[[:space:]]*TValue \*xparams,[[:space:]]*TValue ptree,[[:space:]]*#TValue denv);/void \1(klisp_State *K);/
+#}
+
+# done!
+
+# Detect all with simple brace
+# There are 101
+#/^void \(.*\)[(]klisp_State \*K, TValue \*xparams, TValue ptree, TValue denv[)]/{
+#N
+#/^void \(.*\)[(]klisp_State \*K, TValue \*xparams, TValue ptree, TValue denv[)].*\n[{]/P
+#}
+
+# replace them
+# This is used to modify in place with sed -i -f <this-file> *.c
+#/^void \(.*\)[(]klisp_State \*K, TValue \*xparams, TValue ptree, TValue denv[)]/{
+#N
+#s/^void \(.*\)[(]klisp_State \*K, TValue \*xparams, TValue ptree, TValue denv[)].*\n[{]/void \1(klisp_State *K)\
+#\{\
+# TValue *xparams = K->next_xparams;\
+# TValue ptree = K->next_value;\
+# TValue denv = K->next_env;\
+# klisp_assert(ttisenvironment(K->next_env));/
+#}
+
+# Detect the ones in two lines (with braces)
+# There are 84
+#/^void \(.*\)[(]klisp_State \*K,/{
+#N
+#N
+#/^void \(.*\)[(]klisp_State \*K,[[:space:]]*TValue \*xparams,[[:space:]]*TValue ptree,[[:space:]]*TValue denv[)][[:space:]]*[{]/P
+#}
+
+# replace them
+# This is used to modify in place with sed -i -f <this-file> *.c
+/^void \(.*\)[(]klisp_State \*K,/{
+N
+N
+s/^void \(.*\)[(]klisp_State \*K,[[:space:]]*TValue \*xparams,[[:space:]]*TValue ptree,[[:space:]]*TValue denv[)][[:space:]]*[{]/void \1(klisp_State *K)\
+\{\
+ TValue *xparams = K->next_xparams;\
+ TValue ptree = K->next_value;\
+ TValue denv = K->next_env;\
+ klisp_assert(ttisenvironment(K->next_env));/
+}
+
+# keval_ofn was changed manually because the name of denv was env
+# (denv was reserved for the den param in ptree)
+# do_vau was changed manually because the name of ptree was obj
+# (ptree was reserved for the ptree param)
+# ffi_type_ref and ffi_type_ref were changed manually (were static)
diff --git a/src/rep_op_h.sed b/src/rep_op_h.sed
@@ -0,0 +1,31 @@
+# This is a collection of sed commands to refactor operatives underlying
+# functions to just take a kernel state pointer (instead of also taking extra
+# params, ptree and denv).
+
+# All these tests are run one at a time with sed -n
+
+# detect single line function definition
+# There are 97
+/^void \(.*\)[(]klisp_State \*K, TValue \*xparams, TValue ptree, TValue denv[)];/P
+
+# Replace them in place with sed -i -f <this-file> *.h
+#s/^void \(.*\)[(]klisp_State \*K, TValue \*xparams, TValue ptree, TValue denv[)];/void \1(klisp_State *K);/
+
+# All the single line definitions done
+
+# try to detect multi line function definition
+# There are 62
+#/^void \(.*\)[(]klisp_State \*K,/{
+#N
+#/^void \(.*\)[(]klisp_State \*K,[[:space:]]*TValue \*xparams,[[:space:]]*TValue ptree,[[:space:]]*TValue denv);/P
+#}
+
+# replace them
+# equalp had a type (was xparas instead of xparams), correct first
+s/xparas/xparams/
+/^void \(.*\)[(]klisp_State \*K,/{
+N
+s/^void \(.*\)[(]klisp_State \*K,[[:space:]]*TValue \*xparams,[[:space:]]*TValue ptree,[[:space:]]*TValue denv);/void \1(klisp_State *K);/
+}
+
+# Done!
+\ No newline at end of file
