commit 9dff9d52a4523d34aabce1e0d92c5b701b572490
parent 5445c97c9f8043a31c064598a7b1231db361cef2
Author: Andres Navarro <canavarro82@gmail.com>
Date: Wed, 20 Apr 2011 22:21:59 -0300
Added simple naming in add_binding. Bugfix: can_have_name has to check that the obj is collectable before testing flags.
Diffstat:
2 files changed, 20 insertions(+), 3 deletions(-)
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -109,13 +109,27 @@ TValue kfind_local_binding(klisp_State *K, TValue bindings, TValue sym)
#define kenv_parents(kst_, env_) (tv2env(env_)->parents)
#define kenv_bindings(kst_, env_) (tv2env(env_)->bindings)
-/* Assumes that env, sym & val are rooted. sym & val need not be
- right now, but that could change */
+/* GC: Assumes that obj & sym are rooted. */
+void try_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
+ that if this object receives a name it can pass on that
+ name to other objs, like applicatives to operatives &
+ some applicatives to objects */
+ TValue *node = klispH_set(K, tv2table(K->name_table), obj);
+ *node = sym;
+ }
+}
+
+/* GC: Assumes that env, sym & val are rooted. */
void kadd_binding(klisp_State *K, TValue env, TValue sym, TValue val)
{
klisp_assert(ttisenvironment(env));
klisp_assert(ttissymbol(sym));
+ try_set_name(K, val, sym);
+
TValue bindings = kenv_bindings(K, env);
if (ttistable(bindings)) {
TValue *cell = klispH_setsym(K, tv2table(bindings), tv2sym(sym));
diff --git a/src/kobject.h b/src/kobject.h
@@ -638,7 +638,10 @@ int32_t kmark_count;
#define K_FLAG_CAN_HAVE_NAME 0x80
#define K_FLAG_HAS_NAME 0x40
-#define kcan_have_name(o_) ((tv_get_kflags(o_)) & K_FLAG_CAN_HAVE_NAME)
+/* evaluates o_ more than once */
+#define kcan_have_name(o_) \
+ (iscollectable(o_) && ((tv_get_kflags(o_)) & K_FLAG_CAN_HAVE_NAME) != 0)
+
#define khas_name(o_) ((tv_get_kflags(o_)) & K_FLAG_HAS_NAME)
#define K_FLAG_HAS_SI 0x20
