Commit c2893075f30e574ca6f0c91533f9ff7b36053303

Baptiste 2024-07-22T15:14:29

binding handling (work in progress)

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. */