diff --git a/libkc3/binding.c b/libkc3/binding.c
index 9599ab5..ac27d1e 100644
--- a/libkc3/binding.c
+++ b/libkc3/binding.c
@@ -13,6 +13,7 @@
#include "alloc.h"
#include "assert.h"
#include "binding.h"
+#include "compare.h"
#include "list.h"
#include "tag.h"
@@ -34,6 +35,18 @@ void binding_delete_all (s_binding *binding)
b = binding_delete(b);
}
+s_binding ** binding_find (s_binding **binding, const s_sym *name)
+{
+ s_binding **b;
+ b = binding;
+ while (*b) {
+ if (! compare_sym(name, (*b)->name))
+ return b;
+ b = &(*b)->next;
+ }
+ return NULL;
+}
+
const s_tag * binding_get (const s_binding *binding, const s_sym *name)
{
const s_binding *b;
@@ -59,26 +72,24 @@ s_tag * binding_get_w (s_binding *binding, const s_sym *name)
}
s_binding * binding_init (s_binding *binding, const s_sym *name,
- const s_tag *value, s_binding *next)
+ s_binding *next)
{
s_binding tmp = {0};
assert(binding);
- if (! tag_init_copy(&tmp.value, value))
- return NULL;
+ tag_init_void(&tmp.value);
tmp.name = name;
tmp.next = next;
*binding = tmp;
return binding;
}
-s_binding * binding_new (const s_sym *name, const s_tag *value,
- s_binding *next)
+s_binding * binding_new (const s_sym *name, s_binding *next)
{
s_binding *binding;
binding = alloc(sizeof(s_binding));
if (! binding)
return NULL;
- if (! binding_init(binding, name, value, next)) {
+ if (! binding_init(binding, name, next)) {
free(binding);
return NULL;
}
diff --git a/libkc3/binding.h b/libkc3/binding.h
index 118871a..730f9de 100644
--- a/libkc3/binding.h
+++ b/libkc3/binding.h
@@ -19,13 +19,12 @@
use. */
void binding_clean (s_binding *binding);
s_binding * binding_init (s_binding *binding, const s_sym *name,
- const s_tag *value, s_binding *next);
+ s_binding *next);
/* Heap-allocation functions, call binding_delete* after use. */
s_binding * binding_delete (s_binding *binding);
void binding_delete_all (s_binding *binding);
-s_binding * binding_new (const s_sym *name, const s_tag *value,
- s_binding *next);
+s_binding * binding_new (const s_sym *name, s_binding *next);
/* Observers. */
const s_tag * binding_get (const s_binding *binding, const s_sym *name);
@@ -34,5 +33,6 @@ const s_tag * binding_is_bound (const s_binding *binding,
/* Operators. */
s_tag * binding_get_w (s_binding *binding, const s_sym *name);
+s_binding ** binding_find (s_binding **binding, const s_sym *name);
#endif /* LIBC3_BINDING_H */
diff --git a/libkc3/env.c b/libkc3/env.c
index 0da45af..e16b1f3 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -943,7 +943,7 @@ bool env_eval_equal_tag (s_env *env, bool macro, const s_tag *a,
tag_init_copy(dest, b);
else
env_eval_tag(env, b, dest);
- frame_binding_new(env->frame->next, a->data.ident.sym, dest);
+ frame_binding_new_copy(env->frame->next, a->data.ident.sym, dest);
return true;
}
if (is_unbound_b) {
@@ -951,7 +951,7 @@ bool env_eval_equal_tag (s_env *env, bool macro, const s_tag *a,
tag_init_copy(dest, a);
else
env_eval_tag(env, a, dest);
- frame_binding_new(env->frame->next, b->data.ident.sym, dest);
+ frame_binding_new_copy(env->frame->next, b->data.ident.sym, dest);
return true;
}
if (! macro &&
diff --git a/libkc3/frame.c b/libkc3/frame.c
index 7107db8..5703611 100644
--- a/libkc3/frame.c
+++ b/libkc3/frame.c
@@ -15,18 +15,45 @@
#include "binding.h"
#include "frame.h"
#include "list.h"
+#include "tag.h"
-s_frame * frame_binding_new (s_frame *frame, const s_sym *name,
- const s_tag *value)
+s_frame * frame_binding_new (s_frame *frame, const s_sym *name)
{
s_binding *b;
- b = binding_new(name, value, frame->bindings);
+ b = binding_new(name, frame->bindings);
if (! b)
return NULL;
frame->bindings = b;
return frame;
}
+s_frame * frame_binding_new_copy (s_frame *frame, const s_sym *name, const s_tag *value)
+{
+ s_tag *tag;
+ frame_binding_new(frame, name);
+ tag = binding_get_w(frame->bindings, name);
+ if (tag == NULL) {
+ err_puts("frame_binding_new_copy: binding new");
+ assert(! "frame_binding_new_copy: binding new");
+ return NULL;
+ }
+ if (! tag_init_copy(tag, value)) {
+ err_puts("frame_binding_new_copy: tag_init_copy");
+ assert(! "frame_binding_new_copy: tag_init_copy");
+ frame = frame_binding_delete(frame, name);
+ return NULL;
+ }
+ return frame;
+}
+
+s_frame * frame_binding_delete (s_frame *frame, const s_sym *name)
+{
+ s_binding **b;
+ b = binding_find(&frame->bindings, name);
+ *b = binding_delete(*b);
+ return frame;
+}
+
s_frame * frame_clean (s_frame *frame)
{
s_frame *next;
diff --git a/libkc3/frame.h b/libkc3/frame.h
index 9fa6925..e652ac4 100644
--- a/libkc3/frame.h
+++ b/libkc3/frame.h
@@ -27,8 +27,9 @@ s_frame * frame_delete (s_frame *frame);
void frame_delete_all (s_frame *frame);
/* Operators. */
-s_frame * frame_binding_new (s_frame *frame, const s_sym *name,
- const s_tag *value);
+s_frame * frame_binding_new (s_frame *frame, const s_sym *name);
+s_frame * frame_binding_new_copy (s_frame *frame, const s_sym *name, const s_tag *value);
+s_frame * frame_binding_delete (s_frame *frame, const s_sym *name);
s_tag * frame_get_w (s_frame *frame, const s_sym *sym);
/* Observers. */