Commit 2e832877fbdb381ebfa0012b4523904c7e54e156

Thomas de Grivel 2023-03-10T18:53:22

wip

diff --git a/lib/c3/0.1/c3.facts b/lib/c3/0.1/c3.facts
index 7ffb67b..91a112e 100644
--- a/lib/c3/0.1/c3.facts
+++ b/lib/c3/0.1/c3.facts
@@ -1,9 +1,26 @@
 %{module: C3.Facts.Dump,
   version: 0x0000000000000001,
-  count: 0x0000000000000005}
+  count: 0x000000000000000A}
 {C3, :is-a, :module}
 {C3, :name, "C3"}
 {C3, :path, "c3.facts"}
+{C3, :symbol, C3.+}
+{C3.+, :cfn, cfn :tag "tag_add" (:tag, :tag)}
+{C3.+, :is_a, :operator}
+{C3.+, :operator_precedence, 1}
+{C3.+, :operator_associativity, :left}
+{C3.-, :cfn, cfn :tag "tag_sub" (:tag, :tag)}
+{C3.-, :is_a, :operator}
+{C3.-, :operator_precedence, 1}
+{C3.-, :operator_associativity, :left}
+{C3.*, :cfn, cfn :tag "tag_mul" (:tag, :tag)}
+{C3.*, :is_a, :operator}
+{C3.*, :operator_precedence, 2}
+{C3.*, :operator_associativity, :left}
+{C3./, :cfn, cfn :tag "tag_div" (:tag, :tag)}
+{C3./, :is_a, :operator}
+{C3./, :operator_precedence, 2}
+{C3./, :operator_associativity, :left}
 {C3, :symbol, C3.first}
 {C3.first, :fn, fn {
  ([a | _b]) { a }
@@ -11,4 +28,4 @@
  ({a, _b, _c}) { a }
  ({a, _b, _c, _d}) { a }
 }}
-%{hash: 0xEB60A3EFBF9FC908}
+%{hash: 0xC73C2E069FEA6136}
diff --git a/libc3/buf_inspect.c b/libc3/buf_inspect.c
index 0847ba1..67eb7e1 100644
--- a/libc3/buf_inspect.c
+++ b/libc3/buf_inspect.c
@@ -99,7 +99,7 @@ sw buf_inspect_cfn (s_buf *buf, const s_cfn *cfn)
   sw r;
   sw result = 0;
   assert(cfn);
-  if ((r = buf_inspect_sym(buf, cfn->name)) < 0)
+  if ((r = buf_inspect_str(buf, &cfn->name)) < 0)
     return r;
   result += r;
   if ((r = buf_write_1(buf, "(")) < 0)
@@ -128,7 +128,7 @@ sw buf_inspect_cfn_size (const s_cfn *cfn)
   sw r;
   sw result = 0;
   assert(cfn);
-  if ((r = buf_inspect_sym_size(cfn->name)) < 0)
+  if ((r = buf_inspect_str_size(&cfn->name)) < 0)
     return r;
   result += r;
   result += strlen("(");
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index c6370e5..83dba84 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -18,6 +18,8 @@
 #include "../libtommath/tommath.h"
 #include "c3.h"
 
+sw buf_parse_cfn_arg_types (s_buf *buf, s_list **dest);
+
 sw buf_parse_bool (s_buf *buf, bool *p)
 {
   character c;
@@ -60,6 +62,10 @@ sw buf_parse_call (s_buf *buf, s_call *dest)
   s_buf_save save;
   assert(buf);
   assert(dest);
+  if ((r = buf_parse_call_op(buf, dest)) < 0)
+    return r;
+  if (r > 0)
+    return r;
   buf_save_init(buf, &save);
   if ((r = buf_parse_ident(buf, &dest->ident)) <= 0)
     goto clean;
@@ -170,6 +176,129 @@ sw buf_parse_call_args_paren (s_buf *buf, s_call *dest)
   return r;
 }
 
+sw buf_parse_call_op (s_buf *buf, s_call *dest)
+{
+  s_tag *left;
+  sw r;
+  sw result = 0;
+  s_buf_save save;
+  assert(buf);
+  assert(dest);
+  buf_save_init(buf, &save);
+  left = tag_new();
+  if ((r = buf_parse_tag(buf, left)) <= 0)
+    return r;
+  result += r;
+  if ((r = buf_parse_call_op_precedence(buf, dest, left, 0)) < 0)
+    return r;
+  result += r;
+  r = result;
+  goto clean;
+ restore:
+  buf_save_restore_rpos(buf, &save);
+ clean:
+  buf_save_clean(buf, &save);
+  return r;
+}
+
+sw buf_parse_call_op_precedence (s_buf *buf, s_call *dest, s_tag *left,
+                                 u8 min_precedence)
+{
+  s_ident op;
+  sw r;
+  sw result = 0;
+  s_tag right;
+  if ((r = buf_parse_ident(buf, &op)) < 0)
+    
+}
+
+sw buf_parse_cfn (s_buf *buf, s_cfn *dest)
+{
+  sw r;
+  sw result = 0;
+  s_buf_save save;
+  s_cfn tmp;
+  assert(buf);
+  assert(dest);
+  buf_save_init(buf, &save);
+  if ((r = buf_read_1(buf, "cfn")) <= 0)
+    goto clean;
+  result += r;
+  if ((r = buf_ignore_spaces(buf)) <= 0)
+    goto restore;
+  result += r;
+  if ((r = buf_parse_sym(buf, &tmp.result_type)) <= 0)
+    goto restore;
+  result += r;
+  if ((r = buf_ignore_spaces(buf)) <= 0)
+    goto restore;
+  result += r;
+  if ((r = buf_parse_str(buf, &tmp.name)) <= 0)
+    goto restore;
+  result += r;
+  if ((r = buf_ignore_spaces(buf)) <= 0)
+    goto restore;
+  result += r;
+  if ((r = buf_parse_cfn_arg_types(buf, &tmp.arg_types)) <= 0)
+    goto restore;
+  result += r;
+  *dest = tmp;
+  r = result;
+  goto clean;
+ restore:
+  buf_save_restore_rpos(buf, &save);
+ clean:
+  buf_save_clean(buf, &save);
+  return r;
+}
+
+sw buf_parse_cfn_arg_types (s_buf *buf, s_list **dest)
+{
+  sw r;
+  sw result = 0;
+  s_buf_save save;
+  s_list **tail;
+  s_list *tmp;
+  assert(buf);
+  assert(dest);
+  buf_save_init(buf, &save);
+  if ((r = buf_read_1(buf, "(")) <= 0)
+    goto clean;
+  result += r;
+  if ((r = buf_ignore_spaces(buf)) < 0)
+    goto restore;
+  result += r;
+  tail = &tmp;
+  while (1) {
+    *tail = list_new(NULL);
+    if ((r = buf_parse_tag_sym(buf, &(*tail)->tag)) <= 0)
+      goto restore;
+    result += r;
+    if ((r = buf_ignore_spaces(buf)) < 0)
+      goto restore;
+    result += r;
+    if ((r = buf_read_1(buf, ",")) < 0)
+      goto restore;
+    if (! r)
+      break;
+    result += r;
+    if ((r = buf_ignore_spaces(buf)) < 0)
+      goto restore;
+    result += r;
+  }
+  if ((r = buf_read_1(buf, ")")) <= 0)
+    goto restore;
+  result += r;
+  *dest = tmp;
+  r = result;
+  goto clean;
+ restore:
+  buf_save_restore_rpos(buf, &save);
+ clean:
+  buf_save_clean(buf, &save);
+  return r;
+}
+
 sw buf_parse_character (s_buf *buf, character *dest)
 {
   character c;
@@ -1344,6 +1473,7 @@ sw buf_parse_tag (s_buf *buf, s_tag *dest)
       (r = buf_parse_tag_str(buf, dest)) != 0 ||
       (r = buf_parse_tag_tuple(buf, dest)) != 0 ||
       (r = buf_parse_tag_quote(buf, dest)) != 0 ||
+      (r = buf_parse_tag_cfn(buf, dest)) != 0 ||
       (r = buf_parse_tag_fn(buf, dest)) != 0 ||
       (r = buf_parse_tag_call(buf, dest)) != 0 ||
       (r = buf_parse_tag_ident(buf, dest)) != 0 ||
@@ -1383,6 +1513,14 @@ sw buf_parse_tag_call (s_buf *buf, s_tag *dest)
   return r;
 }
 
+sw buf_parse_tag_cfn (s_buf *buf, s_tag *dest)
+{
+  sw r;
+  if ((r = buf_parse_cfn(buf, &dest->data.cfn)) > 0)
+    dest->type.type = TAG_CFN;
+  return r;
+}
+
 sw buf_parse_tag_character (s_buf *buf, s_tag *dest)
 {
   sw r;
diff --git a/libc3/buf_parse.h b/libc3/buf_parse.h
index f6114d2..579c04c 100644
--- a/libc3/buf_parse.h
+++ b/libc3/buf_parse.h
@@ -32,6 +32,7 @@
  */
 
 sw buf_parse_bool (s_buf *buf, bool *dest);
+sw buf_parse_cfn (s_buf *buf, s_cfn *dest);
 sw buf_parse_character (s_buf *buf, character *dest);
 sw buf_parse_digit_bin(s_buf *buf, u8 *dest);
 sw buf_parse_digit_hex (s_buf *buf, u8 *dest);
@@ -46,6 +47,9 @@ sw buf_parse_fn_algo (s_buf *buf, s_list **dest);
 sw buf_parse_fn_pattern (s_buf *buf, s_list **dest);
 sw buf_parse_call (s_buf *buf, s_call *dest);
 sw buf_parse_call_args_paren (s_buf *buf, s_call *dest);
+sw buf_parse_call_op (s_buf *buf, s_call *dest);
+sw buf_parse_call_op_precedence (s_buf *buf, s_call *dest, s_tag *left,
+                                 u8 min_precedence);
 sw buf_parse_comments (s_buf *buf);
 sw buf_parse_integer (s_buf *buf, s_integer *dest);
 sw buf_parse_integer_unsigned_bin (s_buf *buf, s_integer *dest);
@@ -65,6 +69,7 @@ sw buf_parse_sym (s_buf *buf, const s_sym **dest);
 sw buf_parse_tag (s_buf *buf, s_tag *dest);
 sw buf_parse_tag_bool (s_buf *buf, s_tag *dest);
 sw buf_parse_tag_call (s_buf *buf, s_tag *dest);
+sw buf_parse_tag_cfn (s_buf *buf, s_tag *dest);
 sw buf_parse_tag_character (s_buf *buf, s_tag *dest);
 sw buf_parse_tag_fn (s_buf *buf, s_tag *dest);
 sw buf_parse_tag_ident (s_buf *buf, s_tag *dest);
diff --git a/libc3/cfn.c b/libc3/cfn.c
index 0cbb147..23b16b4 100644
--- a/libc3/cfn.c
+++ b/libc3/cfn.c
@@ -122,7 +122,6 @@ s_cfn * cfn_set_type (s_cfn *cfn, s_list *arg_type,
 
 ffi_type * cfn_sym_to_ffi_type (const s_sym *sym)
 {
-  assert(tag);
   if (sym == sym_1("s8"))
     return &ffi_type_sint8;
   if (sym == sym_1("s16"))
@@ -150,7 +149,6 @@ ffi_type * cfn_sym_to_ffi_type (const s_sym *sym)
 
 e_tag_type cfn_sym_to_tag_type (const s_sym *sym)
 {
-  assert(tag);
   if (sym == sym_1("void"))
     return TAG_VOID;
   if (sym == sym_1("bool"))
diff --git a/libc3/compare.c b/libc3/compare.c
index 7e8cc24..deb3b43 100644
--- a/libc3/compare.c
+++ b/libc3/compare.c
@@ -60,7 +60,7 @@ s8 compare_cfn (const s_cfn *a, const s_cfn *b)
     return -1;
   if (!b)
     return 1;
-  if ((r = compare_sym(a->name, b->name)))
+  if ((r = compare_str(&a->name, &b->name)))
     return r;
   return compare_list(a->arg_types, b->arg_types);
 }
diff --git a/libc3/hash.c b/libc3/hash.c
index 447db5f..4376896 100644
--- a/libc3/hash.c
+++ b/libc3/hash.c
@@ -85,7 +85,7 @@ void hash_update_cfn (t_hash *hash, const s_cfn *cfn)
   assert(hash);
   assert(cfn);
   hash_update(hash, type, sizeof(type));
-  hash_update_sym(hash, cfn->name);
+  hash_update_str(hash, &cfn->name);
   hash_update_list(hash, cfn->arg_types);
 }
 
diff --git a/libc3/types.h b/libc3/types.h
index ffe11ea..14a8fbf 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -140,15 +140,6 @@ struct buf_save {
   uw wpos;
 };
 
-struct cfn {
-  const s_sym *name;
-  void *p;
-  u8 arity;
-  const s_sym *result_type;
-  s_list *arg_types;
-  ffi_cif cif;
-};
-
 struct fact {
   const s_tag *subject;
   const s_tag *predicate;
@@ -288,6 +279,15 @@ struct call {
   s_fn *fn;
 };
 
+struct cfn {
+  s_str name;
+  void *p;
+  u8 arity;
+  const s_sym *result_type;
+  s_list *arg_types;
+  ffi_cif cif;
+};
+
 struct log {
   s_buf  buf;
   u64    count;