Commit 18e2da307ba5901b46521331c320e044e1a28751

Thomas de Grivel 2024-09-16T16:41:44

wip cow, pcow, reference counting

diff --git a/ikc3/.ikc3_history b/ikc3/.ikc3_history
index ca49c99..b753c8f 100644
--- a/ikc3/.ikc3_history
+++ b/ikc3/.ikc3_history
@@ -1,6 +1,3 @@
-a
-a = 1
-a
 to_lisp(quote a = ? <- 1 ; 2)
 a = ?
 Facts.with_tags(Facts.env_facts(), KC3, :operator, a, fn (fact) { puts(a); 1 })
@@ -97,3 +94,6 @@ a = cow 1 + 1
 a
 a = cow 1 + 1
 a
+a = cow 1
+a <- 2
+a
diff --git a/libkc3/configure b/libkc3/configure
index 6e1a5ea..62a577f 100755
--- a/libkc3/configure
+++ b/libkc3/configure
@@ -73,7 +73,7 @@ LDFLAGS_COV="$LDFLAGS --coverage"
 LIBS_COV="$LIBS -lgcov"
 
 # Debug config
-CFLAGS_DEBUG="$CFLAGS -DDEBUG -O2 -g"
+CFLAGS_DEBUG="$CFLAGS -DDEBUG -O0 -g"
 LDFLAGS_DEBUG="$LDFLAGS"
 LIBS_DEBUG="$LIBS"
 
diff --git a/libkc3/cow.c b/libkc3/cow.c
index 5e581a3..9b6271b 100644
--- a/libkc3/cow.c
+++ b/libkc3/cow.c
@@ -22,17 +22,6 @@
 #include "sym.h"
 #include "tag.h"
 
-s_tag * cow_assign (s_cow *cow, const s_tag *value, s_tag *dest)
-{
-  if (! tag_init_copy(cow_read_write(cow), value))
-    return NULL;
-  if (! cow_freeze(cow))
-    return NULL;
-  dest->type = TAG_COW;
-  dest->data.cow = cow;
-  return dest;
-}
-
 void cow_clean (s_cow *cow)
 {
   assert(cow);
@@ -78,6 +67,7 @@ s_cow * cow_init (s_cow *cow, const s_sym *type)
   assert(type);
   tmp.type = type;
   tmp.list = list_new(NULL);
+  tmp.reference_count = 1;
   *cow = tmp;
   return cow;
 }
@@ -108,7 +98,7 @@ s_cow * cow_init_cast (s_cow *cow, const s_sym * const *type,
                        const s_tag *tag)
 {
   void *data;
-  s_cow tmp = {0};
+  s_cow tmp;
   assert(tag);
   assert(type);
   assert(tag);
@@ -117,8 +107,7 @@ s_cow * cow_init_cast (s_cow *cow, const s_sym * const *type,
     assert(! "cow_init_cast: cannot cast to Cow");
     return NULL;
   }
-  tmp.type = *type;
-  tmp.list = list_new(NULL);
+  cow_init(&tmp, *type);
   if (! sym_to_tag_type(*type, &tmp.list->tag.type))
     return NULL;
   if (! tag_to_pointer(&tmp.list->tag, *type, &data))
@@ -126,6 +115,7 @@ s_cow * cow_init_cast (s_cow *cow, const s_sym * const *type,
   if (! data_init_cast(data, type, tag))
     return NULL;
   cow_freeze(&tmp);
+  tmp.reference_count = 1;
   *cow = tmp;
   return cow;
 }
@@ -136,6 +126,7 @@ s_cow * cow_init_copy (s_cow *cow, const s_cow *src)
   assert(cow);
   assert(src);
   tmp.type = src->type;
+  tmp.reference_count = 1;
   tmp.list = list_new_copy(src->list);
   if (! tmp.list)
     return NULL;
@@ -162,6 +153,7 @@ s_cow * cow_init_tag_copy (s_cow *cow, const s_sym *type,
     }
   }
   tmp.type = type;
+  tmp.reference_count = 1;
   tmp.list = list_new_tag_copy(src, NULL);
   if (! tmp.list)
     return NULL;
@@ -249,6 +241,17 @@ s_tag * cow_read_write (s_cow *cow)
   return &cow->list->tag;
 }
 
+sw cow_ref (s_cow *cow)
+{
+  assert(cow);
+  if (! cow->reference_count) {
+    err_puts("cow_ref: reference count = 0");
+    assert(! "cow_ref: reference count = 0");
+    return -1;
+  }
+  return ++cow->reference_count;
+}
+
 s_cow * cow_thaw (s_cow *cow)
 {
   s_tag tmp = {0};
@@ -279,3 +282,16 @@ s_cow * cow_thaw_copy (s_cow *cow, const s_tag *src)
   cow->list->tag = tmp;
   return cow;
 }
+
+sw cow_unref (s_cow *cow)
+{
+  assert(cow);
+  if (! cow->reference_count) {
+    err_puts("cow_unref: reference count = 0");
+    assert(! "cow_unref: reference count = 0");
+    return -1;
+  }
+  if (! --cow->reference_count)
+    cow_clean(cow);
+  return cow->reference_count;
+}
diff --git a/libkc3/cow.h b/libkc3/cow.h
index 914d3a4..8fe0bd6 100644
--- a/libkc3/cow.h
+++ b/libkc3/cow.h
@@ -53,10 +53,11 @@ s_tag *       cow_read_write (s_cow *cow);
 const s_tag * cow_resolve (const s_cow *cow);
 
 /* Operators. */
-s_tag * cow_assign (s_cow *cow, const s_tag *value, s_tag *dest);
 s_cow * cow_freeze (s_cow *cow);
 s_cow * cow_freeze_copy (s_cow *cow, const s_tag *src);
+sw      cow_ref (s_cow *cow);
 s_cow * cow_thaw (s_cow *cow);
 s_cow * cow_thaw_copy (s_cow *cow, const s_tag *src);
+sw      cow_unref (s_cow *cow);
 
 #endif /* LIBKC3_COW_H */
diff --git a/libkc3/pcow.c b/libkc3/pcow.c
index 9d0ea24..bee541d 100644
--- a/libkc3/pcow.c
+++ b/libkc3/pcow.c
@@ -13,11 +13,28 @@
 #include "assert.h"
 #include "cow.h"
 #include "pcow.h"
+#include "tag.h"
+
+s_tag * pcow_assign (s_cow * const *cow, const s_tag *value,
+                     s_tag *dest)
+{
+  if (cow_ref(*cow) < 0)
+    return NULL;
+  if (! tag_init_copy(cow_read_write(*cow), value))
+    return NULL;
+  if (! cow_freeze(*cow)) {
+    return NULL;
+  }
+  dest->type = TAG_COW;
+  dest->data.cow = *cow;
+  return dest;
+}
 
 void pcow_clean (s_cow **p)
 {
   assert(p);
-  cow_delete(*p);
+  if (! cow_unref(*p))
+    cow_delete(*p);
 }
 
 s_cow ** pcow_init (s_cow **p, const s_sym *type)
@@ -44,15 +61,13 @@ s_cow ** pcow_init_cast (s_cow **p, const s_sym * const *type,
   return p;
 }
 
-s_cow ** pcow_init_copy (s_cow **p,
-                         const s_cow * const *src)
+s_cow ** pcow_init_copy (s_cow **p, s_cow * const *src)
 {
-  s_cow *tmp = NULL;
   assert(p);
   assert(src);
-  tmp = cow_new_copy(*src);
-  if (! tmp)
+  if (! src || ! *src)
     return NULL;
-  *p = tmp;
+  cow_ref(*src);
+  *p = *src;
   return p;
 }
diff --git a/libkc3/pcow.h b/libkc3/pcow.h
index e7af1bd..4247e14 100644
--- a/libkc3/pcow.h
+++ b/libkc3/pcow.h
@@ -20,6 +20,10 @@ void     pcow_clean (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, s_cow * const *src);
+
+/* Operators. */
+s_tag * pcow_assign (s_cow * const *cow, const s_tag *value,
+                     s_tag *dest);
 
 #endif /* LIBKC3_PCOW_H */
diff --git a/libkc3/tag.c b/libkc3/tag.c
index d13300a..b078dc6 100644
--- a/libkc3/tag.c
+++ b/libkc3/tag.c
@@ -87,7 +87,7 @@ s_tag * tag_assign (const s_tag *tag, const s_tag *value, s_tag *dest)
   case TAG_VAR:
     return var_assign(&tag->data.var, value, dest);
   case TAG_COW:
-    return cow_assign(tag->data.cow, value, dest);
+    return pcow_assign(&tag->data.cow, value, dest);
   default:
     break;
   }
@@ -451,8 +451,7 @@ s_tag * tag_init_copy (s_tag *tag, const s_tag *src)
     return tag;
   case TAG_COW:
     tag->type = src->type;
-    if (! pcow_init_copy(&tag->data.cow,
-                         (const s_cow * const *) &src->data.cow))
+    if (! pcow_init_copy(&tag->data.cow, &src->data.cow))
       return NULL;
     return tag;
   case TAG_F32:
diff --git a/libkc3/types.h b/libkc3/types.h
index d7c54db..43fd0a5 100644
--- a/libkc3/types.h
+++ b/libkc3/types.h
@@ -245,6 +245,7 @@ struct buf_save {
 struct cow {
   const s_sym *type;
   s_list *list;
+  sw reference_count;
 };
 
 struct fact {
diff --git a/test/ikc3/cow.kc3 b/test/ikc3/cow.kc3
new file mode 100644
index 0000000..d790861
--- /dev/null
+++ b/test/ikc3/cow.kc3
@@ -0,0 +1,8 @@
+quote cow 1
+cow 1
+quote a = cow 1
+a = cow 1
+quote a <- 2
+a <- 2
+quote a
+a
diff --git a/test/ikc3/cow.out.expected b/test/ikc3/cow.out.expected
new file mode 100644
index 0000000..93c75f8
--- /dev/null
+++ b/test/ikc3/cow.out.expected
@@ -0,0 +1,8 @@
+cow 1
+cow 1
+a = cow 1
+cow 1
+a <- 2
+cow 2
+a
+cow 2
diff --git a/test/ikc3/cow.ret.expected b/test/ikc3/cow.ret.expected
new file mode 100644
index 0000000..573541a
--- /dev/null
+++ b/test/ikc3/cow.ret.expected
@@ -0,0 +1 @@
+0