Commit 42d88e086f053c92f4b77c5a39881eb675a1dd43

Thomas de Grivel 2024-10-19T11:37:40

env_eval_equal_tag: bind and set variables

diff --git a/libkc3/env.c b/libkc3/env.c
index 621fb14..1c7bf24 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -60,6 +60,7 @@
 #include "tag_init.h"
 #include "time.h"
 #include "tuple.h"
+#include "var.h"
 
 s_env g_kc3_env;
 
@@ -991,16 +992,38 @@ bool env_eval_equal_tag (s_env *env, bool macro, const s_tag *a,
 {
   bool is_unbound_a;
   bool is_unbound_b;
+  bool is_var_a = false;
+  bool is_var_b = false;
   s_tag tmp_a;
   s_tag tmp_b;
+  s_tag *var_a;
+  s_tag *var_b;
   assert(env);
   assert(a);
   assert(b);
   assert(dest);
   tag_init_void(&tmp_a);
   tag_init_void(&tmp_b);
-  is_unbound_a = a->type == TAG_IDENT;
-  is_unbound_b = ! macro && b->type == TAG_IDENT;
+  if (a->type == TAG_VAR) {
+    if (! a->data.var.ptr) {
+      if (! (var_a = frame_binding_new_var(env->frame)))
+        return false;
+      a = var_a;
+    }
+    if (! tag_is_unbound_var(a, &is_var_a))
+      return false;
+  }
+  if (b->type == TAG_VAR) {
+    if (! b->data.var.ptr) {
+      if (! (var_b = frame_binding_new_var(env->frame)))
+        return false;
+      b = var_b;
+    }
+    if (! tag_is_unbound_var(b, &is_var_b))
+      return false;
+  }
+  is_unbound_a = a->type == TAG_IDENT || is_var_a;
+  is_unbound_b = ! macro && (b->type == TAG_IDENT || is_var_b);
   if (is_unbound_a && is_unbound_b) {
     err_write_1("env_eval_equal_tag: unbound equal on both sides: ");
     err_inspect_ident(&a->data.ident);
@@ -1019,8 +1042,14 @@ 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);
-    if (! frame_replace(env->frame, a->data.ident.sym, dest))
-      return false;
+    if (is_var_a) {
+      if (! var_set(&a->data.var, dest))
+        return false;
+    }
+    else {
+      if (! frame_replace(env->frame, a->data.ident.sym, dest))
+        return false;
+    }
     return true;
   }
   if (is_unbound_b) {
@@ -1028,8 +1057,14 @@ 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);
-    if (! frame_replace(env->frame, b->data.ident.sym, dest))
-      return false;
+    if (is_var_b) {
+      if (! var_set(&b->data.var, dest))
+        return false;
+    }
+    else {
+      if (! frame_replace(env->frame, b->data.ident.sym, dest))
+        return false;
+    }
     return true;
   }
   if (! macro &&
diff --git a/libkc3/frame.c b/libkc3/frame.c
index a6d6a3b..afbd9f3 100644
--- a/libkc3/frame.c
+++ b/libkc3/frame.c
@@ -18,6 +18,14 @@
 #include "sym.h"
 #include "tag.h"
 
+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_tag * frame_binding_new (s_frame *frame, const s_sym *name)
 {
   s_binding *b;
@@ -53,12 +61,15 @@ s_frame * frame_binding_new_copy (s_frame *frame, const s_sym *name,
   return frame;
 }
 
-s_frame * frame_binding_delete (s_frame *frame, const s_sym *name)
+s_tag * frame_binding_new_var (s_frame *frame)
 {
-  s_binding **b;
-  b = binding_find(&frame->bindings, name);
-  *b = binding_delete(*b);
-  return frame;
+  s_binding *b;
+  b = binding_new(NULL, frame->bindings);
+  if (! b)
+    return NULL;
+  frame->bindings = b;
+  tag_init_var(&b->value, &g_sym_Tag);
+  return &b->value;
 }
 
 s_frame * frame_binding_replace (s_frame *frame, const s_sym *name,
diff --git a/libkc3/frame.h b/libkc3/frame.h
index cc048c8..db3e04a 100644
--- a/libkc3/frame.h
+++ b/libkc3/frame.h
@@ -35,6 +35,7 @@ const s_tag * frame_get (const s_frame *frame, const s_sym *sym);
 s_tag *   frame_binding_new (s_frame *frame, const s_sym *name);
 s_frame * frame_binding_new_copy (s_frame *frame, const s_sym *name,
                                   s_tag *value);
+s_tag *   frame_binding_new_var (s_frame *frame);
 s_frame * frame_binding_delete (s_frame *frame, const s_sym *name);
 s_frame * frame_binding_replace (s_frame *frame, const s_sym *name,
                                  const s_tag *value);
diff --git a/test/ikc3/equal.kc3 b/test/ikc3/equal.kc3
index c3a29e2..80ffcea 100644
--- a/test/ikc3/equal.kc3
+++ b/test/ikc3/equal.kc3
@@ -1,4 +1,12 @@
+quote a = 1
 a = 1
+quote b = 1
 b = 1
+quote c = 2
 c = 2
+quote [d, e] = [1, 2]
 [d, e] = [1, 2]
+quote {1, 2} = {f, g}
+{1, 2} = {f, g}
+quote ? = 1
+? = 1
diff --git a/test/ikc3/equal.out.expected b/test/ikc3/equal.out.expected
index c46aff7..94d56a2 100644
--- a/test/ikc3/equal.out.expected
+++ b/test/ikc3/equal.out.expected
@@ -1,4 +1,12 @@
+a = 1
 1
+b = 1
 1
+c = 2
 2
+[d, e] = [1, 2]
 [1, 2]
+{1, 2} = {f, g}
+{1, 2}
+? = 1
+1