klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

commit 82045a3e8dce30c1102dfa23eb42bf3ebd2b1a50
parent 1a607a12a0b55b476adba3d5c8bf695d54a39be4
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 23 Nov 2011 05:26:07 -0300

Merged changes from refactor

Diffstat:
Msrc/kcontinuation.c | 2+-
Msrc/kcontinuation.h | 2+-
Msrc/keval.c | 25+++++++++++++++++++------
Msrc/keval.h | 6+++---
Msrc/kgbooleans.c | 29++++++++++++++++++++++++-----
Msrc/kgbooleans.h | 10+++++-----
Msrc/kgbytevectors.c | 63+++++++++++++++++++++++++++++++++++++++++++++------------------
Msrc/kgbytevectors.h | 27+++++++++------------------
Msrc/kgchars.c | 28++++++++++++++++++++--------
Msrc/kgchars.h | 12++++--------
Msrc/kgcombiners.c | 80+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------
Msrc/kgcombiners.h | 23+++++++++++------------
Msrc/kgcontinuations.c | 68+++++++++++++++++++++++++++++++++++++++++++++++++++-----------------
Msrc/kgcontinuations.h | 27++++++++++-----------------
Msrc/kgcontrol.c | 51+++++++++++++++++++++++++++++++++++++++++----------
Msrc/kgcontrol.h | 16++++++++--------
Msrc/kgencapsulations.c | 25++++++++++++++++++++-----
Msrc/kgencapsulations.h | 5++---
Msrc/kgenv_mut.c | 39++++++++++++++++++++++++++++++++-------
Msrc/kgenv_mut.h | 14+++++++-------
Msrc/kgenvironments.c | 108++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----------------
Msrc/kgenvironments.h | 41++++++++++++++++++-----------------------
Msrc/kgeqp.c | 6+++++-
Msrc/kgeqp.h | 2+-
Msrc/kgequalp.c | 6+++++-
Msrc/kgequalp.h | 2+-
Msrc/kgerror.c | 26+++++++++++++++++++-------
Msrc/kgffi.c | 118++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------
Msrc/kgffi.h | 3+--
Msrc/kghelpers.c | 35+++++++++++++++++++++++++++++------
Msrc/kghelpers.h | 12++++++------
Msrc/kgkd_vars.c | 33++++++++++++++++++++++++---------
Msrc/kgkd_vars.h | 11++++-------
Msrc/kgks_vars.c | 21+++++++++++++++------
Msrc/kgks_vars.h | 3+--
Msrc/kgnumbers.c | 209+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------
Msrc/kgnumbers.h | 71++++++++++++++++++++++++++++++-----------------------------------------
Msrc/kgpair_mut.c | 48++++++++++++++++++++++++++++++++++++++----------
Msrc/kgpair_mut.h | 16+++++++---------
Msrc/kgpairs_lists.c | 149+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------
Msrc/kgpairs_lists.h | 57+++++++++++++++++++++++++++------------------------------
Msrc/kgports.c | 164+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------
Msrc/kgports.h | 49++++++++++++++++++++++---------------------------
Msrc/kgpromises.c | 23+++++++++++++++++++----
Msrc/kgpromises.h | 8++++----
Msrc/kgstrings.c | 77++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----------------
Msrc/kgstrings.h | 29++++++++++++-----------------
Msrc/kgsymbols.c | 14++++++++++----
Msrc/kgsymbols.h | 6++----
Msrc/kgsystem.c | 33+++++++++++++++++++++++++++------
Msrc/kgsystem.h | 6++----
Msrc/kgvectors.c | 81++++++++++++++++++++++++++++++++++++++++---------------------------------------
Msrc/klisp.c | 27+++++++++++++++++++++------
Msrc/koperative.c | 2+-
Msrc/koperative.h | 3++-
Msrc/kread.c | 51+++++++++++++++++++++++++++++++++++++++++++++++++--
Msrc/krepl.c | 27+++++++++++++++++++--------
Msrc/krepl.h | 10+++++-----
Msrc/kscript.c | 12+++++++++---
Msrc/kscript.h | 4++--
Msrc/kstate.c | 33++++++++++++++++++++-------------
Msrc/kstate.h | 31+++++++++++++++----------------
Asrc/rep_op_c.sed | 78++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Asrc/rep_op_h.sed | 32++++++++++++++++++++++++++++++++
Msrc/tests/vectors.k | 4++--
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))))