commit 82045a3e8dce30c1102dfa23eb42bf3ebd2b1a50
parent 1a607a12a0b55b476adba3d5c8bf695d54a39be4
Author: Andres Navarro <canavarro82@gmail.com>
Date: Wed, 23 Nov 2011 05:26:07 -0300
Merged changes from refactor
Diffstat:
65 files changed, 1650 insertions(+), 683 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
@@ -15,8 +15,11 @@
/*
** Eval helpers
*/
-void do_eval_ls(klisp_State *K, TValue *xparams, TValue obj)
+void do_eval_ls(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: this argument list pair
** xparams[1]: dynamic environment
@@ -89,8 +92,11 @@ inline TValue make_arg_ls(klisp_State *K, TValue operands, TValue *tail)
return arg_ls;
}
-void do_combine(klisp_State *K, TValue *xparams, TValue obj)
+void do_combine(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: operand list
** xparams[1]: dynamic environment
@@ -138,22 +144,29 @@ void do_combine(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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,8 +11,8 @@
#include "kstate.h"
#include "kobject.h"
-void keval_ofn(klisp_State *K, TValue *xparams, TValue obj, TValue env);
-void do_eval_ls(klisp_State *K, TValue *xparams, TValue obj);
-void do_combine(klisp_State *K, TValue *xparams, TValue obj);
+void keval_ofn(klisp_State *K);
+void do_eval_ls(klisp_State *K);
+void do_combine(klisp_State *K);
#endif
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 */
@@ -90,8 +102,11 @@ void orp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
** call that is acomplished by checking if the current continuation will
** perform a boolean check, and in that case, no continuation is created
*/
-void do_Sandp_Sorp(klisp_State *K, TValue *xparams, TValue obj)
+void do_Sandp_Sorp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: symbol name
** xparams[1]: termination boolean
@@ -141,8 +156,12 @@ void do_Sandp_Sorp(klisp_State *K, TValue *xparams, TValue obj)
}
}
-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, TValue *xparams, TValue obj);
-void Sandp_Sorp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void do_Sandp_Sorp(klisp_State *K);
+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);
@@ -411,8 +437,11 @@ TValue map_for_each_transpose(klisp_State *K, TValue lss,
/* Continuation helpers for map */
/* For acyclic input lists: Return the mapped list */
-void do_map_ret(klisp_State *K, TValue *xparams, TValue obj)
+void do_map_ret(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: (dummy . complete-ls)
*/
@@ -427,8 +456,11 @@ void do_map_ret(klisp_State *K, TValue *xparams, TValue obj)
}
/* For cyclic input list: close the cycle and return the mapped list */
-void do_map_encycle(klisp_State *K, TValue *xparams, TValue obj)
+void do_map_encycle(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: (dummy . complete-ls)
** xparams[1]: last non-cycle pair
@@ -450,8 +482,11 @@ void do_map_encycle(klisp_State *K, TValue *xparams, TValue obj)
kapply_cc(K, copy);
}
-void do_map(klisp_State *K, TValue *xparams, TValue obj)
+void do_map(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: app
** xparams[1]: rem-ls
@@ -499,8 +534,11 @@ void do_map(klisp_State *K, TValue *xparams, TValue obj)
}
}
-void do_map_cycle(klisp_State *K, TValue *xparams, TValue obj)
+void do_map_cycle(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: app
** xparams[1]: (dummy . res-list)
@@ -528,7 +566,9 @@ void do_map_cycle(klisp_State *K, TValue *xparams, TValue obj)
the inert value passed to the first continuation */
TValue new_cont =
kmake_continuation(K, encycle_cont, do_map, 6, app, ls,
- last_apair, cpairs, denv, KTRUE);
+ last_apair, i2tv(cpairs), denv, KTRUE);
+ klisp_assert(ttisenvironment(denv));
+
krooted_tvs_pop(K);
kset_cc(K, new_cont);
/* this will be like a nop and will continue with do_map */
@@ -536,8 +576,12 @@ void do_map_cycle(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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);
@@ -577,7 +621,6 @@ void map(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
: kmake_continuation(K, kget_cc(K), do_map_cycle, 4,
app, dummy, i2tv(res_cpairs), denv);
-
krooted_tvs_push(K, ret_cont);
/* schedule the mapping of the elements of the acyclic part.
@@ -592,6 +635,7 @@ void map(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
krooted_tvs_pop(K);
kset_cc(K, new_cont);
+
/* this will be a nop, and will continue with do_map */
kapply_cc(K, KINERT);
}
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,11 +77,11 @@ 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_map_ret(klisp_State *K, TValue *xparams, TValue obj);
-void do_map_encycle(klisp_State *K, TValue *xparams, TValue obj);
-void do_map(klisp_State *K, TValue *xparams, TValue obj);
-void do_map_cycle(klisp_State *K, TValue *xparams, TValue obj);
+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);
+void do_map_cycle(klisp_State *K);
/* init ground */
void kinit_combiners_ground_env(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);
@@ -38,8 +42,11 @@ void call_cc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Helper for extend-continuation */
-void do_extended_cont(klisp_State *K, TValue *xparams, TValue obj)
+void do_extended_cont(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: applicative
** xparams[1]: environment
@@ -53,9 +60,12 @@ void do_extended_cont(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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);
@@ -80,8 +90,11 @@ void extend_continuation(klisp_State *K, TValue *xparams, TValue ptree,
passes the value. xparams is not actually empty, it contains
the entry/exit guards, but they are used only in
continuation->applicative (that is during abnormal passes) */
-void do_pass_value(klisp_State *K, TValue *xparams, TValue obj)
+void do_pass_value(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
UNUSED(xparams);
kapply_cc(K, obj);
}
@@ -158,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,
@@ -194,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 &
@@ -217,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);
@@ -232,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);
@@ -272,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,
@@ -310,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
@@ -19,25 +19,22 @@
#include "kghelpers.h"
/* Helpers (also used in keyed dynamic code) */
-void do_pass_value(klisp_State *K, TValue *xparams, TValue obj);
+void do_pass_value(klisp_State *K);
/* 7.1.1 continuation? */
/* 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,22 +43,18 @@ 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, TValue *xparams, TValue obj);
+void do_extended_cont(klisp_State *K);
/* init ground */
void kinit_continuations_ground_env(klisp_State *K);
diff --git a/src/kgcontrol.c b/src/kgcontrol.c
@@ -26,11 +26,15 @@
/* 4.5.2 $if */
/* helpers */
-void do_select_clause(klisp_State *K, TValue *xparams, TValue obj);
+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;
@@ -48,8 +52,11 @@ void Sif(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
ktail_eval(K, test, denv);
}
-void do_select_clause(klisp_State *K, TValue *xparams, TValue obj)
+void do_select_clause(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: dynamic env
** xparams[1]: consequent clause
@@ -66,8 +73,12 @@ void do_select_clause(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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)) {
@@ -98,9 +109,15 @@ void Ssequence(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Helper (also used by $vau and $lambda) */
-/* the ramaining list can't be null, that case is managed before */
-void do_seq(klisp_State *K, TValue *xparams, TValue obj)
+/* the remaining list can't be null, that case is managed before */
+void do_seq(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
+
+ UNUSED(obj);
+
/*
** xparams[0]: remaining list
** xparams[1]: dynamic environment
@@ -198,8 +215,11 @@ TValue split_check_cond_clauses(klisp_State *K, TValue clauses,
}
/* Helper for the $cond continuation */
-void do_cond(klisp_State *K, TValue *xparams, TValue obj)
+void do_cond(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: the body corresponding to obj
** xparams[1]: remaining tests
@@ -258,8 +278,12 @@ void do_cond(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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;
@@ -289,8 +313,11 @@ void Scond(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Helper continuation for for-each */
-void do_for_each(klisp_State *K, TValue *xparams, TValue obj)
+void do_for_each(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: app
** xparams[1]: rem-ls
@@ -329,8 +356,12 @@ void do_for_each(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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,15 +34,15 @@ 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, TValue *xparams, TValue obj);
-void do_cond(klisp_State *K, TValue *xparams, TValue obj);
-void do_select_clause(klisp_State *K, TValue *xparams, TValue obj);
-void do_for_each(klisp_State *K, TValue *xparams, TValue obj);
+void do_seq(klisp_State *K);
+void do_cond(klisp_State *K);
+void do_select_clause(klisp_State *K);
+void do_for_each(klisp_State *K);
/* init ground */
void kinit_control_ground_env(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
*/
@@ -45,8 +49,11 @@ void SdefineB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* helper */
-void do_match(klisp_State *K, TValue *xparams, TValue obj)
+void do_match(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: ptree
** xparams[1]: dynamic environment
@@ -61,8 +68,12 @@ void do_match(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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];
@@ -82,8 +93,11 @@ void SsetB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Helpers for $set! */
-void do_set_eval_obj(klisp_State *K, TValue *xparams, TValue obj)
+void do_set_eval_obj(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: name as symbol
** xparams[1]: ptree
@@ -169,8 +183,11 @@ TValue check_copy_symbol_list(klisp_State *K, char *name, TValue obj)
return kcutoff_dummy1(K);
}
-void do_import(klisp_State *K, TValue *xparams, TValue obj)
+void do_import(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: name as symbol
** xparams[1]: symbols
@@ -195,8 +212,12 @@ void do_import(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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
*/
@@ -251,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
@@ -21,12 +21,12 @@
/* helpers */
inline void match(klisp_State *K, char *name, TValue env, TValue ptree,
TValue obj);
-void do_match(klisp_State *K, TValue *xparams, TValue obj);
+void do_match(klisp_State *K);
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,20 +235,20 @@ 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, TValue *xparams, TValue obj);
+void do_set_eval_obj(klisp_State *K);
/* Helpers for $provide & $import! */
TValue check_copy_symbol_list(klisp_State *K, char *name, TValue obj);
-void do_import(klisp_State *K, TValue *xparams, 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);
@@ -156,8 +162,11 @@ TValue split_check_let_bindings(klisp_State *K, char *name, TValue bindings,
** it expects the result of the last evaluation to be matched to
** this-ptree
*/
-void do_let(klisp_State *K, TValue *xparams, TValue obj)
+void do_let(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: symbol name
** xparams[1]: this ptree
@@ -212,8 +221,12 @@ void do_let(klisp_State *K, TValue *xparams, TValue obj)
/* 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
*/
@@ -248,8 +261,11 @@ void Slet(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Helper for $binds? */
-void do_bindsp(klisp_State *K, TValue *xparams, TValue obj)
+void do_bindsp(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: symbol list (may contain cycles)
** xparams[1]: symbol list count
@@ -278,8 +294,12 @@ void do_bindsp(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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);
@@ -297,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);
@@ -320,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
*/
@@ -369,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
*/
@@ -406,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
*/
@@ -456,8 +494,11 @@ void SletrecS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Helper for $let-redirect */
-void do_let_redirect(klisp_State *K, TValue *xparams, TValue obj)
+void do_let_redirect(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: symbol name
** xparams[1]: ptree
@@ -487,8 +528,12 @@ void do_let_redirect(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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
*/
@@ -522,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
*/
@@ -561,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);
@@ -576,8 +629,11 @@ void Sremote_eval(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* Helper for $remote-eval */
-void do_remote_eval(klisp_State *K, TValue *xparams, TValue obj)
+void do_remote_eval(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
if (!ttisenvironment(obj)) {
klispE_throw_simple(K, "bad type from second operand "
"evaluation (expected environment)");
@@ -589,8 +645,11 @@ void do_remote_eval(klisp_State *K, TValue *xparams, TValue obj)
}
/* Helper for $bindings->environment */
-void do_b_to_env(klisp_State *K, TValue *xparams, TValue obj)
+void do_b_to_env(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: ptree
** xparams[1]: created env
@@ -603,9 +662,12 @@ void do_b_to_env(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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,65 +25,60 @@
/* 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, TValue *xparams, TValue obj);
+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, TValue *xparams, TValue obj);
+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, TValue *xparams, TValue obj);
+void do_remote_eval(klisp_State *K);
/* Helper for $bindings->environment */
-void do_b_to_env(klisp_State *K, TValue *xparams, TValue obj);
+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, TValue *xparams, TValue obj);
+void do_let(klisp_State *K);
/* init ground */
void kinit_environments_ground_env(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);
@@ -49,8 +58,11 @@ void error_object_irritants(klisp_State *K, TValue *xparams, TValue ptree,
kapply_cc(K, err_obj->irritants);
}
/* REFACTOR this is the same as do_pass_value */
-void do_exception_cont(klisp_State *K, TValue *xparams, TValue obj)
+void do_exception_cont(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
UNUSED(xparams);
/* Just pass error object to general error continuation. */
kapply_cc(K, obj);
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);
@@ -699,9 +712,11 @@ static TValue ffi_callback_guard(ffi_callback_t *cb, klisp_Ofunc fn)
return ls2;
}
-void do_ffi_callback_encode_result(klisp_State *K, TValue *xparams,
- TValue obj)
+void do_ffi_callback_encode_result(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: cif
** xparams[1]: p2tv(libffi return buffer)
@@ -712,9 +727,12 @@ void do_ffi_callback_encode_result(klisp_State *K, TValue *xparams,
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)
@@ -764,8 +782,11 @@ void do_ffi_callback_decode_arguments(klisp_State *K, TValue *xparams,
ktail_call(K, app_tv, tail, denv);
}
-void do_ffi_callback_return(klisp_State *K, TValue *xparams, TValue obj)
+void do_ffi_callback_return(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
UNUSED(obj);
/*
** xparams[0]: p2tv(ffi_callback_t)
@@ -778,11 +799,15 @@ void do_ffi_callback_return(klisp_State *K, TValue *xparams, TValue obj)
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.
@@ -794,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)
@@ -845,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. */
@@ -878,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
@@ -996,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);
@@ -1018,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
*/
@@ -1038,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
*/
@@ -1060,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);
@@ -1094,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
@@ -301,8 +321,11 @@ int32_t check_list(klisp_State *K, const char *name, bool allow_infp,
** Continuation that ignores the value received and instead returns
** a previously computed value.
*/
-void do_return_value(klisp_State *K, TValue *xparams, TValue obj)
+void do_return_value(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: saved_obj
*/
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,18 +388,18 @@ 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);
/*
** Continuation that ignores the value received and instead returns
** a previously computed value.
*/
-void do_return_value(klisp_State *K, TValue *xparams, TValue obj);
+void do_return_value(klisp_State *K);
/* GC: assumes parent & obj are rooted */
inline TValue make_return_value_cont(klisp_State *K, TValue parent, TValue obj)
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
*/
@@ -51,8 +54,11 @@ void do_access(klisp_State *K, TValue *xparams, TValue ptree,
}
/* continuation to set the key to the old value on normal return */
-void do_unbind(klisp_State *K, TValue *xparams, TValue obj)
+void do_unbind(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: dynamic key
** xparams[1]: old flag
@@ -70,9 +76,12 @@ void do_unbind(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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
@@ -149,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
*/
@@ -186,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,16 +19,13 @@
#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, TValue *xparams, TValue obj);
+void do_unbind(klisp_State *K);
/* init ground */
void kinit_kgkd_vars_ground_env(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);
@@ -469,8 +508,11 @@ void list_neighbors(klisp_State *K, TValue *xparams, TValue ptree,
/* Helpers for filter */
/* For acyclic input lists: Return the filtered list */
-void do_ret_cdr(klisp_State *K, TValue *xparams, TValue obj)
+void do_ret_cdr(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: (dummy . complete-ls)
*/
@@ -487,8 +529,11 @@ void do_ret_cdr(klisp_State *K, TValue *xparams, TValue obj)
/* For cyclic input list: If the result cycle is non empty,
close it and return filtered list */
-void do_filter_encycle(klisp_State *K, TValue *xparams, TValue obj)
+void do_filter_encycle(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: (dummy . complete-ls)
** xparams[1]: last non-cycle pair
@@ -518,8 +563,11 @@ void do_filter_encycle(klisp_State *K, TValue *xparams, TValue obj)
kapply_cc(K, copy);
}
-void do_filter(klisp_State *K, TValue *xparams, TValue obj)
+void do_filter(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: app
** xparams[1]: (last-obj . rem-ls)
@@ -565,8 +613,11 @@ void do_filter(klisp_State *K, TValue *xparams, TValue obj)
}
}
-void do_filter_cycle(klisp_State *K, TValue *xparams, TValue obj)
+void do_filter_cycle(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: app
** xparams[1]: (dummy . res-list)
@@ -599,8 +650,12 @@ void do_filter_cycle(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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,
@@ -640,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);
@@ -664,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);
@@ -688,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);
@@ -716,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);
@@ -746,10 +816,13 @@ void countable_listp(klisp_State *K, TValue *xparams, TValue ptree,
/* Helpers for reduce */
/* NOTE: This is used from both do_reduce_cycle and reduce */
-void do_reduce(klisp_State *K, TValue *xparams, TValue obj);
+void do_reduce(klisp_State *K);
-void do_reduce_prec(klisp_State *K, TValue *xparams, TValue obj)
+void do_reduce_prec(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: first-pair
** xparams[1]: (old-obj . rem-ls)
@@ -783,8 +856,11 @@ void do_reduce_prec(klisp_State *K, TValue *xparams, TValue obj)
}
}
-void do_reduce_postc(klisp_State *K, TValue *xparams, TValue obj)
+void do_reduce_postc(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: postc
** xparams[1]: denv
@@ -799,8 +875,11 @@ void do_reduce_postc(klisp_State *K, TValue *xparams, TValue obj)
/* This could be avoided by contructing a list and calling
do_reduce, but the order would be backwards if the cycle
is processed after the acyclic part */
-void do_reduce_combine(klisp_State *K, TValue *xparams, TValue obj)
+void do_reduce_combine(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: acyclic result
** xparams[1]: bin
@@ -818,8 +897,11 @@ void do_reduce_combine(klisp_State *K, TValue *xparams, TValue obj)
ktail_eval(K, expr, denv);
}
-void do_reduce_cycle(klisp_State *K, TValue *xparams, TValue obj)
+void do_reduce_cycle(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: first-cpair
** xparams[1]: cpairs
@@ -879,8 +961,11 @@ void do_reduce_cycle(klisp_State *K, TValue *xparams, TValue obj)
}
/* NOTE: This is used from both do_reduce_cycle and reduce */
-void do_reduce(klisp_State *K, TValue *xparams, TValue obj)
+void do_reduce(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: remaining list
** xparams[1]: remaining pairs
@@ -920,8 +1005,12 @@ void do_reduce(klisp_State *K, TValue *xparams, TValue obj)
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,54 +48,51 @@ 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 do_ret_cdr(klisp_State *K, TValue *xparams, TValue obj);
-void do_filter_encycle(klisp_State *K, TValue *xparams, TValue obj);
-void do_filter_cycle(klisp_State *K, TValue *xparams, TValue obj);
-void do_filter(klisp_State *K, TValue *xparams, TValue obj);
-void do_reduce_prec(klisp_State *K, TValue *xparams, TValue obj);
-void do_reduce_postc(klisp_State *K, TValue *xparams, TValue obj);
-void do_reduce_combine(klisp_State *K, TValue *xparams, TValue obj);
-void do_reduce_cycle(klisp_State *K, TValue *xparams, TValue obj);
-void do_reduce(klisp_State *K, TValue *xparams, TValue obj);
+void reduce(klisp_State *K);
+
+
+void do_ret_cdr(klisp_State *K);
+void do_filter_encycle(klisp_State *K);
+void do_filter_cycle(klisp_State *K);
+void do_filter(klisp_State *K);
+void do_reduce_prec(klisp_State *K);
+void do_reduce_postc(klisp_State *K);
+void do_reduce_combine(klisp_State *K);
+void do_reduce_cycle(klisp_State *K);
+void do_reduce(klisp_State *K);
/* init ground */
void kinit_pairs_lists_ground_env(klisp_State *K);
diff --git a/src/kgports.c b/src/kgports.c
@@ -54,8 +54,11 @@
/* 15.1.3 with-input-from-file, with-ouput-to-file */
/* helper for with-i/o-from/to-file & call-with-i/o-file */
-void do_close_file_ret(klisp_State *K, TValue *xparams, TValue obj)
+void do_close_file_ret(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: port
*/
@@ -70,9 +73,12 @@ void do_close_file_ret(klisp_State *K, TValue *xparams, TValue obj)
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];
@@ -100,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
@@ -120,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?
@@ -137,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?
@@ -168,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?
*/
@@ -190,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?
@@ -215,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?
*/
@@ -245,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);
@@ -272,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);
@@ -304,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);
@@ -330,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);
@@ -358,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
*/
@@ -400,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);
@@ -426,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);
@@ -453,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
*/
@@ -495,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);
@@ -525,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);
@@ -552,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
*/
@@ -614,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);
@@ -665,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,
@@ -726,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);
@@ -755,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);
@@ -781,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);
@@ -800,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);
@@ -821,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, TValue *xparams, TValue obj);
+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
@@ -28,8 +28,11 @@
/* uses typep */
/* Helper for force */
-void do_handle_result(klisp_State *K, TValue *xparams, TValue obj)
+void do_handle_result(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: promise
*/
@@ -64,8 +67,12 @@ void do_handle_result(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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);
@@ -86,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);
@@ -96,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,15 +22,15 @@
/* 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, TValue *xparams, TValue obj);
+void do_handle_result(klisp_State *K);
/* init ground */
void kinit_promises_ground_env(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/kgvectors.c b/src/kgvectors.c
@@ -31,11 +31,11 @@
/* use ftypep */
/* (R7RS 3rd draft 6.3.6) make-vector */
-void make_vector(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void make_vector(klisp_State *K)
{
- UNUSED(xparams);
- UNUSED(denv);
+ klisp_assert(ttisenvironment(K->next_env));
+ TValue ptree = K->next_value;
+
bind_al1tp(K, ptree, "exact integer", keintegerp, tv_s, fill);
if (!get_opt_tpar(K, fill, "any", anytype))
fill = KINERT;
@@ -54,11 +54,11 @@ void make_vector(klisp_State *K, TValue *xparams, TValue ptree,
}
/* (R7RS 3rd draft 6.3.6) vector-length */
-void vector_length(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void vector_length(klisp_State *K)
{
- UNUSED(xparams);
- UNUSED(denv);
+ klisp_assert(ttisenvironment(K->next_env));
+ TValue ptree = K->next_value;
+
bind_1tp(K, ptree, "vector", ttisvector, vector);
TValue res = i2tv(kvector_length(vector));
@@ -66,10 +66,11 @@ void vector_length(klisp_State *K, TValue *xparams, TValue ptree,
}
/* (R7RS 3rd draft 6.3.6) vector-ref */
-void vector_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void vector_ref(klisp_State *K)
{
- UNUSED(xparams);
- UNUSED(denv);
+ klisp_assert(ttisenvironment(K->next_env));
+
+ TValue ptree = K->next_value;
bind_2tp(K, ptree, "vector", ttisvector, vector,
"exact integer", keintegerp, tv_i);
@@ -88,10 +89,11 @@ void vector_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
/* (R7RS 3rd draft 6.3.6) vector-set! */
-void vector_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void vector_setS(klisp_State *K)
{
- UNUSED(xparams);
- UNUSED(denv);
+ klisp_assert(ttisenvironment(K->next_env));
+
+ TValue ptree = K->next_value;
bind_3tp(K, ptree, "vector", ttisvector, vector,
"exact integer", keintegerp, tv_i, "any", anytype, tv_new_value);
@@ -117,15 +119,15 @@ void vector_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* (R7RS 3rd draft 6.3.6) vector-copy */
/* TEMP: at least for now this always returns mutable vectors */
-void vector_copy(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
+void vector_copy(klisp_State *K)
{
- UNUSED(xparams);
- UNUSED(denv);
+ klisp_assert(ttisenvironment(K->next_env));
+ TValue ptree = K->next_value;
+
bind_1tp(K, ptree, "vector", ttisvector, v);
- TValue new_vector = kvector_emptyp(v)
- ? v
+ TValue new_vector = kvector_emptyp(v)?
+ v
: kvector_new_bs_g(K, true, kvector_array(v), kvector_length(v));
kapply_cc(K, new_vector);
}
@@ -148,30 +150,30 @@ static TValue list_to_vector_h(klisp_State *K, const char *name, TValue ls)
}
/* (R7RS 3rd draft 6.3.6) vector */
-void vector(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void vector(klisp_State *K)
{
- UNUSED(xparams);
- UNUSED(denv);
+ klisp_assert(ttisenvironment(K->next_env));
+
+ TValue ptree = K->next_value;
kapply_cc(K, list_to_vector_h(K, "vector", ptree));
}
/* (R7RS 3rd draft 6.3.6) list->vector */
-void list_to_vector(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void list_to_vector(klisp_State *K)
{
- UNUSED(xparams);
- UNUSED(denv);
+ klisp_assert(ttisenvironment(K->next_env));
+
+ TValue ptree = K->next_value;
bind_1p(K, ptree, ls);
kapply_cc(K, list_to_vector_h(K, "list->vector", ls));
}
/* (R7RS 3rd draft 6.3.6) vector->list */
-void vector_to_list(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void vector_to_list(klisp_State *K)
{
- UNUSED(xparams);
- UNUSED(denv);
+ klisp_assert(ttisenvironment(K->next_env));
+
+ TValue ptree = K->next_value;
bind_1tp(K, ptree, "vector", ttisvector, v);
TValue tail = KNIL;
@@ -184,16 +186,16 @@ void vector_to_list(klisp_State *K, TValue *xparams,
}
/* ??.?.? vector->immutable-vector */
-void vector_to_immutable_vector(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
+void vector_to_immutable_vector(klisp_State *K)
{
- UNUSED(xparams);
- UNUSED(denv);
+ klisp_assert(ttisenvironment(K->next_env));
+
+ TValue ptree = K->next_value;
bind_1tp(K, ptree, "vector", ttisvector, v);
- TValue res = kvector_immutablep(v)
- ? v
- : kvector_new_bs_g(K, false, kvector_array(v), kvector_length(v));
+ TValue res = kvector_immutablep(v)?
+ v
+ : kvector_new_bs_g(K, false, kvector_array(v), kvector_length(v));
kapply_cc(K, res);
}
@@ -240,5 +242,4 @@ void kinit_vectors_ground_env(klisp_State *K)
/* ??.1.?? vector->immutable-vector */
add_applicative(K, ground_env, "vector->immutable-vector",
vector_to_immutable_vector, 0);
-
}
diff --git a/src/klisp.c b/src/klisp.c
@@ -154,8 +154,11 @@ static void print_version(void)
/* REFACTOR maybe these should be moved to a general place to be used
from any program */
-void do_str_eval(klisp_State *K, TValue *xparams, TValue obj)
+void do_str_eval(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: dynamic environment
*/
@@ -163,8 +166,11 @@ void do_str_eval(klisp_State *K, TValue *xparams, TValue obj)
ktail_eval(K, obj, denv);
}
-void do_str_read(klisp_State *K, TValue *xparams, TValue obj)
+void do_str_read(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: port
*/
@@ -189,9 +195,12 @@ void do_str_read(klisp_State *K, TValue *xparams, TValue obj)
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
*/
@@ -267,8 +276,11 @@ static int dostring (klisp_State *K, const char *s, const char *name)
return report(K, status);
}
-void do_file_eval(klisp_State *K, TValue *xparams, TValue obj)
+void do_file_eval(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: dynamic environment
*/
@@ -281,8 +293,11 @@ void do_file_eval(klisp_State *K, TValue *xparams, TValue obj)
kapply_cc(K, KINERT);
}
-void do_file_read(klisp_State *K, TValue *xparams, TValue obj)
+void do_file_read(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
UNUSED(obj);
TValue port = xparams[0];
/* read all file as a list (as immutable data) */
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/kread.c b/src/kread.c
@@ -150,7 +150,32 @@ void change_shared_def(klisp_State *K, TValue def_token, TValue value)
}
tail = kcdr(tail);
}
- /* NOTE: can't really happen */
+ klisp_assert(0); /* shouldn't happen */
+ return;
+}
+
+/* NOTE: the shared def is guaranteed to exist */
+void remove_shared_def(klisp_State *K, TValue def_token)
+{
+ /* IMPLEMENTATION RESTRICTION: only allow fixints in shared tokens */
+ int32_t ref_num = ivalue(kcdr(def_token));
+ TValue tail = K->shared_dict;
+ TValue last_pair = KNIL;
+ while (!ttisnil(tail)) {
+ TValue head = kcar(tail);
+ if (ref_num == ivalue(kcar(head))) {
+ if (ttisnil(last_pair)) {
+ /* this is the first value */
+ K->shared_dict = kcdr(tail);
+ } else {
+ kset_cdr(last_pair, kcdr(tail));
+ }
+ return;
+ }
+ last_pair = tail;
+ tail = kcdr(tail);
+ }
+ klisp_assert(0); /* shouldn't happen */
return;
}
@@ -202,10 +227,15 @@ TValue kread_fsm(klisp_State *K, bool listp)
TValue obj_si = KNIL; /* put some value for gc */
int32_t sexp_comments = 0;
TValue last_sexp_comment_si = KNIL; /* put some value for gc */
+ /* list of shared list, each element represent a nested sexp comment,
+ each is a list of shared defs in that particular level, to be
+ undefined after the sexp comment ends */
+ TValue sexp_comment_shared = KNIL;
krooted_vars_push(K, &obj);
krooted_vars_push(K, &obj_si);
krooted_vars_push(K, &last_sexp_comment_si);
+ krooted_vars_push(K, &sexp_comment_shared);
while (!(get_state(K) == ST_READ && !read_next_token)) {
if (read_next_token) {
@@ -373,7 +403,13 @@ TValue kread_fsm(klisp_State *K, bool listp)
default: {
krooted_tvs_push(K, tok);
try_shared_def(K, tok, KNIL);
- /* token ok, read defined object */
+ /* token ok */
+ /* save the token for later undefining */
+ if (sexp_comments > 0) {
+ kset_car(sexp_comment_shared,
+ kcons(K, tok, kcar(sexp_comment_shared)));
+ }
+ /* read defined object */
/* NOTE: save the source info to return it
after the defined object is read */
TValue si = ktok_get_source_info(K);
@@ -413,6 +449,8 @@ TValue kread_fsm(klisp_State *K, bool listp)
case ';': { /* sexp comment */
klisp_assert(sexp_comments < 1000);
++sexp_comments;
+ sexp_comment_shared =
+ kcons(K, KNIL, sexp_comment_shared);
push_data(K, last_sexp_comment_si);
push_state(K, ST_SEXP_COMMENT);
last_sexp_comment_si = ktok_get_source_info(K);
@@ -599,6 +637,14 @@ TValue kread_fsm(klisp_State *K, bool listp)
case ST_SEXP_COMMENT:
klisp_assert(sexp_comments > 0);
--sexp_comments;
+ /* undefine all shared obj defined in the context
+ of this sexp comment */
+ while(!ttisnil(kcar(sexp_comment_shared))) {
+ TValue first = kcaar(sexp_comment_shared);
+ remove_shared_def(K, first);
+ kset_car(sexp_comment_shared, kcdar(sexp_comment_shared));
+ }
+ sexp_comment_shared = kcdr(sexp_comment_shared);
pop_state(K);
last_sexp_comment_si = get_data(K);
pop_data(K);
@@ -616,6 +662,7 @@ TValue kread_fsm(klisp_State *K, bool listp)
krooted_vars_pop(K);
krooted_vars_pop(K);
krooted_vars_pop(K);
+ krooted_vars_pop(K);
pop_state(K);
klisp_assert(ks_sisempty(K));
diff --git a/src/krepl.c b/src/krepl.c
@@ -28,8 +28,11 @@
/* TODO add names & source info to the repl continuations */
/* the underlying function of the read cont */
-void do_repl_read(klisp_State *K, TValue *xparams, TValue obj)
+void do_repl_read(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
UNUSED(xparams);
UNUSED(obj);
@@ -50,8 +53,11 @@ void do_repl_read(klisp_State *K, TValue *xparams, TValue obj)
}
/* the underlying function of the eval cont */
-void do_repl_eval(klisp_State *K, TValue *xparams, TValue obj)
+void do_repl_eval(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: dynamic environment
*/
@@ -76,9 +82,8 @@ void do_repl_eval(klisp_State *K, TValue *xparams, TValue obj)
}
}
-void do_repl_loop(klisp_State *K, TValue *xparams, TValue obj);
-void do_int_repl_error(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
+void do_repl_loop(klisp_State *K);
+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 */
@@ -128,8 +133,11 @@ void create_loop(klisp_State *K, TValue denv)
}
/* the underlying function of the write & loop cont */
-void do_repl_loop(klisp_State *K, TValue *xparams, TValue obj)
+void do_repl_loop(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: dynamic environment
*/
@@ -146,9 +154,12 @@ void do_repl_loop(klisp_State *K, TValue *xparams, TValue obj)
}
/* 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/krepl.h b/src/krepl.h
@@ -14,10 +14,10 @@
void kinit_repl(klisp_State *K);
/* continuation functions */
-void do_repl_exit(klisp_State *K, TValue *xparams, TValue obj);
-void do_repl_read(klisp_State *K, TValue *xparams, TValue obj);
-void do_repl_eval(klisp_State *K, TValue *xparams, TValue obj);
-void do_repl_loop(klisp_State *K, TValue *xparams, TValue obj);
-void do_repl_error(klisp_State *K, TValue *xparams, TValue obj);
+void do_repl_exit(klisp_State *K);
+void do_repl_read(klisp_State *K);
+void do_repl_eval(klisp_State *K);
+void do_repl_loop(klisp_State *K);
+void do_repl_error(klisp_State *K);
#endif
diff --git a/src/kscript.c b/src/kscript.c
@@ -42,8 +42,11 @@ static inline TValue krooted_tvs_pass_si(klisp_State *K, TValue v, TValue si)
#endif
/* the exit continuation, it exits the loop */
-void do_script_exit(klisp_State *K, TValue *xparams, TValue obj)
+void do_script_exit(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
UNUSED(xparams);
/* save exit code */
@@ -68,12 +71,15 @@ void do_script_exit(klisp_State *K, TValue *xparams, TValue obj)
/* the underlying function of the error cont */
-void do_script_error(klisp_State *K, TValue *xparams, TValue obj)
+void do_script_error(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]: dynamic environment
*/
-
+ UNUSED(xparams);
/* FOR NOW used only for irritant list */
TValue port = kcdr(K->kd_error_port_key);
klisp_assert(kfport_file(port) == stderr);
diff --git a/src/kscript.h b/src/kscript.h
@@ -15,8 +15,8 @@
void kinit_script(klisp_State *K, int argc, char *argv[]);
/* continuation functions */
-void do_script_exit(klisp_State *K, TValue *xparams, TValue obj);
-void do_script_error(klisp_State *K, TValue *xparams, TValue obj);
+void do_script_exit(klisp_State *K);
+void do_script_error(klisp_State *K);
/* default exit code in case of error according to SRFI-22 */
diff --git a/src/kstate.c b/src/kstate.c
@@ -282,8 +282,11 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
/*
** Root and Error continuations
*/
-void do_root_exit(klisp_State *K, TValue *xparams, TValue obj)
+void do_root_exit(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
UNUSED(xparams);
/* Just save the value and end the loop */
@@ -292,8 +295,11 @@ void do_root_exit(klisp_State *K, TValue *xparams, TValue obj)
return;
}
-void do_error_exit(klisp_State *K, TValue *xparams, TValue obj)
+void do_error_exit(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
UNUSED(xparams);
/* TEMP Just pass the error to the root continuation */
@@ -503,16 +509,23 @@ 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() */
kcall_cont(K, cont, ptree);
}
-void do_interception(klisp_State *K, TValue *xparams, TValue obj)
+void do_interception(klisp_State *K)
{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
/*
** xparams[0]:
** xparams[1]: dst cont
@@ -600,15 +613,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, K->next_xparams, K->next_value);
- } 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;
@@ -352,14 +358,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, TValue *ud, TValue val);
-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)
@@ -472,6 +470,7 @@ inline void klispS_tail_call_si(klisp_State *K, TValue top, TValue ptree,
K->next_func = op->fn;
K->next_value = ptree;
/* NOTE: this is what differentiates a tail call from a return */
+ klisp_assert(ttisenvironment(env));
K->next_env = env;
K->next_xparams = op->extra;
K->next_si = si;
@@ -494,17 +493,17 @@ inline void klispS_tail_call_si(klisp_State *K, TValue top, TValue ptree,
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);
void klisp_close (klisp_State *K);
-void do_interception(klisp_State *K, TValue *xparams, TValue obj);
+void do_interception(klisp_State *K);
/* for root and error continuations */
-void do_root_exit(klisp_State *K, TValue *xparams, TValue obj);
-void do_error_exit(klisp_State *K, TValue *xparams, TValue obj);
+void do_root_exit(klisp_State *K);
+void do_error_exit(klisp_State *K);
/* simple accessors for dynamic keys */
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
diff --git a/src/tests/vectors.k b/src/tests/vectors.k
@@ -88,9 +88,9 @@
;; (R7RS 3rd draft, section 6.3.6) vector-copy
;; TODO: implement equal? for vectors first
-;; XXX bytevector->immutable-bytevector
+;; XXX vector->immutable-vector
-($check-predicate (applicative? bytevector->immutable-bytevector))
+($check-predicate (applicative? vector->immutable-vector))
($check-predicate
(immutable-vector? (vector->immutable-vector (vector 1 2))))
