commit f92b211ba3c24d8385a9f053a1d81c2042485515
parent aadfff628e6096cc7954dbd621d1aa582da7dbb4
Author: Andres Navarro <canavarro82@gmail.com>
Date: Sat, 16 Apr 2011 10:23:45 -0300
Removed si & name params from kmake_applicative & kmake_operative. Both now assumed all their arguments are rooted. Made kmake_applicative shorthand for (kwrap (kmake_operative ...)).
Diffstat:
15 files changed, 60 insertions(+), 86 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -70,7 +70,7 @@ kcontinuation.o: kcontinuation.c kcontinuation.h kmem.h kstate.h kobject.h \
koperative.o: koperative.c koperative.h kmem.h kstate.h kobject.h \
klisp.h kgc.h
kapplicative.o: kapplicative.c kapplicative.h kmem.h kstate.h kobject.h \
- klisp.h kgc.h
+ klisp.h kgc.h koperative.h
kencapsulation.o: kencapsulation.c kencapsulation.h kmem.h kstate.h kobject.h \
klisp.h kpair.h kgc.h
kpromise.o: kpromise.c kpromise.h kmem.h kstate.h kobject.h \
diff --git a/src/kapplicative.c b/src/kapplicative.c
@@ -10,28 +10,17 @@
#include "kmem.h"
#include "kgc.h"
+/* GC: Assumes underlying is rooted */
TValue kwrap(klisp_State *K, TValue underlying)
{
- return kmake_applicative(K, KNIL, KNIL, underlying);
-}
-
-TValue kmake_applicative(klisp_State *K, TValue name, TValue si,
- TValue underlying)
-{
- krooted_tvs_push(K, name);
- krooted_tvs_push(K, si);
- krooted_tvs_push(K, underlying);
Applicative *new_app = klispM_new(K, Applicative);
- krooted_tvs_pop(K);
- krooted_tvs_pop(K);
- krooted_tvs_pop(K);
/* header + gc_fields */
klispC_link(K, (GCObject *) new_app, K_TAPPLICATIVE, 0);
/* applicative specific fields */
- new_app->name = name;
- new_app->si = si;
+ new_app->name = KNIL;
+ new_app->si = KNIL;
new_app->underlying = underlying;
return gc2app(new_app);
}
diff --git a/src/kapplicative.h b/src/kapplicative.h
@@ -9,9 +9,20 @@
#include "kobject.h"
#include "kstate.h"
+#include "koperative.h"
+/* GC: Assumes underlying is rooted */
TValue kwrap(klisp_State *K, TValue underlying);
-TValue kmake_applicative(klisp_State *K, TValue name, TValue si,
- TValue underlying);
-#define kunwrap(app_) (tv2app(app_)->underlying)
+
+/* GC: Assumes all argps are rooted */
+#define kmake_applicative(K_, ...) \
+ ({ klisp_State *K__ = (K_); \
+ TValue op = kmake_operative(K__, __VA_ARGS__); \
+ krooted_tvs_push(K__, op); \
+ TValue app = kwrap(K__, op); \
+ krooted_tvs_pop(K__); \
+ (app); })
+
+inline TValue kunwrap(TValue app) { return (tv2app(app)->underlying); }
+
#endif
diff --git a/src/kenvironment.h b/src/kenvironment.h
@@ -10,12 +10,14 @@
#include "kobject.h"
#include "kstate.h"
+/* GC: Assumes parents is rooted */
TValue kmake_environment(klisp_State *K, TValue parents);
#define kmake_empty_environment(kst_) (kmake_environment(kst_, KNIL))
void kadd_binding(klisp_State *K, TValue env, TValue sym, TValue val);
TValue kget_binding(klisp_State *K, TValue env, TValue sym);
bool kbinds(klisp_State *K, TValue env, TValue sym);
/* keyed dynamic vars */
+/* GC: Assumes parents, key & val are rooted */
TValue kmake_keyed_static_env(klisp_State *K, TValue parent, TValue key,
TValue val);
TValue kget_keyed_static_var(klisp_State *K, TValue env, TValue key);
diff --git a/src/kgcombiners.c b/src/kgcombiners.c
@@ -45,16 +45,18 @@ void Svau(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* The ptree & body are copied to avoid mutation */
vptree = check_copy_ptree(K, "$vau", vptree, vpenv);
- /* GC: root ptree while body is being copied */
- krooted_tvs_push(K, vptree); /* make op will protect it now */
+ krooted_tvs_push(K, vptree);
/* the body should be a list */
UNUSED(check_list(K, "$vau", true, vbody, NULL));
vbody = copy_es_immutable_h(K, "$vau", vbody, false);
+
+ krooted_tvs_push(K, vbody);
- krooted_tvs_pop(K); /* make op will protect it now */
+ TValue new_op = kmake_operative(K, do_vau, 4, vptree, vpenv, vbody, denv);
- TValue new_op = make_operative(K, do_vau, 4, vptree, vpenv, vbody, denv);
+ krooted_tvs_pop(K);
+ krooted_tvs_pop(K);
kapply_cc(K, new_op);
}
@@ -134,8 +136,8 @@ void Slambda(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
(void)check_list(K, "$lambda", true, vbody, &dummy);
vbody = copy_es_immutable_h(K, "$lambda", vbody, false);
- TValue new_app = make_applicative(K, do_vau, 4, vptree, KIGNORE, vbody,
- denv);
+ TValue new_app = kmake_applicative(K, do_vau, 4, vptree, KIGNORE, vbody,
+ denv);
kapply_cc(K, new_app);
}
diff --git a/src/kgcontinuations.c b/src/kgcontinuations.c
@@ -191,7 +191,7 @@ void continuation_applicative(klisp_State *K, TValue *xparams, TValue ptree,
bind_1tp(K, "continuation->applicative", ptree, "continuation",
ttiscontinuation, cont);
/* cont_app is from kstate */
- TValue app = make_applicative(K, cont_app, 1, cont);
+ TValue app = kmake_applicative(K, cont_app, 1, cont);
kapply_cc(K, app);
}
diff --git a/src/kgencapsulations.c b/src/kgencapsulations.c
@@ -95,9 +95,9 @@ void make_encapsulation_type(klisp_State *K, TValue *xparams, TValue ptree,
/* GC: root intermediate values & pairs */
TValue key = kmake_encapsulation_key(K);
- TValue e = make_applicative(K, enc_wrap, 1, key);
- TValue p = make_applicative(K, enc_typep, 1, key);
- TValue d = make_applicative(K, enc_unwrap, 1, key);
+ TValue e = kmake_applicative(K, enc_wrap, 1, key);
+ TValue p = kmake_applicative(K, enc_typep, 1, key);
+ TValue d = kmake_applicative(K, enc_unwrap, 1, key);
TValue ls = kcons(K, e, kcons(K, p, kcons(K, d, KNIL)));
kapply_cc(K, ls);
diff --git a/src/kghelpers.h b/src/kghelpers.h
@@ -219,12 +219,6 @@ inline bool get_opt_tpar(klisp_State *K, char *name, int32_t type, TValue *par)
}
-/* TODO: add name and source info */
-#define make_operative(K_, fn_, ...) \
- kmake_operative(K_, KNIL, KNIL, fn_, __VA_ARGS__)
-#define make_applicative(K_, fn_, ...) \
- kwrap(K_, kmake_operative(K_, KNIL, KNIL, fn_, __VA_ARGS__))
-
/*
** This states are useful for traversing trees, saving the state in the
** token char buffer
diff --git a/src/kgkd_vars.c b/src/kgkd_vars.c
@@ -104,9 +104,9 @@ inline TValue make_bind_continuation(klisp_State *K, TValue key,
old_value);
/* create the guards to guarantee that the values remain consistent on
abnormal passes (in both directions) */
- TValue exit_int = kmake_operative(K, KNIL, KNIL, do_set_pass,
+ TValue exit_int = kmake_operative(K, do_set_pass,
3, key, old_flag, old_value);
- TValue entry_int = kmake_operative(K, KNIL, KNIL, do_set_pass,
+ TValue entry_int = kmake_operative(K, do_set_pass,
3, key, new_flag, new_value);
TValue exit_guard = kcons(K, K->root_cont, exit_int);
TValue exit_guards = kcons(K, exit_guard, KNIL);
@@ -161,8 +161,8 @@ void make_keyed_dynamic_variable(klisp_State *K, TValue *xparams,
check_0p(K, "make-keyed-dynamic-variable", ptree);
TValue key = kcons(K, KFALSE, KINERT);
- TValue a = kwrap(K, kmake_operative(K, KNIL, KNIL, do_access, 1, key));
- TValue b = kwrap(K, kmake_operative(K, KNIL, KNIL, do_bind, 1, key));
+ TValue a = kmake_applicative(K, do_access, 1, key);
+ TValue b = kmake_applicative(K, do_bind, 1, key);
TValue ls = kcons(K, b, kcons(K, a, KNIL));
kapply_cc(K, ls);
}
diff --git a/src/kgks_vars.c b/src/kgks_vars.c
@@ -65,8 +65,8 @@ void make_keyed_static_variable(klisp_State *K, TValue *xparams,
check_0p(K, "make-keyed-static-variable", ptree);
/* the key is just a dummy pair */
TValue key = kcons(K, KINERT, KINERT);
- TValue a = kwrap(K, kmake_operative(K, KNIL, KNIL, do_sv_access, 1, key));
- TValue b = kwrap(K, kmake_operative(K, KNIL, KNIL, do_sv_bind, 1, key));
+ TValue a = kmake_applicative(K, do_sv_access, 1, key);
+ TValue b = kmake_applicative(K, do_sv_bind, 1, key);
TValue ls = kcons(K, b, kcons(K, a, KNIL));
kapply_cc(K, ls);
}
diff --git a/src/kgports.c b/src/kgports.c
@@ -72,7 +72,7 @@ void with_file(klisp_State *K, TValue *xparams, TValue ptree,
do_close_file_ret, 1, new_port);
kset_cc(K, new_cont);
- TValue op = kmake_operative(K, KNIL, KNIL, do_bind, 1, key);
+ TValue op = kmake_operative(K, do_bind, 1, key);
TValue args = kcons(K, new_port, kcons(K, comb, KNIL));
/* even if we call with denv, do_bind calls comb in an empty env */
ktail_call(K, op, args, denv);
@@ -413,7 +413,7 @@ void do_int_close_file(klisp_State *K, TValue *xparams, TValue ptree,
TValue make_guarded_read_cont(klisp_State *K, TValue parent, TValue port)
{
/* create the guard to close file after read errors */
- TValue exit_int = kmake_operative(K, KNIL, KNIL, do_int_close_file,
+ TValue exit_int = kmake_operative(K, do_int_close_file,
1, port);
TValue exit_guard = kcons(K, K->error_cont, exit_int);
TValue exit_guards = kcons(K, exit_guard, KNIL);
diff --git a/src/kground.c b/src/kground.c
@@ -44,6 +44,7 @@
** BEWARE: this is highly unhygienic, it assumes variables "symbol" and
** "value", both of type TValue. symbol will be bound to a symbol named by
** "n_" and can be referrenced in the var_args
+** GC: All of these assume that the extra args are rooted
*/
/* Right now all symbols are rooted, but when possible, they will
@@ -52,19 +53,19 @@
#define add_operative(K_, env_, n_, fn_, ...) \
{ symbol = ksymbol_new(K_, n_); \
krooted_tvs_push(K_, symbol); \
- value = make_operative(K_, fn_, __VA_ARGS__); \
+ value = kmake_operative(K_, fn_, __VA_ARGS__); \
krooted_tvs_push(K_, value); \
kadd_binding(K_, env_, symbol, value); \
krooted_tvs_pop(K_); \
krooted_tvs_pop(K_); }
-#define add_applicative(K_, env_, n_, fn_, ...) \
- { symbol = ksymbol_new(K_, n_); \
- krooted_tvs_push(K_, symbol); \
- value = make_applicative(K_, fn_, __VA_ARGS__); \
- krooted_tvs_push(K_, value); \
- kadd_binding(K_, env_, symbol, value); \
- krooted_tvs_pop(K_); \
+#define add_applicative(K_, env_, n_, fn_, ...) \
+ { symbol = ksymbol_new(K_, n_); \
+ krooted_tvs_push(K_, symbol); \
+ value = kmake_applicative(K_, fn_, __VA_ARGS__); \
+ krooted_tvs_push(K_, value); \
+ kadd_binding(K_, env_, symbol, value); \
+ krooted_tvs_pop(K_); \
krooted_tvs_pop(K_); }
#define add_value(K_, env_, n_, v_) \
diff --git a/src/koperative.c b/src/koperative.c
@@ -12,46 +12,20 @@
#include "kmem.h"
#include "kgc.h"
-/* should be at least < GC_PROTECT_SIZE - 3 */
-#define OP_MAX_ARGS 16
-
-TValue kmake_operative(klisp_State *K, TValue name, TValue si,
- klisp_Ofunc fn, int32_t xcount, ...)
+/* GC: Assumes all argps are rooted */
+TValue kmake_operative(klisp_State *K, klisp_Ofunc fn, int32_t xcount, ...)
{
va_list argp;
- klisp_assert(xcount < OP_MAX_ARGS);
-
- TValue args[OP_MAX_ARGS];
- va_start(argp, xcount);
- for (int i = 0; i < xcount; i++) {
- TValue val = va_arg(argp, TValue);
- krooted_tvs_push(K, val);
- args[i] = val;
- }
- va_end(argp);
-
- krooted_tvs_push(K, name);
- krooted_tvs_push(K, si);
-
Operative *new_op = (Operative *)
klispM_malloc(K, sizeof(Operative) + sizeof(TValue) * xcount);
- for (int i = 0; i < xcount; i++) {
- TValue val = args[i];
- new_op->extra[i] = val;
- krooted_tvs_pop(K);
- }
-
- krooted_tvs_pop(K);
- krooted_tvs_pop(K);
-
/* header + gc_fields */
klispC_link(K, (GCObject *) new_op, K_TOPERATIVE, 0);
/* operative specific fields */
- new_op->name = name;
- new_op->si = si;
+ new_op->name = KNIL;
+ new_op->si = KNIL;
new_op->fn = fn;
new_op->extra_size = xcount;
@@ -60,5 +34,6 @@ TValue kmake_operative(klisp_State *K, TValue name, TValue si,
new_op->extra[i] = va_arg(argp, TValue);
}
va_end(argp);
+
return gc2op(new_op);
}
diff --git a/src/koperative.h b/src/koperative.h
@@ -11,7 +11,8 @@
#include "kstate.h"
/* TODO: make some specialized constructors for 0, 1 and 2 parameters */
-TValue kmake_operative(klisp_State *K, TValue name, TValue si,
- klisp_Ofunc fn, int xcount, ...);
+
+/* GC: Assumes all argps are rooted */
+TValue kmake_operative(klisp_State *K, klisp_Ofunc fn, int xcount, ...);
#endif
diff --git a/src/kstate.c b/src/kstate.c
@@ -168,8 +168,8 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
K->kd_out_port_key = kcons(K, KTRUE, out_port);
/* create the ground environment and the eval operative */
- K->eval_op = kmake_operative(K, KNIL, KNIL, keval_ofn, 0);
- K->list_app = kwrap(K, kmake_operative(K, KNIL, KNIL, list, 0));
+ K->eval_op = kmake_operative(K, keval_ofn, 0);
+ K->list_app = kmake_applicative(K, list, 0);
K->ground_env = kmake_empty_environment(K);
K->module_params_sym = ksymbol_new(K, "module-parameters");
@@ -404,8 +404,7 @@ void do_interception(klisp_State *K, TValue *xparams, TValue obj)
TValue op = kcar(first);
TValue outer = kcadr(first);
TValue denv = kcddr(first);
- TValue app = kwrap(K, kmake_operative(K, KNIL, KNIL,
- cont_app, 1, outer));
+ TValue app = kmake_applicative(K, cont_app, 1, outer);
TValue ptree = kcons(K, obj, kcons(K, app, KNIL));
TValue new_cont =
kmake_continuation(K, outer, KNIL, KNIL, do_interception,
