Commit ed2cf4e646565a6fc1df2fe9a7872e72a30e476f

Thomas de Grivel 2024-08-21T18:57:05

make Var work, add operator var_assign (<-)

diff --git a/.ikc3_history b/.ikc3_history
index 75b2914..14d5db1 100644
--- a/.ikc3_history
+++ b/.ikc3_history
@@ -1,56 +1,3 @@
-Struct.offset(%HTTP.Response{}, :code)
-Struct.offset(%HTTP.Response{}, :message)
-Struct.offset(%HTTP.Response{}, :headers)
-Struct.offset(%HTTP.Response{}, :body)
-Struct.offset(%HTTP.Request{}, :method)
-Struct.offset(%HTTP.Request{}, :url)
-Struct.offset(%HTTP.Request{}, :protocol)
-Struct.offset(%HTTP.Request{}, :headers)
-Struct.offset(%HTTP.Response{}, :message)
-Struct.offset(%HTTP.Request{}, :method)
-Struct.offset(%HTTP.Request{}, :url)
-Struct.offset(%HTTP.Request{}, :protocol)
-Struct.offset(%HTTP.Request{}, :headers)
-Struct.offset(%HTTP.Response{}, :protocol)
-Struct.offset(%HTTP.Response{}, :code)
-Struct.offset(%HTTP.Response{}, :message)
-Struct.offset(%HTTP.Response{}, :headers)
-Struct.offset(%HTTP.Response{}, :body)
-"a#{a}"
-quote "a#{a}"
-"a#{a}"
-"a#{:a}"
-quote "a#{a}"
-quote "a#{:a}"
-quote "a"
-quote "a #{:a}"
-"a #{:a}"
-"""a #{:a}"""
-"""a #{":a"}"""
-quote """a #{":a"}"""
-"""a #{":a"}"""
-quote "a#{a}"
-quote "a#{:a}"
-quote """a#{:a}"""
-quote """a#{"a"}"""
-quote """a#{:a}"""
-quote """a #{:a}"""
-quote "a #{:a}"
-quote "a"
-%Time{}
-Facts.env_facts()
-(Facts) Facts.env_facts()
-Facts.with_tags(Facts.env_facts(), ?, ?, ?)
-cursor = Facts.with_tags(Facts.env_facts(), ?, ?, ?)
-tuple = {?, ?, ?}
-cursor = Facts.with_tuple(Facts.env_facts(), tuple)
-a = ?
-b = ?
-c = ?
-s = ?
-p = ?
-o = ?
-cursor = Facts.with_tags(Facts.env_facts(), s, p, o)
 ptr = Facts.Cursor.next(cursor)
 s = ?
 p = ?
@@ -97,3 +44,56 @@ if true do if true do %KC3.Operator{} end end
 Facts.with(Facts.env_facts(), [[KC3, :operator, ?]], fn (fact) { puts(fact.object); void })
 Facts.with(Facts.env_facts(), [[?, :operator, ?]], fn (fact) { puts(fact.subject); puts(fact.object); void })
 Facts.with(Facts.env_facts(), [[plop, :operator, op], [op, :symbol_value, value]], fn (fact) { puts(value); void })
+Facts.with(Facts.env_facts(), quote [[plop, :operator, op], [op, :symbol_value, value]], fn (fact) { puts(value); void })
+a = ?
+b = ?
+c = ?
+Facts.with_tags(Facts.env_facts(), a, b, c, fn (fact) { puts(a); puts(b); puts(c); void })
+a = ?
+b = ?
+c = ?
+Facts.with_tags(Facts.env_facts(), a, b, c, fn (fact) { puts(a); puts(b); puts(c); void })
+a = ?
+b = ?
+c = ?
+Facts.with_tags(Facts.env_facts(), a, b, c, fn (fact) { puts(a); puts(b); puts(c); void })
+a = ?
+b = ?
+c = ?
+Facts.with_tags(Facts.env_facts(), a, b, c, fn (fact) { puts(a); puts(b); puts(c); void })
+a
+a <- 1
+type(a)
+(Ptr) a
+a = ?
+type(a)
+(Ptr) a
+a = ?
+b = ?
+c = ?
+Facts.with_tags(Facts.env_facts(), a, b, c, fn (fact) { puts(a); puts(b); puts(c); void })
+a <- 1
+a = ?
+a <- 1
+a = ?
+a <- 1
+a
+(Ptr) a
+a <- 1
+a <- 2
+type(a)
+a = ?
+a <- 1
+a
+a = ?
+a <- 1
+a
+a = ?
+a <- 1
+a = ?
+a <- 1
+a
+a = ?
+b = ?
+c = ?
+Facts.with_tags(Facts.env_facts(), a, b, c, fn (fact) { puts(a); puts(b); puts(c); void })
diff --git a/lib/kc3/0.1/kc3.facts b/lib/kc3/0.1/kc3.facts
index 04c1346..43de506 100644
--- a/lib/kc3/0.1/kc3.facts
+++ b/lib/kc3/0.1/kc3.facts
@@ -141,6 +141,13 @@ replace {KC3.operator_gte, :arity, 2}
 replace {KC3.operator_gte, :symbol_value, cfn Bool "tag_gte" (Tag, Tag, Result)}
 replace {KC3.operator_gte, :operator_precedence, 8}
 replace {KC3.operator_gte, :operator_associativity, :left}
+add {KC3, :operator, KC3.operator_assign}
+replace {KC3.operator_assign, :is_a, :operator}
+replace {KC3.operator_assign, :sym, :<-}
+replace {KC3.operator_assign, :arity, 2}
+replace {KC3.operator_assign, :symbol_value, cfn Tag "var_assign" (Var, Tag, Result)}
+replace {KC3.operator_assign, :operator_precedence, 7}
+replace {KC3.operator_assign, :operator_associativity, :left}
 add {KC3, :operator, KC3.operator_eq}
 replace {KC3.operator_eq, :is_a, :operator}
 replace {KC3.operator_eq, :sym, :==}
diff --git a/libkc3/env.c b/libkc3/env.c
index 7de4417..e5a242d 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -1878,6 +1878,8 @@ bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
     return env_eval_time(env, &tag->data.time, dest);
   case TAG_TUPLE:
     return env_eval_tuple(env, &tag->data.tuple, dest);
+  case TAG_VAR:
+    return env_eval_var(env, tag, dest);
   case TAG_BOOL:
   case TAG_CHARACTER:
   case TAG_F32:
@@ -1903,7 +1905,6 @@ bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
   case TAG_U64:
   case TAG_UNQUOTE:
   case TAG_UW:
-  case TAG_VAR:
     if (! tag_init_copy(dest, tag))
       return false;
     return true;
@@ -1970,6 +1971,33 @@ bool env_eval_tuple (s_env *env, const s_tuple *tuple, s_tag *dest)
   return true;
 }
 
+bool env_eval_var (s_env *env, const s_tag *tag, s_tag *dest)
+{
+  s_tag tmp = {0};
+  const s_var *var;
+  assert(env);
+  assert(tag);
+  assert(dest);
+  (void) env;
+  if (tag->type != TAG_VAR)
+    return false;
+  var = &tag->data.var;
+  if (var->ptr && var->ptr->type != TAG_VAR) {
+    if (! tag_init_copy(dest, var->ptr))
+      return false;
+    return true;
+  }
+  tmp.type = TAG_VAR;
+  if (! var->ptr ||
+      var->ptr == tag)
+    tmp.data.var.ptr = dest;
+  else
+    tmp.data.var.ptr = var->ptr;
+  tmp.data.var.type = var->type;
+  *dest = tmp;
+  return true;
+}
+
 bool env_eval_void (s_env *env, const void *_, s_tag *dest)
 {
   assert(env);
@@ -2071,13 +2099,14 @@ s_facts_with_cursor * env_facts_with_list (s_env *env, s_facts *facts,
   assert(facts);
   assert(cursor);
   assert(spec);
-  spec_i = spec;
   tmp = NULL;
   tmp_tail = &tmp;
+  spec_i = spec;
   while (spec_i) {
     if (spec_i->tag.type != TAG_LIST)
       goto ko;
     *tmp_tail = list_new(NULL);
+    (*tmp_tail)->tag.type = TAG_LIST;
     tmp_tail_j = &(*tmp_tail)->tag.data.list;
     spec_j = spec_i->tag.data.list;
     while (spec_j) {
diff --git a/libkc3/env.h b/libkc3/env.h
index 29b63f8..d0eed9e 100644
--- a/libkc3/env.h
+++ b/libkc3/env.h
@@ -176,6 +176,7 @@ bool          env_eval_time (s_env *env, const s_time *time,
                              s_tag *dest);
 bool          env_eval_tuple (s_env *env, const s_tuple *tuple,
                               s_tag *dest);
+bool          env_eval_var (s_env *env, const s_tag *tag, s_tag *dest);
 bool          env_eval_void (s_env *env, const void *_, s_tag *dest);
 s_fact_w *    env_fact_w_eval (s_env *env, const s_fact_w *fact,
 			       s_fact_w *dest);
diff --git a/libkc3/facts_spec.c b/libkc3/facts_spec.c
index d029e50..aa001ca 100644
--- a/libkc3/facts_spec.c
+++ b/libkc3/facts_spec.c
@@ -70,11 +70,22 @@ p_facts_spec facts_spec_new_list (s_list *spec)
     return NULL;
   s = spec;
   while (s) {
-    if (s->tag.type != TAG_LIST ||
-        (c = list_length(s->tag.data.list)) < 3 ||
-        (c - 1) % 2) {
-      err_puts("facts_spec_new_list: invalid spec");
-      assert(! "facts_spec_new_list: invalid spec");
+    if (s->tag.type != TAG_LIST) {
+      err_puts("facts_spec_new_list: invalid spec: not a List of List");
+      assert(! "facts_spec_new_list: invalid spec: not a List of List");
+      return NULL;
+    }
+    t = s->tag.data.list;
+    if ((c = list_length(t)) < 3) {
+      err_puts("facts_spec_new_list: invalid spec: list length < 3");
+      assert(! "facts_spec_new_list: invalid spec: list length < 3");
+      return NULL;
+    }
+    if ((c - 1) % 2) {
+      err_puts("facts_spec_new_list: invalid spec: list length"
+               " != 3 + 2 * n");
+      assert(! "facts_spec_new_list: invalid spec: list length"
+               " != 3 + 2 * n");
       return NULL;
     }
     count += c + 1;
diff --git a/libkc3/frame.c b/libkc3/frame.c
index 373a6ea..d29d9b9 100644
--- a/libkc3/frame.c
+++ b/libkc3/frame.c
@@ -37,13 +37,15 @@ s_frame * frame_binding_new_copy (s_frame *frame, const s_sym *name,
     err_puts("frame_binding_new_copy: binding new");
     assert(! "frame_binding_new_copy: binding new");
     return NULL;
-    }
-  if (! tag_init_copy(tag, value)) {
+  }
+  if (value->type == TAG_VAR)
+    tag_init_var(tag, value->data.var.type);
+  else 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;
 }
 
@@ -175,7 +177,10 @@ s_frame * frame_replace (s_frame *frame, const s_sym *sym,
     result = binding_get_w(f->bindings, sym);
     if (result) {
       tag_clean(result);
-      tag_init_copy(result, value);
+      if (value->type == TAG_VAR)
+        tag_init_var(result, value->data.var.type);
+      else
+        tag_init_copy(result, value);
       return frame;
     }
     f = f->next;
diff --git a/libkc3/ptr.c b/libkc3/ptr.c
index bc7508a..91353b4 100644
--- a/libkc3/ptr.c
+++ b/libkc3/ptr.c
@@ -56,6 +56,7 @@ u_ptr_w * ptr_init_cast (u_ptr_w *p,
   case TAG_U32: p->p = (void *) ((uw) tag->data.u32);  return p;
   case TAG_U64: p->p = (void *) ((uw) tag->data.u64);  return p;
   case TAG_UW:  p->p = (void *) ((uw) tag->data.uw);   return p;
+  case TAG_VAR: p->p = tag->data.var.ptr;              return p;
   default:
     break;
   }
diff --git a/libkc3/sym.c b/libkc3/sym.c
index e40858d..1aae9d3 100644
--- a/libkc3/sym.c
+++ b/libkc3/sym.c
@@ -866,6 +866,10 @@ bool sym_to_ffi_type (const s_sym *sym, ffi_type *result_type,
     *dest = &ffi_type_ulong;
     return true;
   }
+  if (sym == &g_sym_Var) {
+    *dest = &ffi_type_pointer;
+    return true;
+  }
   if (sym == &g_sym_Void) {
     *dest = &ffi_type_void;
     return true;
diff --git a/libkc3/tag.c b/libkc3/tag.c
index 3ce7908..95bdfea 100644
--- a/libkc3/tag.c
+++ b/libkc3/tag.c
@@ -1344,6 +1344,10 @@ bool tag_to_ffi_pointer (s_tag *tag, const s_sym *type, void **dest)
       *dest = tag;
       return true;
     }
+    if (type == &g_sym_Var) {
+      *dest = &tag->data.var;
+      return true;
+    }
     goto invalid_cast;
   case TAG_VOID:
     if (type == &g_sym_Void) {
diff --git a/libkc3/var.c b/libkc3/var.c
index 24ad8e1..0d7aa33 100644
--- a/libkc3/var.c
+++ b/libkc3/var.c
@@ -16,6 +16,16 @@
 #include "tag.h"
 #include "var.h"
 
+s_tag * var_assign (s_var *var, const s_tag *value, s_tag *dest)
+{
+  assert(var);
+  assert(value);
+  assert(dest);
+  if (! var_set(var, value))
+    return NULL;
+  return tag_init_copy(dest, value);
+}
+
 s_var * var_init (s_var *var, s_tag *ptr, const s_sym *type)
 {
   s_var tmp = {0};