commit 2e38fafd51c879fac2484af60ac267bb4ac322d7
parent c9968f34c70786bfd968fdbc31b7353e7ed6f0fb
Author: Andres Navarro <canavarro82@gmail.com>
Date: Fri, 29 Apr 2011 18:23:12 -0300
Added names to the different kinds of continuations. TODO: add all names to the table in kground.
Diffstat:
10 files changed, 73 insertions(+), 8 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -95,7 +95,7 @@ kground.o: kground.c kground.h kstate.h kobject.h klisp.h kenvironment.h \
kgpair_mut.h kgenvironments.h kgenv_mut.h kgcombiners.h \
kgcontinuations.h kgencapsulations.h kgpromises.h kgkd_vars.h \
kgks_vars.h kgports.h kgchars.h kgnumbers.h kgstrings.o \
- klispconf.h
+ klispconf.h krepl.h keval.h ktable.h kstring.h
kghelpers.o: kghelpers.c kghelpers.h kstate.h kstate.h klisp.h kpair.h \
kapplicative.h koperative.h kerror.h kobject.h ksymbol.h \
kcontinuation.h
diff --git a/src/keval.c b/src/keval.c
@@ -39,7 +39,7 @@ void eval_ls_cfn(klisp_State *K, TValue *xparams, TValue obj)
} else {
/* more arguments need to be evaluated */
/* GC: all objects are rooted at this point */
- TValue new_cont = kmake_continuation(K, kget_cc(K), &eval_ls_cfn, 4,
+ TValue new_cont = kmake_continuation(K, kget_cc(K), eval_ls_cfn, 4,
rest, env, tail, combiner);
kset_cc(K, new_cont);
ktail_eval(K, kcar(rest), env);
diff --git a/src/kgc.c b/src/kgc.c
@@ -556,6 +556,7 @@ static void markroot (klisp_State *K) {
/* TEMP: this is quite awfull, think of other way to do this */
/* MAYBE: some of these could be FIXED */
markvalue(K, K->name_table);
+ markvalue(K, K->cont_name_table);
markvalue(K, K->curr_cont);
markvalue(K, K->next_obj);
markvalue(K, K->next_value);
diff --git a/src/kground.c b/src/kground.c
@@ -40,6 +40,12 @@
#include "kgchars.h"
#include "kgports.h"
+/* for initing cont names */
+#include "ktable.h"
+#include "kstring.h"
+#include "keval.h"
+#include "krepl.h"
+
/*
** BEWARE: this is highly unhygienic, it assumes variables "symbol" and
** "value", both of type TValue. symbol will be bound to a symbol named by
@@ -83,6 +89,25 @@
symbol = ksymbol_new(K_, n_); \
kadd_binding(K_, env_, symbol, v_); }
+/* for init_cont_names */
+#define add_cont_name(K_, t_, c_, n_) \
+ { TValue str = kstring_new_b_imm(K_, n_); \
+ TValue *node = klispH_set(K_, t_, p2tv(c_)); \
+ *node = str; \
+ }
+
+/*
+** This is called once to save the names of the types of continuations
+** used in the ground environment & repl
+** TODO the repl should init its own names!
+*/
+void kinit_cont_names(klisp_State *K)
+{
+ Table *t = tv2table(K->cont_name_table);
+
+ add_cont_name(K, t, exit_fn, "do-exit");
+}
+
/*
** This is called once to bind all symbols in the ground environment
*/
@@ -1059,5 +1084,7 @@ void kinit_ground_env(klisp_State *K)
error if a file exists, but that would need to be an option in all three
methods of opening. Also some directory checking, traversing etc */
+ kinit_cont_names(K);
+
return;
}
diff --git a/src/klimits.h b/src/klimits.h
@@ -54,13 +54,13 @@
#define MINSTRTABSIZE 32
#endif
-/* minimum size for the name & si table (must be power of 2) */
+/* minimum size for the name & cont_name tables (must be power of 2) */
#ifndef MINNAMETABSIZE
#define MINNAMETABSIZE 32
#endif
-#ifndef MINSITABSIZE
-#define MINSITABSIZE 32
+#ifndef MINCONTNAMETABSIZE
+#define MINCONTNAMETABSIZE 32
#endif
/* starting size for ground environment hashtable */
diff --git a/src/krepl.c b/src/krepl.c
@@ -81,12 +81,12 @@ inline void create_loop(klisp_State *K, TValue denv)
{
krooted_tvs_push(K, denv);
TValue loop_cont =
- kmake_continuation(K, K->root_cont, &loop_fn, 1, denv);
+ kmake_continuation(K, K->root_cont, loop_fn, 1, denv);
krooted_tvs_push(K, loop_cont);
- TValue eval_cont = kmake_continuation(K, loop_cont, &eval_cfn, 1, denv);
+ TValue eval_cont = kmake_continuation(K, loop_cont, eval_cfn, 1, denv);
krooted_tvs_pop(K); /* in eval cont */
krooted_tvs_push(K, eval_cont);
- TValue read_cont = kmake_continuation(K, eval_cont, &read_fn, 0);
+ TValue read_cont = kmake_continuation(K, eval_cont, read_fn, 0);
kset_cc(K, read_cont);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
diff --git a/src/krepl.h b/src/krepl.h
@@ -13,4 +13,11 @@
void kinit_repl(klisp_State *K);
+/* continuation functions */
+void exit_fn(klisp_State *K, TValue *xparams, TValue obj);
+void read_fn(klisp_State *K, TValue *xparams, TValue obj);
+void eval_cfn(klisp_State *K, TValue *xparams, TValue obj);
+void loop_fn(klisp_State *K, TValue *xparams, TValue obj);
+void error_fn(klisp_State *K, TValue *xparams, TValue obj);
+
#endif
diff --git a/src/kstate.c b/src/kstate.c
@@ -137,6 +137,9 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
be fixed! */
K->name_table = klispH_new(K, 0, MINNAMETABSIZE,
K_FLAG_WEAK_KEYS);
+ /* here the keys are uncollectable */
+ K->cont_name_table = klispH_new(K, 0, MINCONTNAMETABSIZE,
+ K_FLAG_WEAK_NOTHING);
/* Empty string */
/* MAYBE: fix it so we can remove empty_string from roots */
diff --git a/src/kstate.h b/src/kstate.h
@@ -47,6 +47,7 @@ typedef struct stringtable {
struct klisp_State {
stringtable strt; /* hash table for immutable strings & symbols */
TValue name_table; /* hash tables for naming objects */
+ TValue cont_name_table; /* hash tables for naming continuation functions*/
TValue curr_cont;
/*
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -237,6 +237,29 @@ void kw_print_si(klisp_State *K, TValue obj)
}
#endif /* KTRACK_SI */
+/* obj should be a continuation */
+/* REFACTOR: move get cont name to a function somewhere else */
+void kw_print_cont_type(klisp_State *K, TValue obj)
+{
+ bool saved_displayp = K->write_displayp;
+ K->write_displayp = true; /* avoid "s and escapes */
+
+ Continuation *cont = tv2cont(obj);
+ const TValue *node = klispH_get(tv2table(K->cont_name_table),
+ p2tv(cont->fn));
+
+ char *type;
+ if (node == &kfree) {
+ type = "?";
+ } else {
+ klisp_assert(ttisstring(*node));
+ type = kstring_buf(*node);
+ }
+
+ kw_printf(K, " (%s)", type);
+ K->write_displayp = saved_displayp;
+}
+
/*
** Writes all values except strings and pairs
*/
@@ -322,6 +345,9 @@ void kwrite_simple(klisp_State *K, TValue obj)
kw_print_name(K, obj);
}
#endif
+
+ kw_print_cont_type(K, obj);
+
#if KTRACK_SI
if (khas_si(obj))
kw_print_si(K, obj);
