commit f844337f9fb93f72b8b40de1c2633b3643eb457c
parent 54311c2bc8f054bae929369c511991f9c17acad6
Author: Andres Navarro <canavarro82@gmail.com>
Date: Fri, 29 Apr 2011 14:09:17 -0300
Added name to the eval operative (for better error signaling in evaluations like those of $sequence), and refactored get_name and try_set_name to interface of kenvironment.h.
Diffstat:
6 files changed, 27 insertions(+), 27 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -58,12 +58,14 @@ ksymbol.o: ksymbol.c ksymbol.h kobject.h kpair.h kstring.h kstate.h kmem.h \
kread.o: kread.c kread.h kobject.h ktoken.h kpair.h kstate.h kerror.h klisp.h \
kport.h ktable.h klispconf.h
kwrite.o: kwrite.c kwrite.h kobject.h kpair.h kstring.h kstate.h kerror.h \
- klisp.h kport.h kinteger.h krational.h ktable.h klispconf.h
+ klisp.h kport.h kinteger.h krational.h ktable.h klispconf.h \
+ kenvironment.h
# XXX: now that all dealloc code is in gc, many of these are unnecessary
kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h kstring.h klisp.h \
kenvironment.h kpair.h keval.h koperative.h kground.h \
krepl.h kcontinuation.h kapplicative.h kport.h ksymbol.h kport.h \
- kstring.h kinteger.h krational.h kgc.h klimits.h ktable.h klispconf.h
+ kstring.h kinteger.h krational.h kgc.h klimits.h ktable.h klispconf.h \
+ kenvironment.h
kmem.o: kmem.c kmem.h klisp.h kerror.h klisp.h kstate.h kgc.h klispconf.h
kerror.o: kerror.c kerror.h klisp.h kstate.h klisp.h kmem.h kstring.h kpair.h
kauxlib.o: kauxlib.c kauxlib.h klisp.h kstate.h klisp.h
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -112,7 +112,7 @@ TValue kfind_local_binding(klisp_State *K, TValue bindings, TValue sym)
#if KTRACK_NAMES
/* GC: Assumes that obj & sym are rooted. */
-void try_set_name(klisp_State *K, TValue obj, TValue sym)
+void ktry_set_name(klisp_State *K, TValue obj, TValue sym)
{
if (kcan_have_name(obj) && !khas_name(obj)) {
/* TODO: maybe we could have some kind of inheritance so
@@ -140,6 +140,15 @@ void try_set_name(klisp_State *K, TValue obj, TValue sym)
}
}
}
+
+/* Assumes obj has a name */
+TValue kget_name(klisp_State *K, TValue obj)
+{
+ const TValue *node = klispH_get(tv2table(K->name_table),
+ obj);
+ klisp_assert(node != &kfree);
+ return *node;
+}
#endif
/* GC: Assumes that env, sym & val are rooted. */
@@ -149,7 +158,7 @@ void kadd_binding(klisp_State *K, TValue env, TValue sym, TValue val)
klisp_assert(ttissymbol(sym));
#if KTRACK_NAMES
- try_set_name(K, val, sym);
+ ktry_set_name(K, val, sym);
#endif
TValue bindings = kenv_bindings(K, env);
diff --git a/src/kenvironment.h b/src/kenvironment.h
@@ -30,4 +30,10 @@ TValue kget_keyed_static_var(klisp_State *K, TValue env, TValue key);
hashtable */
TValue kmake_table_environment(klisp_State *K, TValue parents);
+#if KTRACK_NAMES
+void ktry_set_name(klisp_State *K, TValue obj, TValue sym);
+/* assumes it has a name */
+TValue kget_name(klisp_State *K, TValue obj);
+#endif
+
#endif
diff --git a/src/krepl.c b/src/krepl.c
@@ -109,18 +109,6 @@ void loop_fn(klisp_State *K, TValue *xparams, TValue obj)
create_loop(K, denv);
}
-/* XXX move this to a common file (same as in write) */
-#if KTRACK_NAMES
-/* Assumes obj has a name */
-TValue krepl_get_name(klisp_State *K, TValue obj)
-{
- const TValue *node = klispH_get(tv2table(K->name_table),
- obj);
- klisp_assert(node != &kfree);
- return *node;
-}
-#endif /* KTRACK_NAMES */
-
/* the underlying function of the error cont */
void error_fn(klisp_State *K, TValue *xparams, TValue obj)
{
@@ -147,7 +135,7 @@ void error_fn(klisp_State *K, TValue *xparams, TValue obj)
who_str = kstring_buf(who);
#if KTRACK_NAMES
} else if (khas_name(who)) {
- TValue name = krepl_get_name(K, who);
+ TValue name = kget_name(K, who);
who_str = ksymbol_buf(name);
#endif
} else {
diff --git a/src/kstate.c b/src/kstate.c
@@ -195,6 +195,9 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
si = kcons(K, kstring_new_b_imm(K, __FILE__),
kcons(K, i2tv(line_number), i2tv(0)));
kset_source_info(K, K->eval_op, si);
+
+ TValue eval_name = ksymbol_new(K, "eval");
+ ktry_set_name(K, K->eval_op, eval_name);
K->list_app = kmake_applicative(K, list, 0), line_number = __LINE__;
si = kcons(K, kstring_new_b_imm(K, __FILE__),
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -20,6 +20,7 @@
#include "kerror.h"
#include "ktable.h"
#include "kport.h"
+#include "kenvironment.h"
/*
** Stack for the write FSM
@@ -207,18 +208,9 @@ void kw_set_initial_marks(klisp_State *K, TValue root)
}
#if KTRACK_NAMES
-/* Assumes obj has a name */
-TValue kw_get_name(klisp_State *K, TValue obj)
-{
- const TValue *node = klispH_get(tv2table(K->name_table),
- obj);
- klisp_assert(node != &kfree);
- return *node;
-}
-
void kw_print_name(klisp_State *K, TValue obj)
{
- kw_printf(K, ": %s", ksymbol_buf(kw_get_name(K, obj)));
+ kw_printf(K, ": %s", ksymbol_buf(kget_name(K, obj)));
}
#endif /* KTRACK_NAMES */
