Commit 140bc66b63b9a44c8554cd857beb6a2051a35a4b

Thomas de Grivel 2024-05-11T20:25:59

wip cow

diff --git a/.ic3_history b/.ic3_history
index 2241ea2..08269ae 100644
--- a/.ic3_history
+++ b/.ic3_history
@@ -1,9 +1,4 @@
 Plop.a
-Plop
-defmodule Plop do def a = 1 end
-Plop.a
-defmodule Plop do def a = 1 end
-Plop.a
 defmodule Plop do defoperator :operator_add :+ cfn Tag "tag_add" (Tag, Tag, Result) 10 :left end
 defmodule Plop do defoperator :operator_add :+ cfn Tag "tag_mul" (Tag, Tag, Result) 10 :left end
 defmodule Plop do
@@ -97,3 +92,8 @@ List.reverse([1, 2, 3])
 List.reverse([1, 2, 3, 4, 5, 6, 7, 8, 9, 10])
 (List) {1, 2}
 ?
+cow 1
+(Tag) cow 1
+a = cow 1
+a
+a + 1
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index fa843b7..f729efb 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -1196,16 +1196,19 @@ sw buf_parse_cow (s_buf *buf, s_cow *cow)
   assert(buf);
   assert(cow);
   buf_save_init(buf, &save);
-  if ((r = buf_parse_paren_sym(buf, &type)) <= 0)
+  type = &g_sym_Tag;
+  if ((r = buf_parse_paren_sym(buf, &type)) < 0)
     goto clean;
-  result += r;
-  if ((r = buf_ignore_spaces(buf)) < 0)
-    goto restore;
-  result += r;
+  if (r) {
+    result += r;
+    if ((r = buf_ignore_spaces(buf)) <= 0)
+      goto restore;
+    result += r;
+  }
   if ((r = buf_read_1(buf, "cow")) <= 0)
     goto restore;
   result += r;
-  if ((r = buf_ignore_spaces(buf)) < 0)
+  if ((r = buf_ignore_spaces(buf)) <= 0)
     goto restore;
   result += r;
   if (! cow_init(&tmp, type))
@@ -1213,6 +1216,22 @@ sw buf_parse_cow (s_buf *buf, s_cow *cow)
   if ((r = buf_parse_tag(buf, cow_read_write(&tmp))) <= 0)
     goto restore;
   result += r;
+  if (tmp.type != &g_sym_Tag) {
+    if (! tag_type(cow_read_write(&tmp), &type)) {
+      r = -1;
+      goto restore;
+    }
+    if (tmp.type != type) {
+      err_write_1("buf_parse_cow: type mismatch: ");
+      err_inspect_sym(&tmp.type);
+      err_write_1(" != ");
+      err_inspect_sym(&type);
+      assert(! "buf_parse_cow: type mismatch");
+      r = -1;
+      goto restore;
+    }
+  }
+  cow_freeze(&tmp);
   *cow = tmp;
   r = result;
   goto clean;
@@ -3601,12 +3620,12 @@ sw buf_parse_tag_primary (s_buf *buf, s_tag *dest)
       (r = buf_parse_tag_void(buf, dest)) != 0 ||
       (r = buf_parse_tag_number(buf, dest)) != 0 ||
       (r = buf_parse_tag_array(buf, dest)) != 0 ||
+      (r = buf_parse_tag_cow(buf, dest)) != 0 ||
       (r = buf_parse_tag_cast(buf, dest)) != 0 ||
       (r = buf_parse_tag_unquote(buf, dest)) != 0 ||
       (r = buf_parse_tag_if(buf, dest)) != 0 ||
       (r = buf_parse_tag_call(buf, dest)) != 0 ||
       (r = buf_parse_tag_call_paren(buf, dest)) != 0 ||
-      (r = buf_parse_tag_cow(buf, dest)) != 0 ||
       (r = buf_parse_tag_quote(buf, dest)) != 0 ||
       (r = buf_parse_tag_call_op_unary(buf, dest)) != 0 ||
       (r = buf_parse_tag_bool(buf, dest)) != 0 ||
diff --git a/libc3/cow.h b/libc3/cow.h
index 9f7d92a..7d56d15 100644
--- a/libc3/cow.h
+++ b/libc3/cow.h
@@ -50,6 +50,7 @@ s_cow * cow_new_tag_copy (const s_sym *type, const s_tag *src);
 s_str *       cow_inspect (const s_cow *cow, s_str *dest);
 const s_tag * cow_read_only (const s_cow *cow);
 s_tag *       cow_read_write (s_cow *cow);
+const s_tag * cow_resolve (const s_cow *cow);
 
 /* Operators. */
 s_cow * cow_freeze (s_cow *cow);
diff --git a/libc3/env.c b/libc3/env.c
index 6d243f6..9b95d66 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -782,10 +782,8 @@ bool env_eval_equal_tag (s_env *env, bool macro, const s_tag *a,
     tag_clean(&tmp_b);
     return true;
   }
-  while (a->type == TAG_COW)
-    a = cow_read_only(a->data.cow);
-  while (b->type == TAG_COW)
-    b = cow_read_only(b->data.cow);
+  a = tag_resolve_cow(a);
+  b = tag_resolve_cow(b);
   switch (a->type) {
   case TAG_COMPLEX:
   case TAG_F32:
diff --git a/libc3/tag.c b/libc3/tag.c
index 2f800ad..efe0688 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -600,14 +600,7 @@ bool tag_is_bound_var (const s_tag *tag)
 bool tag_is_number (const s_tag *tag)
 {
   assert(tag);
-  while (tag->type == TAG_COW) {
-    tag = cow_read_only(tag->data.cow);
-    if (! tag) {
-      err_puts("tag_is_number: cow was not frozen");
-      assert(! "tag_is_number: cow was not frozen");
-      return false;
-    }
-  }
+  tag = tag_resolve_cow(tag);
   switch (tag->type) {
   case TAG_VOID:
   case TAG_ARRAY:
@@ -808,6 +801,18 @@ s_tag * tag_paren (const s_tag *tag, s_tag *dest)
   return tag_init_copy(dest, tag);
 }
 
+const s_tag * tag_resolve_cow (const s_tag *tag)
+{
+  while (tag->type == TAG_COW)
+    tag = cow_read_only(tag->data.cow);
+  if (! tag) {
+    err_puts("tag_resolve_cow: cow was not frozen");
+    assert(! "tag_resolve_cow: cow was not frozen");
+    return NULL;
+  }
+  return tag;
+}
+
 uw * tag_size (const s_tag *tag, uw *dest)
 {
   const s_sym *type;
diff --git a/libc3/tag.h b/libc3/tag.h
index cd0543f..3e103a5 100644
--- a/libc3/tag.h
+++ b/libc3/tag.h
@@ -51,6 +51,7 @@ bool           tag_is_number (const s_tag *tag);
 bool           tag_is_unbound_var (const s_tag *tag);
 bool           tag_is_zero(const s_tag *tag);
 s8             tag_number_compare (const s_tag *a, const s_tag *b);
+const s_tag *  tag_resolve_cow (const s_tag *tag);
 uw *           tag_size (const s_tag *tag, uw *dest);
 ffi_type       tag_to_ffi_type(const s_tag *tag);
 const s_sym ** tag_type (const s_tag *tag, const s_sym **type);