Commit c66e2eaa890e1d5e21da2557b260670545b1d515

Thomas de Grivel 2023-02-11T00:36:40

wip

diff --git a/libc3/buf_inspect.c b/libc3/buf_inspect.c
index 9419a4c..1d7dba5 100644
--- a/libc3/buf_inspect.c
+++ b/libc3/buf_inspect.c
@@ -901,7 +901,7 @@ sw buf_inspect_tag (s_buf *buf, const s_tag *tag)
   case TAG_U16:     return buf_inspect_u16(buf, tag->data.u16);
   case TAG_U32:     return buf_inspect_u32(buf, tag->data.u32);
   case TAG_U64:     return buf_inspect_u64(buf, tag->data.u64);
-  case TAG_VAR:     return buf_inspect_var(buf, tag->data.var);
+  case TAG_VAR:     return buf_inspect_var(buf, tag);
   }
   assert(! "unknown tag type");
   return -1;
@@ -939,10 +939,7 @@ sw buf_inspect_tag_size (const s_tag *tag)
   case TAG_U16:      return buf_inspect_u16_size(tag->data.u16);
   case TAG_U32:      return buf_inspect_u32_size(tag->data.u32);
   case TAG_U64:      return buf_inspect_u64_size(tag->data.u64);
-  case TAG_VAR:
-    assert(! "variable");
-    errx(1, "buf_inspect_tag_size: variable");
-    return -1;
+  case TAG_VAR:      return BUF_INSPECT_VAR_SIZE;
   }
   assert(! "unknown tag type");
   return -1;
@@ -1192,10 +1189,7 @@ sw buf_inspect_var (s_buf *buf, const s_tag *var)
   if ((r = buf_inspect_uw_hex(buf, (uw) var)) < 0)
     return r;
   result += r;
-  if ((r = buf_write_1(buf, ") = ")) < 0)
-    return r;
-  result += r;
-  if ((r = buf_inspect_tag(buf, var)) < 0)
+  if ((r = buf_write_1(buf, ")")) < 0)
     return r;
   result += r;
   return result;
diff --git a/libc3/buf_inspect.h b/libc3/buf_inspect.h
index a735cf4..0263582 100644
--- a/libc3/buf_inspect.h
+++ b/libc3/buf_inspect.h
@@ -24,6 +24,7 @@
 
 #define BUF_INSPECT_U64_HEX_SIZE 16
 #define BUF_INSPECT_UW_HEX_SIZE (sizeof(uw) / 4)
+#define BUF_INSPECT_VAR_SIZE (BUF_INSPECT_UW_HEX_SIZE + 7)
 
 sw buf_inspect_bool (s_buf *buf, e_bool b);
 sw buf_inspect_bool_size (e_bool b);
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index 75f01d2..a9991b1 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -528,7 +528,6 @@ sw buf_parse_fn_pattern (s_buf *buf, s_list **dest)
     result += r;
     *dest = list_new(NULL);
     (*dest)->tag = tag;
-    tag_init_list(&(*dest)->next, NULL);
     dest = &(*dest)->next.data.list;
     if ((r = buf_ignore_spaces(buf)) < 0)
       goto restore;
@@ -545,7 +544,6 @@ sw buf_parse_fn_pattern (s_buf *buf, s_list **dest)
     if ((r = buf_ignore_spaces(buf)) < 0)
       goto restore;
     result += r;
-    continue;
   }
   r = result;
   goto clean;
diff --git a/libc3/compare.c b/libc3/compare.c
index 3489b0a..2925a86 100644
--- a/libc3/compare.c
+++ b/libc3/compare.c
@@ -292,10 +292,6 @@ s8 compare_sym (const s_sym *a, const s_sym *b)
 }
 
 s8 compare_tag (const s_tag *a, const s_tag *b) {
-  if (tag_is_bound_var(a))
-    a = a->data.var;
-  if (tag_is_bound_var(b))
-    b = b->data.var;
   if (a == b)
     return 0;
   if (!a ||
@@ -340,7 +336,7 @@ s8 compare_tag (const s_tag *a, const s_tag *b) {
   case TAG_U16: return compare_u16(a->data.u16, b->data.u16);
   case TAG_U32: return compare_u32(a->data.u32, b->data.u32);
   case TAG_U64: return compare_u64(a->data.u64, b->data.u64);
-  case TAG_VAR: return compare_ptr(a->data.var, b->data.var);
+  case TAG_VAR: return compare_ptr(a, b);
   }
   assert(! "compare_tag: error");
   errx(1, "compare_tag");
diff --git a/libc3/fn.c b/libc3/fn.c
index 2926e23..0eb799c 100644
--- a/libc3/fn.c
+++ b/libc3/fn.c
@@ -25,6 +25,14 @@ void fn_clean (s_fn *fn)
   list_delete_all(fn->algo);
 }
 
+s_fn * fn_copy (const s_fn *src, s_fn *dest)
+{
+  dest->arity = src->arity;
+  list_copy(src->pattern, &dest->pattern);
+  list_copy(src->algo, &dest->algo);
+  return dest;
+}
+
 s_fn * fn_init (s_fn *fn)
 {
   assert(fn);
diff --git a/libc3/fn.h b/libc3/fn.h
index e72a986..9a7644a 100644
--- a/libc3/fn.h
+++ b/libc3/fn.h
@@ -22,7 +22,11 @@
 
 #include "types.h"
 
-s_fn * fn_init (s_fn *fn);
+/* stack-allocation compatible functions */
 void   fn_clean (s_fn *fn);
+s_fn * fn_init (s_fn *fn);
+
+/* modifiers */
+s_fn * fn_copy (const s_fn *src, s_fn *dest);
 
 #endif /* FN_H */
diff --git a/libc3/tag.c b/libc3/tag.c
index d1531a8..7d6a7ee 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -153,17 +153,50 @@ s_tag * tag_copy (const s_tag *src, s_tag *dest)
   assert(src);
   assert(dest);
   switch (src->type.type) {
-  case TAG_CALL: call_copy(&src->data.call, &dest->data.call);    break;
+  case TAG_VAR:
+    error("tag_copy: TAG_VAR");
+  case TAG_VOID:
+    break;
+  case TAG_CALL:
+  case TAG_CALL_FN:
+  case TAG_CALL_MACRO:
+    call_copy(&src->data.call, &dest->data.call);
+    break;
+  case TAG_FN:
+    fn_copy(&src->data.fn, &dest->data.fn);
+    break;
   case TAG_INTEGER:
     integer_init(&dest->data.integer);
-    integer_copy(&src->data.integer, &dest->data.integer);        break;
-  case TAG_LIST: list_copy(src->data.list, &dest->data.list);     break;
-  case TAG_QUOTE: quote_copy(src->data.quote, &dest->data.quote); break;
-  case TAG_STR: str_copy(&src->data.str, &dest->data.str);        break;
+    integer_copy(&src->data.integer, &dest->data.integer);
+    break;
+  case TAG_LIST:
+    list_copy(src->data.list, &dest->data.list);
+    break;
+  case TAG_QUOTE:
+    quote_copy(src->data.quote, &dest->data.quote);
+    break;
+  case TAG_STR:
+    str_copy(&src->data.str, &dest->data.str);
+    break;
   case TAG_TUPLE:
-    tuple_copy(&src->data.tuple, &dest->data.tuple);              break;
-  case TAG_VAR: errx(1, "tag_copy: variable");              return NULL;
-  default: dest->data = src->data;
+    tuple_copy(&src->data.tuple, &dest->data.tuple);
+    break;
+  case TAG_BOOL:
+  case TAG_CHARACTER:
+  case TAG_F32:
+  case TAG_F64:
+  case TAG_IDENT:
+  case TAG_PTAG:
+  case TAG_S8:
+  case TAG_S16:
+  case TAG_S32:
+  case TAG_S64:
+  case TAG_SYM:
+  case TAG_U8:
+  case TAG_U16:
+  case TAG_U32:
+  case TAG_U64:
+    dest->data = src->data;
   }
   dest->type.type = src->type.type;
   return dest;
@@ -555,8 +588,7 @@ s_tag * tag_integer_reduce (s_tag *tag)
 e_bool tag_is_bound_var (const s_tag *tag)
 {
   return (tag &&
-          tag->type.type == TAG_VAR &&
-          tag->data.var);
+          tag->type.type != TAG_VAR);
 }
 
 e_bool tag_is_number (const s_tag *tag)
@@ -581,8 +613,7 @@ e_bool tag_is_number (const s_tag *tag)
 e_bool tag_is_unbound_var (const s_tag *tag)
 {
   return (tag &&
-          tag->type.type == TAG_VAR &&
-          tag->data.var == NULL);
+          tag->type.type == TAG_VAR);
 }
 
 s_tag * tag_list (s_tag *tag, s_list *x)
diff --git a/libc3/types.h b/libc3/types.h
index 5522e61..9d927fc 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -124,7 +124,6 @@ typedef s_tag       *t_facts_spec[];
 typedef SHA1_CTX     t_hash;
 typedef s_tag       *p_quote;
 typedef const s_tag *p_tag;
-typedef const s_tag *p_var;
 typedef u64          t_skiplist_height;
 
 #define CHARACTER_MAX S32_MAX
@@ -299,7 +298,6 @@ union tag_data {
   u16          u16;
   u32          u32;
   u64          u64;
-  p_var        var;
 };
 
 /* 4 */