kc3-lang/kc3

diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index ded5e55..fa843b7 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -1192,17 +1192,26 @@ sw buf_parse_cow (s_buf *buf, s_cow *cow)
   sw result = 0;
   s_buf_save save;
   s_cow tmp;
+  const s_sym *type;
   assert(buf);
   assert(cow);
   buf_save_init(buf, &save);
+  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 = 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))
+    goto restore;
   if ((r = buf_parse_tag(buf, cow_read_write(&tmp))) <= 0)
-    goto clean;
+    goto restore;
   result += r;
   *cow = tmp;
   r = result;
@@ -2697,7 +2706,7 @@ sw buf_parse_pcow (s_buf *buf, s_cow **c)
 {
   sw r;
   s_cow *tmp;
-  tmp = cow_new();
+  tmp = alloc(sizeof(s_cow));
   if ((r = buf_parse_cow(buf, tmp)) <= 0) {
     free(tmp);
     return r;
diff --git a/libc3/buf_parse.h b/libc3/buf_parse.h
index 5899e30..7db022a 100644
--- a/libc3/buf_parse.h
+++ b/libc3/buf_parse.h
@@ -59,6 +59,7 @@ sw buf_parse_cast (s_buf *buf, s_call *dest);
 sw buf_parse_cfn (s_buf *buf, s_cfn *dest);
 sw buf_parse_character (s_buf *buf, character *dest);
 sw buf_parse_comments (s_buf *buf);
+sw buf_parse_cow (s_buf *buf, s_cow *cow);
 sw buf_parse_digit (s_buf *buf, const s_str *base, u8 *dest);
 sw buf_parse_digit_bin (s_buf *buf, u8 *dest);
 sw buf_parse_digit_hex (s_buf *buf, u8 *dest);
diff --git a/libc3/cow.c b/libc3/cow.c
index 0e6fe35..0fb2b5a 100644
--- a/libc3/cow.c
+++ b/libc3/cow.c
@@ -10,10 +10,16 @@
  * AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
  * THIS SOFTWARE.
  */
+#include <string.h>
 #include "assert.h"
 #include "alloc.h"
+#include "buf.h"
+#include "buf_inspect.h"
+#include "buf_parse.h"
 #include "cow.h"
+#include "data.h"
 #include "list.h"
+#include "sym.h"
 #include "tag.h"
 
 void cow_clean (s_cow *cow)
@@ -70,13 +76,13 @@ s_cow * cow_init_1 (s_cow *cow, const char *utf8)
   s_buf buf;
   uw len;
   sw r;
-  len = strlen(p);
-  buf_init(&buf, false, len, (char *) p); // buf is read-only
+  len = strlen(utf8);
+  buf_init(&buf, false, len, (char *) utf8); // buf is read-only
   buf.wpos = len;
   r = buf_parse_cow(&buf, cow);
   if (r < 0 || (uw) r != len) {
     err_write_1("invalid cow: \"");
-    err_write_1(p);
+    err_write_1(utf8);
     err_write_1("\", ");
     err_inspect_uw(&len);
     err_write_1(" != ");
@@ -84,30 +90,31 @@ s_cow * cow_init_1 (s_cow *cow, const char *utf8)
     assert(! "invalid cow");
     return NULL;
   }
-  return tag;
+  return cow;
 }
 
 s_cow * cow_init_cast (s_cow *cow, const s_sym * const *type,
                        const s_tag *tag)
 {
   void *data;
-  s_tag tmp;
+  s_cow tmp;
   assert(tag);
   assert(type);
-  assert(src);
+  assert(tag);
   if (*type == &g_sym_Cow) {
     err_puts("cow_init_cast: cannot cast to Cow");
     assert(! "cow_init_cast: cannot cast to Cow");
     return NULL;
   }
-  if (! sym_to_tag_type(*type, &tmp.type))
+  tmp.type = *type;
+  if (! sym_to_tag_type(*type, &tmp.list->tag.type))
     return NULL;
   if (! tag_to_pointer(&tmp.list->tag, *type, &data))
     return NULL;
-  if (! data_init_cast(data, type, src))
+  if (! data_init_cast(data, type, tag))
     return NULL;
-  *tag = tmp;
-  return tag;
+  *cow = tmp;
+  return cow;
 }
 
 s_cow * cow_init_copy (s_cow *cow, const s_cow *src)
@@ -122,16 +129,27 @@ s_cow * cow_init_copy (s_cow *cow, const s_cow *src)
   *cow = tmp;
   return cow;
 }
-  
-s_cow * cow_init_tag_copy (s_cow *cow, const s_tag *src)
+
+s_cow * cow_init_tag_copy (s_cow *cow, const s_sym *type,
+                           const s_tag *src)
 {
   assert(cow);
   assert(src);
+  const s_sym *src_type;
   s_cow tmp = {0};
   assert(cow);
   assert(src);
-  tmp.type = src->type;
-  tmp.list = list_new_tag_copy(src);
+  if (type != &g_sym_Tag) {
+    if (! tag_type(src, &src_type))
+      return NULL;
+    if (type != src_type) {
+      err_puts("cow_init_tag_copy: type mismatch");
+      assert(! "cow_init_tag_copy: type mismatch");
+      return NULL;
+    }
+  }
+  tmp.type = type;
+  tmp.list = list_new_tag_copy(src, NULL);
   if (! tmp.list)
     return NULL;
   *cow = tmp;
@@ -142,7 +160,7 @@ s_str * cow_inspect (const s_cow *cow, s_str *dest)
 {
   s_buf buf;
   sw size;
-  assert(tag);
+  assert(cow);
   assert(dest);
   if ((size = buf_inspect_cow_size(cow)) < 0) {
     err_puts("tag_inspect: size error");
@@ -158,13 +176,13 @@ s_str * cow_inspect (const s_cow *cow, s_str *dest)
   return buf_to_str(&buf, dest);
 }
 
-s_cow * cow_new (void)
+s_cow * cow_new (const s_sym *type)
 {
   s_cow *cow;
   cow = alloc(sizeof(s_cow));
   if (! cow)
     return NULL;
-  if (! cow_init(cow)) {
+  if (! cow_init(cow, type)) {
     free(cow);
     return NULL;
   }
@@ -210,13 +228,24 @@ s_cow * cow_new_copy (const s_cow *src)
   return cow;
 }
 
+s_cow * cow_new_tag_copy (const s_sym *type, const s_tag *src)
+{
+  s_cow *cow;
+  cow = alloc(sizeof(s_cow));
+  if (! cow)
+    return NULL;
+  if (! cow_init_tag_copy(cow, type, src)) {
+    free(cow);
+    return NULL;
+  }
+  return cow;
+}
+
 const s_tag * cow_read_only (const s_cow *cow)
 {
   assert(cow);
   assert(cow->list);
-  if (! list_next(cow->list))
-    if (! cow_freeze(cow))
-      return NULL;
+  assert(list_next(cow->list));
   return &list_next(cow->list)->tag;
 }
 
diff --git a/libc3/cow.h b/libc3/cow.h
index 4d4b92a..9f7d92a 100644
--- a/libc3/cow.h
+++ b/libc3/cow.h
@@ -30,19 +30,21 @@
 
 /* Stack-allocation compatible functions. Call cow_clean after use. */
 void    cow_clean (s_cow *cow);
-s_cow * cow_init (s_cow *cow);
+s_cow * cow_init (s_cow *cow, const s_sym *type);
 s_cow * cow_init_1 (s_cow *cow, const char *utf8);
 s_cow * cow_init_cast (s_cow *cow, const s_sym * const *type,
                        const s_tag *tag);
 s_cow * cow_init_copy (s_cow *cow, const s_cow *src);
-s_cow * cow_init_tag_copy (s_cow *cow, const s_tag *src);
+s_cow * cow_init_tag_copy (s_cow *cow, const s_sym *type,
+                           const s_tag *src);
 
 /* Heap-allocation functions. Call cow_delete after use. */
 void    cow_delete (s_cow *cow);
-s_cow * cow_new (void);
+s_cow * cow_new (const s_sym *type);
 s_cow * cow_new_1 (const char *utf8);
 s_cow * cow_new_cast (const s_sym * const *type, const s_tag *tag);
 s_cow * cow_new_copy (const s_cow *src);
+s_cow * cow_new_tag_copy (const s_sym *type, const s_tag *src);
 
 /* Observers. */
 s_str *       cow_inspect (const s_cow *cow, s_str *dest);
diff --git a/libc3/env.c b/libc3/env.c
index b0523d9..6d243f6 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -584,18 +584,48 @@ bool env_eval_cow (s_env *env, const s_cow *cow, s_tag *dest)
   assert(env);
   assert(cow);
   assert(dest);
-  tmp = alloc(sizeof(s_cow));
+  tmp = cow_new(cow->type);
   if (! tmp)
     return false;
-  if (! env_eval_tag(env, cow_ro(cow), &tmp->r)) {
+  if (! env_eval_tag(env, cow_read_only(cow),
+                     cow_read_write(tmp))) {
     free(tmp);
     return false;
   }
+  cow_freeze(tmp);
   dest->type = TAG_COW;
   dest->data.cow = tmp;
   return true;
 }
 
+bool env_eval_equal_cow (s_env *env, const s_cow *a,
+                         const s_cow *b, s_cow **dest)
+{
+  s8 r;
+  s_cow *tmp;
+  assert(env);
+  assert(a);
+  assert(b);
+  assert(dest);
+  (void) env;
+  if ((r = compare_sym(a->type, b->type))) {
+    err_puts("env_eval_equal_cow: type mismatch");
+    assert(! "env_eval_equal_cow: type mismatch");
+    return false;
+  }
+  if ((r = compare_tag(cow_read_only(a), cow_read_only(b)))) {
+    err_puts("env_eval_equal_cow: value mismatch");
+    assert(! "env_eval_equal_cow: value mismatch");
+    return false;
+  }
+  tmp = cow_new_tag_copy(a->type, cow_read_only(a));
+  if (! tmp)
+    return false;
+  cow_freeze(tmp);
+  *dest = tmp;
+  return true;
+}
+
 bool env_eval_equal_list (s_env *env, bool macro, const s_list *a,
                           const s_list *b, s_list **dest)
 {
@@ -753,9 +783,9 @@ bool env_eval_equal_tag (s_env *env, bool macro, const s_tag *a,
     return true;
   }
   while (a->type == TAG_COW)
-    a = cow_ro(a->data.cow);
+    a = cow_read_only(a->data.cow);
   while (b->type == TAG_COW)
-    b = cow_ro(b->data.cow);
+    b = cow_read_only(b->data.cow);
   switch (a->type) {
   case TAG_COMPLEX:
   case TAG_F32:
@@ -1135,13 +1165,15 @@ bool env_eval_quote_cow (s_env *env, const s_cow *cow,
   assert(cow);
   assert(dest);
   tmp.type = TAG_COW;
-  tmp.data.cow = cow_new();
+  tmp.data.cow = cow_new(cow->type);
   if (! tmp.data.cow)
     return false;
-  if (! env_eval_quote_tag(env, cow_ro(cow), &tmp.data.cow->r)) {
+  if (! env_eval_quote_tag(env, cow_read_only(cow),
+                           cow_read_write(tmp.data.cow))) {
     cow_delete(tmp.data.cow);
     return false;
   }
+  cow_freeze(tmp.data.cow);
   *dest = tmp;
   return true;
 }
diff --git a/libc3/hash.c b/libc3/hash.c
index d699047..2529da4 100644
--- a/libc3/hash.c
+++ b/libc3/hash.c
@@ -12,6 +12,7 @@
  */
 #include "assert.h"
 #include <string.h>
+#include "cow.h"
 #include "data.h"
 #include "hash.h"
 #include "list.h"
@@ -181,9 +182,8 @@ bool hash_update_cow (t_hash *hash, const s_cow *cow)
   assert(hash);
   assert(cow);
   if (! hash_update(hash, type, sizeof(type)) ||
-      ! hash_update_tag(hash, &cow->r) ||
-      ! hash_update_bool(hash, &cow->w_is_set) ||
-      ! hash_update_tag(hash, &cow->w))
+      ! hash_update_sym(hash, &cow->type) ||
+      ! hash_update_tag(hash, cow_read_only(cow)))
     return false;
   return true;
 }
diff --git a/libc3/pcow.c b/libc3/pcow.c
index 0ea48b7..f9c7d0a 100644
--- a/libc3/pcow.c
+++ b/libc3/pcow.c
@@ -20,11 +20,11 @@ void pcow_clean (s_cow **p)
   cow_delete(*p);
 }
 
-s_cow ** pcow_init (s_cow **p)
+s_cow ** pcow_init (s_cow **p, const s_sym *type)
 {
   s_cow *tmp = NULL;
   assert(p);
-  tmp = cow_new();
+  tmp = cow_new(type);
   if (! tmp)
     return NULL;
   *p = tmp;
diff --git a/libc3/pcow.h b/libc3/pcow.h
index 0b722a9..75d1445 100644
--- a/libc3/pcow.h
+++ b/libc3/pcow.h
@@ -17,10 +17,9 @@
 
 /* Stack-allocation compatible functions, call pcow_clean after use. */
 void     pcow_clean (s_cow **p);
-s_cow ** pcow_init (s_cow **p);
+s_cow ** pcow_init (s_cow **p, const s_sym *type);
 s_cow ** pcow_init_cast (s_cow **p, const s_sym * const *type,
                          const s_tag *src);
-s_cow ** pcow_init_copy (s_cow **p,
-                             const s_cow * const *src);
+s_cow ** pcow_init_copy (s_cow **p, const s_cow * const *src);
 
 #endif /* LIBC3_PCOW_H */
diff --git a/libc3/tag.c b/libc3/tag.c
index 2840dfc..2f800ad 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -600,8 +600,14 @@ 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_ro(tag->data.cow);
+  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;
+    }
+  }
   switch (tag->type) {
   case TAG_VOID:
   case TAG_ARRAY: