Commit 78aced3b4ef9ef0b9955c212294655cee9210fa2

Thomas de Grivel 2023-10-20T12:38:38

wip various bugfixes

diff --git a/lib/c3/0.1/c3.facts b/lib/c3/0.1/c3.facts
index 1daf5cf..9c1a51b 100644
--- a/lib/c3/0.1/c3.facts
+++ b/lib/c3/0.1/c3.facts
@@ -143,7 +143,7 @@ replace {C3.operator19, :operator_precedence, 9}
 replace {C3.operator19, :operator_associativity, :left}
 add {C3, :operator, C3.operator20}
 replace {C3.operator20, :is_a, :operator}
-replace {C3.operator20, :symbol, :|}
+replace {C3.operator20, :symbol, :bor}
 replace {C3.operator20, :arity, 2}
 replace {C3.operator20, :cfn, cfn :bool "tag_bor" (Tag, Tag)}
 replace {C3.operator20, :operator_precedence, 10}
diff --git a/libc3/buf_inspect.c b/libc3/buf_inspect.c
index 1d4f9aa..5ed4fd2 100644
--- a/libc3/buf_inspect.c
+++ b/libc3/buf_inspect.c
@@ -251,7 +251,7 @@ sw buf_inspect_call (s_buf *buf, const s_call *call)
     return buf_inspect_cast(buf, call);
   if (operator_find(&call->ident, 1))
     return buf_inspect_call_op_unary(buf, call);
-  if ((op_precedence = operator_precedence(&call->ident)) > 0)
+  if ((op_precedence = operator_precedence(&call->ident, 2)) > 0)
     return buf_inspect_call_op(buf, call, op_precedence);
   if ((r = buf_inspect_ident(buf, &call->ident)) < 0)
     return r;
@@ -350,7 +350,7 @@ sw buf_inspect_call_op (s_buf *buf, const s_call *call, s8 op_precedence)
   left = &call->arguments->tag;
   right = &list_next(call->arguments)->tag;
   if (left->type == TAG_CALL && 
-      (precedence = operator_precedence(&left->data.call.ident))
+      (precedence = operator_precedence(&left->data.call.ident, 2))
       < op_precedence) {
     paren = true;
     if ((r = buf_write_1(buf, "(")) < 0)
@@ -377,7 +377,7 @@ sw buf_inspect_call_op (s_buf *buf, const s_call *call, s8 op_precedence)
     return r;
   result += r;
   if (right->type == TAG_CALL && 
-      (precedence = operator_precedence(&right->data.call.ident))
+      (precedence = operator_precedence(&right->data.call.ident, 2))
       < op_precedence) {
     paren = true;
     if ((r = buf_write_1(buf, "(")) < 0)
@@ -453,7 +453,7 @@ sw buf_inspect_call_size (const s_call *call)
   sw result = 0;
   if (operator_find(&call->ident, 1))
     return buf_inspect_call_op_unary_size(call);
-  if ((op_precedence = operator_precedence(&call->ident)) > 0)
+  if ((op_precedence = operator_precedence(&call->ident, 2)) > 0)
     return buf_inspect_call_op_size(call, op_precedence);
   if ((r = buf_inspect_ident_size(&call->ident)) < 0)
     return r;
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index ca6cd4d..10878e8 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -596,7 +596,7 @@ sw buf_parse_call_op (s_buf *buf, s_call *dest)
   if ((r = buf_parse_ident_peek(buf, &next_op)) <= 0)
     goto restore;
   if (! operator_find(&next_op, 2) ||
-      operator_precedence(&next_op) < 0) {
+      operator_precedence(&next_op, 2) < 0) {
     r = 0;
     goto restore;
   }
@@ -642,7 +642,7 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, u8 min_precedence)
   if ((r = buf_parse_ident_peek(buf, &next_op)) <= 0)
     goto restore;
   if (! operator_find(&next_op, 2) ||
-      (op_precedence = operator_precedence(&next_op)) < 0) {
+      (op_precedence = operator_precedence(&next_op, 2)) < 0) {
     r = 0;
     goto restore;
   }
@@ -668,10 +668,10 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, u8 min_precedence)
     r = buf_parse_ident_peek(buf, &next_op);
     if (r <= 0)
       break;
-    next_op_precedence = operator_precedence(&next_op);
+    next_op_precedence = operator_precedence(&next_op, 2);
     while (r > 0 && operator_find(&next_op, 2) &&
            (next_op_precedence >= op_precedence ||
-            (operator_is_right_associative(&next_op) &&
+            (operator_is_right_associative(&next_op, 2) &&
              next_op_precedence == op_precedence))) {
       call_init_op(&tmp2);
       tmp2.arguments->tag = *right;
@@ -693,7 +693,7 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, u8 min_precedence)
       }
       r = buf_parse_ident_peek(buf, &next_op);
       if (r > 0)
-        next_op_precedence = operator_precedence(&next_op);
+        next_op_precedence = operator_precedence(&next_op, 2);
     }
     if (r <= 0 || (op_precedence = next_op_precedence) < min_precedence)
       break;
diff --git a/libc3/env.c b/libc3/env.c
index 7c6a997..5ca70d0 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -751,7 +751,7 @@ bool env_module_maybe_reload (const s_sym *module, s_env *env,
 }
 
 s_ident * env_operator_call_ident (s_env *env, const s_ident *op,
-                                   s_ident *dest, u8 arity)
+                                   u8 arity, s_ident *dest)
 {
   s_facts_with_cursor cursor;
   s_tag tag_arity;
@@ -843,9 +843,12 @@ bool env_operator_find (s_env *env, const s_ident *op, u8 arity)
   return false;
 }
 
-bool env_operator_is_right_associative (s_env *env, const s_ident *op)
+bool env_operator_is_right_associative (s_env *env, const s_ident *op,
+                                        u8 arity)
 {
   s_facts_with_cursor cursor;
+  s_tag tag_arity;
+  s_tag tag_arity_u8;
   s_tag tag_is_a;
   s_tag tag_module;
   s_tag tag_module_name;
@@ -860,6 +863,8 @@ bool env_operator_is_right_associative (s_env *env, const s_ident *op)
   assert(op);
   tmp = *op;
   ident_resolve_module(&tmp, env);
+  tag_init_1(  &tag_arity, ":arity");
+  tag_init_u8( &tag_arity_u8, arity);
   tag_init_1(  &tag_is_a, ":is_a");
   tag_init_1(  &tag_module, ":module");
   tag_init_sym(&tag_module_name, tmp.module);
@@ -874,6 +879,7 @@ bool env_operator_is_right_associative (s_env *env, const s_ident *op)
       &tag_operator, &tag_operator_var, NULL,
       &tag_operator_var, &tag_is_a, &tag_operator,
       &tag_symbol, &tag_sym,
+      &tag_arity, &tag_arity_u8,
       &tag_operator_assoc, &tag_operator_assoc_var,
       NULL, NULL });
   if (facts_with_cursor_next(&cursor)) {
@@ -893,10 +899,12 @@ bool env_operator_is_right_associative (s_env *env, const s_ident *op)
   return false;
 }
 
-s8 env_operator_precedence (s_env *env, const s_ident *op)
+s8 env_operator_precedence (s_env *env, const s_ident *op, u8 arity)
 {
   s_facts_with_cursor cursor;
   s8 r = -1;
+  s_tag tag_arity;
+  s_tag tag_arity_u8;
   s_tag tag_is_a;
   s_tag tag_module;
   s_tag tag_module_name;
@@ -911,6 +919,8 @@ s8 env_operator_precedence (s_env *env, const s_ident *op)
   assert(op);
   tmp = *op;
   ident_resolve_module(&tmp, env);
+  tag_init_1(  &tag_arity, ":arity");
+  tag_init_u8( &tag_arity_u8, arity);
   tag_init_1(  &tag_is_a, ":is_a");
   tag_init_1(  &tag_module, ":module");
   tag_init_sym(&tag_module_name, tmp.module);
@@ -933,8 +943,9 @@ s8 env_operator_precedence (s_env *env, const s_ident *op)
   }
   else
     warnx("env_operator_precedence: "
-          "operator %s not found in module %s",
+          "operator %s/%d not found in module %s",
           tmp.sym->str.ptr.ps8,
+          arity,
           tmp.module->str.ptr.ps8);
   facts_with_cursor_clean(&cursor);
   return r;
diff --git a/libc3/env.h b/libc3/env.h
index 1ce730c..ac51116 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -58,11 +58,13 @@ bool       env_module_load (const s_sym *module, s_env *env,
 bool       env_module_maybe_reload (const s_sym *module, s_env *env,
                                     s_facts *facts);
 s_ident *  env_operator_call_ident (s_env *env, const s_ident *op,
-                                    s_ident *dest, u8 arity);
+                                    u8 arity, s_ident *dest);
 bool       env_operator_find (s_env *env, const s_ident *op, u8 arity);
 bool       env_operator_is_right_associative (s_env *env,
-                                              const s_ident *op);
-s8         env_operator_precedence (s_env *env, const s_ident *op);
+                                              const s_ident *op,
+                                              u8 arity);
+s8         env_operator_precedence (s_env *env, const s_ident *op,
+                                    u8 arity);
 bool       env_tag_ident_is_bound (const s_env *env, const s_tag *tag,
                                    s_facts *facts);
 
diff --git a/libc3/operator.c b/libc3/operator.c
index bc30884..890bfb7 100644
--- a/libc3/operator.c
+++ b/libc3/operator.c
@@ -16,7 +16,7 @@
 s_ident * operator_call_ident (const s_ident *op, u8 arity,
                                s_ident *dest)
 {
-  return env_operator_call_ident(&g_c3_env, op, dest, arity);
+  return env_operator_call_ident(&g_c3_env, op, arity, dest);
 }
 
 bool operator_find (const s_ident *op, u8 arity)
@@ -24,12 +24,12 @@ bool operator_find (const s_ident *op, u8 arity)
   return env_operator_find(&g_c3_env, op, arity);
 }
 
-bool operator_is_right_associative (const s_ident *op)
+bool operator_is_right_associative (const s_ident *op, u8 arity)
 {
-  return env_operator_is_right_associative(&g_c3_env, op);
+  return env_operator_is_right_associative(&g_c3_env, op, arity);
 }
 
-s8 operator_precedence (const s_ident *op)
+s8 operator_precedence (const s_ident *op, u8 arity)
 {
-  return env_operator_precedence(&g_c3_env, op);
+  return env_operator_precedence(&g_c3_env, op, arity);
 }
diff --git a/libc3/operator.h b/libc3/operator.h
index cba13d1..3bf2e37 100644
--- a/libc3/operator.h
+++ b/libc3/operator.h
@@ -19,7 +19,7 @@
 s_ident * operator_call_ident (const s_ident *op, u8 arity,
                                s_ident *dest);
 bool      operator_find (const s_ident *op, u8 arity);
-bool      operator_is_right_associative (const s_ident *op);
-s8        operator_precedence (const s_ident *op);
+bool      operator_is_right_associative (const s_ident *op, u8 arity);
+s8        operator_precedence (const s_ident *op, u8 arity);
 
 #endif /* OPERATOR_H */
diff --git a/test/buf_parse_test.c b/test/buf_parse_test.c
index cbadf28..7721b02 100644
--- a/test/buf_parse_test.c
+++ b/test/buf_parse_test.c
@@ -808,12 +808,10 @@ TEST_CASE_END(buf_parse_call)
 TEST_CASE(buf_parse_call_op)
 {
   BUF_PARSE_TEST_CALL_OP("1 + 2");
-  /*
   BUF_PARSE_TEST_CALL_OP("1 + 2 + 3");
   BUF_PARSE_TEST_CALL_OP("1 + 2 / 3");
   BUF_PARSE_TEST_CALL_OP("1 + 2 / 3 * 4");
   BUF_PARSE_TEST_CALL_OP("1 + 2 / 3 * 4 - 5");
-  */
 }
 TEST_CASE_END(buf_parse_call_op)