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