commit 284712943f8c46e8709e91f78da2365d3aa61ff9
parent 7b1baf7ba55e0be06ec609b7614d2091aceac676
Author: Andres Navarro <canavarro82@gmail.com>
Date: Tue, 22 Nov 2011 15:42:24 -0300
Refactored Cfunc to only take a klisp_State pointer, xparams and obj are taken from there.
Diffstat:
35 files changed, 320 insertions(+), 103 deletions(-)
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
diff --git a/src/keval.h b/src/keval.h
@@ -12,7 +12,7 @@
#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 do_eval_ls(klisp_State *K);
+void do_combine(klisp_State *K);
#endif
diff --git a/src/kgbooleans.c b/src/kgbooleans.c
@@ -90,8 +90,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
diff --git a/src/kgbooleans.h b/src/kgbooleans.h
@@ -31,7 +31,7 @@ void andp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
void orp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
/* Helpers for $and? & $or? */
-void do_Sandp_Sorp(klisp_State *K, TValue *xparams, TValue obj);
+void do_Sandp_Sorp(klisp_State *K);
void Sandp_Sorp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
/* 6.1.4 $and? */
diff --git a/src/kgcombiners.c b/src/kgcombiners.c
@@ -411,8 +411,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 +430,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 +456,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 +508,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)
diff --git a/src/kgcombiners.h b/src/kgcombiners.h
@@ -79,10 +79,10 @@ 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_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
@@ -38,8 +38,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
@@ -80,8 +83,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);
}
diff --git a/src/kgcontinuations.h b/src/kgcontinuations.h
@@ -19,7 +19,7 @@
#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 */
@@ -61,7 +61,7 @@ void guard_dynamic_extent(klisp_State *K, TValue *xparams, TValue ptree,
void kgexit(klisp_State *K, TValue *xparams, TValue ptree,
TValue denv);
-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,7 +26,7 @@
/* 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)
@@ -48,8 +48,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
@@ -98,9 +101,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 +207,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
@@ -289,8 +301,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
diff --git a/src/kgcontrol.h b/src/kgcontrol.h
@@ -39,10 +39,10 @@ void Scond(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
/* 6.9.1 for-each */
void for_each(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
-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/kgenv_mut.c b/src/kgenv_mut.c
@@ -45,8 +45,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
@@ -82,8 +85,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 +175,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
diff --git a/src/kgenv_mut.h b/src/kgenv_mut.h
@@ -21,7 +21,7 @@
/* 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);
@@ -238,11 +238,11 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree,
void SsetB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
/* 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);
diff --git a/src/kgenvironments.c b/src/kgenvironments.c
@@ -156,8 +156,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
@@ -248,8 +251,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
@@ -456,8 +462,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
@@ -576,8 +585,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 +601,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
diff --git a/src/kgenvironments.h b/src/kgenvironments.h
@@ -39,7 +39,7 @@ TValue split_check_let_bindings(klisp_State *K, char *name, TValue bindings,
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);
/* 6.7.1 $binds? */
void Sbindsp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
@@ -62,7 +62,7 @@ void Sletrec(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
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);
/* 6.7.7 $let-redirect */
void Slet_redirect(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
@@ -74,16 +74,16 @@ void Slet_safe(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
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);
/* 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 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/kgerror.c b/src/kgerror.c
@@ -49,8 +49,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
@@ -699,9 +699,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)
@@ -764,8 +766,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)
diff --git a/src/kghelpers.c b/src/kghelpers.c
@@ -301,8 +301,11 @@ int32_t check_list(klisp_State *K, 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
@@ -399,7 +399,7 @@ void ftyped_kbpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
** 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
@@ -51,8 +51,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
diff --git a/src/kgkd_vars.h b/src/kgkd_vars.h
@@ -28,7 +28,7 @@ void do_access(klisp_State *K, TValue *xparams, TValue ptree,
void make_keyed_dynamic_variable(klisp_State *K, TValue *xparams,
TValue ptree, TValue denv);
-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/kgpairs_lists.c b/src/kgpairs_lists.c
@@ -103,7 +103,7 @@ 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, TValue ptree, TValue denv)
{
/*
@@ -469,8 +469,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 +490,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 +524,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 +574,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)
@@ -746,10 +758,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 +798,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 +817,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 +839,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 +903,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
diff --git a/src/kgpairs_lists.h b/src/kgpairs_lists.h
@@ -35,7 +35,7 @@ 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, TValue ptree, TValue denv);
/* Helper macros to construct xparams[1] for c[ad]{1,4}r */
#define C_AD_R_PARAM(len_, br_) \
@@ -87,15 +87,15 @@ void countable_listp(klisp_State *K, TValue *xparams, TValue ptree,
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 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
*/
diff --git a/src/kgports.h b/src/kgports.h
@@ -105,7 +105,7 @@ 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 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);
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
*/
diff --git a/src/kgpromises.h b/src/kgpromises.h
@@ -30,7 +30,7 @@ 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 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/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
*/
@@ -267,8 +273,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 +290,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/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,7 +82,7 @@ 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_loop(klisp_State *K);
void do_int_repl_error(klisp_State *K, TValue *xparams, TValue ptree,
TValue denv);
@@ -128,8 +134,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
*/
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
@@ -277,8 +277,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 */
@@ -287,8 +290,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 */
@@ -506,8 +512,11 @@ void cont_app(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
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
@@ -598,7 +607,7 @@ void klispS_run(klisp_State *K)
if (ttisnil(K->next_env)) {
/* continuation application */
klisp_Cfunc fn = (klisp_Cfunc) K->next_func;
- (*fn)(K, K->next_xparams, K->next_value);
+ (*fn)(K);
} else {
/* operative calling */
klisp_Ofunc fn = (klisp_Ofunc) K->next_func;
diff --git a/src/kstate.h b/src/kstate.h
@@ -352,7 +352,7 @@ inline void krooted_vars_clear(klisp_State *K) { K->rooted_vars_top = 0; }
** prototypes for underlying c functions of continuations &
** operatives
*/
-typedef void (*klisp_Cfunc) (klisp_State*K, TValue *ud, TValue val);
+typedef void (*klisp_Cfunc) (klisp_State *K);
typedef void (*klisp_Ofunc) (klisp_State *K, TValue *ud, TValue ptree,
TValue env);
@@ -496,11 +496,11 @@ 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_cont_c.sed b/src/rep_cont_c.sed
@@ -0,0 +1,43 @@
+# This is a collection of sed commands to refactor continuation underlying
+# functions to just take a kernel state pointer (instead of also taking extra
+# params and value object.
+
+# All these tests are run one at a time with sed -n
+
+# detect lonely parens
+# /[(] /P
+# none remaining
+
+# detect klisp_State pointer without open parens on the same line
+# /[^(]klisp_State \*K, /P
+# none remaining
+
+# detect single line function definition (trailing ;)
+# There are 3
+#/[(]klisp_State \*K, TValue \*xparams, TValue obj[)];/P
+# use the rep_cont_h.sed script to replace them
+# There are 0 now
+
+# detect single line function definition (no trailing ;)
+#/[(]klisp_State \*K, TValue \*xparams, TValue obj[)]/P
+# There are 48, that is one for each of the 3 we just did, 44 for
+# the ones defined in .h and probably 1 with no definition
+
+# All are single line, detect them with the opening brace
+#/[(]klisp_State \*K, TValue \*xparams, TValue obj[)]/{
+#N
+#/[(]klisp_State \*K, TValue \*xparams, TValue obj[)].*\n[{]/P
+#}
+
+# All function definition are one line, just replace them in the .c
+# This is used to modify in place with sed -i -f <this-file> *.c
+# The only problem was do_ffi_callback_decode_arguments (was two lines)
+/[(]klisp_State \*K, TValue \*xparams, TValue obj[)]/{
+N
+s/^void \(.*\)[(]klisp_State \*K, TValue \*xparams, TValue obj[)].*\n[{]/void \1(klisp_State *K)\
+\{\
+ TValue *xparams = K->next_xparams;\
+ TValue obj = K->next_value;\
+ klisp_assert(ttisnil(K->next_env));/
+}
+
diff --git a/src/rep_cont_h.sed b/src/rep_cont_h.sed
@@ -0,0 +1,25 @@
+# This is a collection of sed commands to refactor continuation underlying
+# functions to just take a kernel state pointer (instead of also taking extra
+# params and value object.
+
+# All these tests are run one at a time with sed -n
+
+# detect lonely parens
+# /[(] /P
+# none remaining
+
+# detect klisp_State pointer without open parens on the same line
+# /[^(]klisp_State \*K, /P
+# none remaining
+
+# detect single line function definition
+# There are 44, all starting with do_
+#/[(]klisp_State \*K, TValue \*xparams, TValue obj[)];/P
+
+#detect functions names starting with do_
+# There are 47, do_access, do_bind and do_vau are not continuation
+#/void do_/P
+
+# All function definition are one line, just replace them in the .h
+# This is used to modify in place with sed -i -f <this-file> *.h
+s/^void \(.*\)[(]klisp_State \*K, TValue \*xparams, TValue obj[)];/void \1(klisp_State *K);/
