Commit b5109da22de31b310e1d812243b4d30f7fa86a48

Thomas de Grivel 2024-08-31T10:27:10

test ikc3 defoperator OK

diff --git a/libkc3/buf_inspect.c b/libkc3/buf_inspect.c
index 29efd71..9258bd8 100644
--- a/libkc3/buf_inspect.c
+++ b/libkc3/buf_inspect.c
@@ -474,7 +474,7 @@ sw buf_inspect_call (s_buf *buf, const s_call *call)
   bool b;
   bool op;
   u8 op_arity;
-  s8 op_precedence;
+  sw op_precedence;
   sw r;
   sw result = 0;
   const s_sym *sym;
@@ -504,7 +504,7 @@ sw buf_inspect_call (s_buf *buf, const s_call *call)
   if (op_arity == 1)
     return buf_inspect_call_op_unary(buf, call);
   if (op_arity == 2 &&
-      (op_precedence = operator_precedence(&call->ident)) > 0)
+      operator_precedence(&call->ident, &op_precedence))
     return buf_inspect_call_op(buf, call, op_precedence);
   if (! ident_is_special_operator(&call->ident, &b))
     return -1;
@@ -824,25 +824,26 @@ sw buf_inspect_call_if_then_else_size (s_pretty *pretty, const s_call *call)
   return result;
 }
 
-sw buf_inspect_call_op (s_buf *buf, const s_call *call, s8 op_precedence)
+sw buf_inspect_call_op (s_buf *buf, const s_call *call, sw op_precedence)
 {
   s_ident ident;
   s_tag *left;
   bool op;
-  bool paren = false;
-  s8 precedence;
+  bool paren;
+  sw precedence;
   sw r;
   sw result = 0;
   s_tag *right;
   left = &call->arguments->tag;
   assert(list_next(call->arguments));
   right = &list_next(call->arguments)->tag;
+  paren = false;
   if (left->type == TAG_CALL) {
     if (! operator_find(&left->data.call.ident, &op))
       return -1;
     if (op &&
-        (precedence = operator_precedence(&left->data.call.ident))
-        < op_precedence) {
+        operator_precedence(&left->data.call.ident, &precedence) &&
+        precedence < op_precedence) {
       paren = true;
       if ((r = buf_write_1(buf, "(")) < 0)
         return r;
@@ -868,19 +869,18 @@ sw buf_inspect_call_op (s_buf *buf, const s_call *call, s8 op_precedence)
   if ((r = buf_write_1(buf, " ")) < 0)
     return r;
   result += r;
+  paren = false;
   if (right->type == TAG_CALL) {
     if (! operator_find(&right->data.call.ident, &op))
       return -1;
     if (op &&
-        (precedence = operator_precedence(&right->data.call.ident))
-        < op_precedence) {
+        operator_precedence(&right->data.call.ident, &precedence) &&
+        precedence < op_precedence) {
       paren = true;
       if ((r = buf_write_1(buf, "(")) < 0)
         return r;
       result += r;
     }
-    else
-      paren = false;
   }
   if ((r = buf_inspect_tag(buf, right)) < 0)
     return r;
@@ -893,13 +893,14 @@ sw buf_inspect_call_op (s_buf *buf, const s_call *call, s8 op_precedence)
   return result;
 }
 
-sw buf_inspect_call_op_size (s_pretty *pretty, const s_call *call, s8 op_precedence)
+sw buf_inspect_call_op_size (s_pretty *pretty, const s_call *call,
+                             sw op_precedence)
 {
   s_ident ident;
   s_tag *left;
   bool op;
   bool paren = false;
-  s8 precedence;
+  sw precedence;
   sw r;
   sw result = 0;
   s_tag *right;
@@ -910,8 +911,8 @@ sw buf_inspect_call_op_size (s_pretty *pretty, const s_call *call, s8 op_precede
     if (! operator_find(&left->data.call.ident, &op))
       return -1;
     if (op &&
-        (precedence = operator_precedence(&left->data.call.ident))
-        < op_precedence) {
+        operator_precedence(&left->data.call.ident, &precedence) &&
+        precedence < op_precedence) {
       paren = true;
       if ((r = buf_write_1_size(pretty, "(")) < 0)
         return r;
@@ -941,8 +942,8 @@ sw buf_inspect_call_op_size (s_pretty *pretty, const s_call *call, s8 op_precede
     if (! operator_find(&right->data.call.ident, &op))
       return -1;
     if (op &&
-        (precedence = operator_precedence(&right->data.call.ident))
-        < op_precedence) {
+        operator_precedence(&right->data.call.ident, &precedence) &&
+        precedence < op_precedence) {
       paren = true;
       if ((r = buf_write_1_size(pretty, "(")) < 0)
         return r;
@@ -1055,7 +1056,7 @@ sw buf_inspect_call_size (s_pretty *pretty, const s_call *call)
   bool b;
   bool op;
   u8 op_arity;
-  s8 op_precedence;
+  sw op_precedence;
   sw r;
   sw result = 0;
   const s_sym *sym;
@@ -1085,7 +1086,7 @@ sw buf_inspect_call_size (s_pretty *pretty, const s_call *call)
   if (op_arity == 1)
     return buf_inspect_call_op_unary_size(pretty, call);
   if (op_arity == 2 &&
-      (op_precedence = operator_precedence(&call->ident)) > 0)
+      operator_precedence(&call->ident, &op_precedence))
     return buf_inspect_call_op_size(pretty, call, op_precedence);
   if (! ident_is_special_operator(&call->ident, &b))
     return -1;
diff --git a/libkc3/buf_inspect.h b/libkc3/buf_inspect.h
index df1453c..1bcb97e 100644
--- a/libkc3/buf_inspect.h
+++ b/libkc3/buf_inspect.h
@@ -87,9 +87,9 @@ sw buf_inspect_call_if_then_else (s_buf *buf, const s_call *call);
 sw buf_inspect_call_if_then_else_size (s_pretty *pretty,
                                        const s_call *call);
 sw buf_inspect_call_op (s_buf *buf, const s_call *call,
-                        s8 op_precedence);
+                        sw op_precedence);
 sw buf_inspect_call_op_size (s_pretty *pretty, const s_call *call,
-                             s8 op_precedence);
+                             sw op_precedence);
 sw buf_inspect_call_op_unary (s_buf *buf, const s_call *call);
 sw buf_inspect_call_op_unary_size (s_pretty *pretty,
                                    const s_call *call);
diff --git a/libkc3/buf_parse.c b/libkc3/buf_parse.c
index a486966..370ba13 100644
--- a/libkc3/buf_parse.c
+++ b/libkc3/buf_parse.c
@@ -875,7 +875,8 @@ sw buf_parse_call_args_paren (s_buf *buf, s_call *dest)
 
 sw buf_parse_call_op (s_buf *buf, s_call *dest)
 {
-  s_ident next_op;
+  s_ident op;
+  sw op_precedence;
   sw r;
   sw result = 0;
   s_buf_save save;
@@ -895,10 +896,10 @@ sw buf_parse_call_op (s_buf *buf, s_call *dest)
   if ((r = buf_ignore_spaces_but_newline(buf)) < 0)
     goto restore;
   result += r;
-  if ((r = buf_peek_ident(buf, &next_op)) <= 0)
+  if ((r = buf_peek_ident(buf, &op)) <= 0)
     goto restore;
-  if (! operator_resolve(&next_op, 2, &next_op) ||
-      operator_precedence(&next_op) < 0) {
+  if (! operator_resolve(&op, 2, &op) ||
+      ! operator_precedence(&op, &op_precedence)) {
     r = 0;
     goto restore;
   }
@@ -943,17 +944,18 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, sw min_precedence)
   if ((r = buf_peek_ident(buf, &next_op)) <= 0)
     goto restore;
   if (! operator_resolve(&next_op, 2, &next_op) ||
-      (op_precedence = operator_precedence(&next_op)) < 0) {
+      ! operator_precedence(&next_op, &next_op_precedence)) {
     r = 0;
     goto restore;
   }
-  while (r > 0 && op_precedence >= min_precedence) {
+  while (r > 0 && next_op_precedence >= min_precedence) {
     if ((r = buf_parse_ident(buf, &next_op)) <= 0)
       goto restore;
     result += r;
     if (! operator_resolve(&next_op, 2, &next_op))
       goto restore;
     op = next_op;
+    op_precedence = next_op_precedence;
     tmp.ident = op;
     if ((r = buf_ignore_spaces(buf)) < 0)
       goto restore;
@@ -974,21 +976,21 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, sw min_precedence)
     if (! operator_resolve(&next_op, 2, &next_op) &&
         ! operator_resolve(&next_op, 1, &next_op))
       break;
-    next_op_precedence = operator_precedence(&next_op);
+    operator_precedence(&next_op, &next_op_precedence);
     while (1) {
       if (r <= 0 ||
           operator_arity(&next_op) != 2) {
         break;
       }
-      if (next_op_precedence <= op_precedence) {
-        if (! operator_is_right_associative(&next_op, &b)) {
-          r = -1;
-          break;
-        }
-        if (! b ||
-            next_op_precedence != op_precedence) {
-          break;
-        }
+      if (next_op_precedence < op_precedence)
+        break;
+      if (! operator_is_right_associative(&op, &b)) {
+        r = -1;
+        break;
+      }
+      if (! b ||
+          next_op_precedence != op_precedence) {
+        break;
       }
       call_init_op(&tmp2);
       tmp2.arguments->tag = *right;
@@ -1014,7 +1016,7 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, sw min_precedence)
       r = buf_peek_ident(buf, &next_op);
       if (r > 0 &&
           (! operator_resolve(&next_op, 2, &next_op) ||
-           (next_op_precedence = operator_precedence(&next_op)) < 0)) {
+           ! operator_precedence(&next_op, &next_op_precedence))) {
         r = 0;
         break;
       }
diff --git a/libkc3/env.c b/libkc3/env.c
index 5a28f02..ca57dfa 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -3038,36 +3038,38 @@ bool * env_operator_is_right_associative (s_env *env, const s_ident *op,
   return dest;
 }
 
-s8 env_operator_precedence (s_env *env, const s_ident *op)
+sw * env_operator_precedence (s_env *env, const s_ident *op, sw *dest)
 {
   s_facts_cursor cursor;
   const s_fact *fact;
-  s8 r = -1;
+  const s_sym *sym_sw = &g_sym_Sw;
   s_tag tag_op;
   s_tag tag_precedence;
   s_tag tag_var;
+  sw tmp;
   assert(env);
   assert(op);
   tag_init_ident(&tag_op, op);
   tag_init_sym(  &tag_precedence, &g_sym_operator_precedence);
-  tag_init_var(  &tag_var, &g_sym_U8);
+  tag_init_var(  &tag_var, &g_sym_Tag);
   if (! facts_with_tags(&env->facts, &cursor, &tag_op, &tag_precedence,
                         &tag_var))
-    return -1;
+    return NULL;
   if (! facts_cursor_next(&cursor, &fact))
-    return -1;
+    return NULL;
   if (fact) {
-    r = tag_var.data.u8;
+    sw_init_cast(&tmp, &sym_sw, &tag_var);
   }
   else {
     err_write_1("env_operator_precedence: precedence for operator ");
     err_write_1(op->sym->str.ptr.pchar);
     err_write_1(" not found in module ");
     err_puts(op->module->str.ptr.pchar);
-    r = -1;
+    return NULL;
   }
   facts_cursor_clean(&cursor);
-  return r;
+  *dest = tmp;
+  return dest;
 }
 
 s_ident * env_operator_resolve (s_env *env, const s_ident *op,
diff --git a/libkc3/env.h b/libkc3/env.h
index c0ac251..1b12f42 100644
--- a/libkc3/env.h
+++ b/libkc3/env.h
@@ -93,7 +93,8 @@ s_ident *     env_operator_ident (s_env *env, const s_ident *op,
 bool *        env_operator_is_right_associative (s_env *env,
                                                  const s_ident *op,
                                                  bool *dest);
-s8            env_operator_precedence (s_env *env, const s_ident *op);
+sw *          env_operator_precedence (s_env *env, const s_ident *op,
+                                       sw *dest);
 s_ident *     env_operator_resolve (s_env *env, const s_ident *op,
                                     u8 arity, s_ident *dest);
 const s_sym ** env_operator_symbol (s_env *env, const s_ident *op,
diff --git a/libkc3/operator.c b/libkc3/operator.c
index e7e4ed4..a0c5c52 100644
--- a/libkc3/operator.c
+++ b/libkc3/operator.c
@@ -33,9 +33,9 @@ bool * operator_is_right_associative (const s_ident *op, bool *dest)
   return env_operator_is_right_associative(&g_kc3_env, op, dest);
 }
 
-s8 operator_precedence (const s_ident *op)
+sw * operator_precedence (const s_ident *op, sw *dest)
 {
-  return env_operator_precedence(&g_kc3_env, op);
+  return env_operator_precedence(&g_kc3_env, op, dest);
 }
 
 s_ident * operator_resolve (const s_ident *op, u8 arity,
diff --git a/libkc3/operator.h b/libkc3/operator.h
index 74a6901..16c82c1 100644
--- a/libkc3/operator.h
+++ b/libkc3/operator.h
@@ -21,7 +21,7 @@ bool *         operator_find (const s_ident *op, bool *dest);
 s_ident *      operator_ident (const s_ident *op, s_ident *dest);
 bool *         operator_is_right_associative (const s_ident *op,
                                               bool *dest);
-s8             operator_precedence (const s_ident *op);
+sw *           operator_precedence (const s_ident *op, sw *dest);
 s_ident *      operator_resolve (const s_ident *ident, u8 arity,
                                  s_ident *dest);
 const s_sym ** operator_symbol (const s_ident *op, const s_sym **dest);
diff --git a/test/ikc3/defoperator.kc3 b/test/ikc3/defoperator.kc3
index 8121e94..92365f0 100644
--- a/test/ikc3/defoperator.kc3
+++ b/test/ikc3/defoperator.kc3
@@ -1,7 +1,7 @@
 quote %KC3.Operator{symbol_value: void}
 %KC3.Operator{symbol_value: void}
-quote def operator_muul = %KC3.Operator{sym: :****, symbol_value: cfn Tag "tag_mul" (Tag, Tag, Result), operator_precedence: 11, operator_associativity: :left}
-def operator_muul = %KC3.Operator{sym: :****, symbol_value: cfn Tag "tag_mul" (Tag, Tag, Result), operator_precedence: 11, operator_associativity: :left}
+quote def operator_muul = %KC3.Operator{sym: :****, symbol_value: cfn Tag "tag_mul" (Tag, Tag, Result), operator_precedence: 13, operator_associativity: :left}
+def operator_muul = %KC3.Operator{sym: :****, symbol_value: cfn Tag "tag_mul" (Tag, Tag, Result), operator_precedence: 13, operator_associativity: :left}
 quote 4 **** 4
 4 **** 4
 quote 4 **** 4 **** 4
diff --git a/test/ikc3/defoperator.out.expected b/test/ikc3/defoperator.out.expected
index 4ba44a8..e36b02c 100644
--- a/test/ikc3/defoperator.out.expected
+++ b/test/ikc3/defoperator.out.expected
@@ -5,7 +5,7 @@
               operator_associativity: :left}
 def operator_muul = %KC3.Operator{sym: :****,
                                   symbol_value: cfn Tag "tag_mul" (Tag, Tag, Result),
-                                  operator_precedence: 11}
+                                  operator_precedence: 13}
 operator_muul
 4 **** 4
 16
@@ -14,3 +14,4 @@ operator_muul
 4 **** 4 + 4
 20
 to_lisp(quote 4 **** 4 + 4)
+[operator_add, [operator_muul, 4, 4], 4]
diff --git a/test/ikc3/to_lisp.out.expected b/test/ikc3/to_lisp.out.expected
index 50cc532..e834640 100644
--- a/test/ikc3/to_lisp.out.expected
+++ b/test/ikc3/to_lisp.out.expected
@@ -1,5 +1,5 @@
-quote (a = ? <- 1 ; 2)
-quote to_lisp(quote (a = ? <- 1 ; 2))
+(a = ? <- 1 ; 2)
+to_lisp(quote (a = ? <- 1 ; 2))
 [operator_paren [operator_semicolumn, [operator_equal, a, [operator_assign ?, 1]], 2]]
 to_lisp(quote a = ? <- 1 ; 2)
 [operator_semicolumn, [operator_equal, a, [operator_assign ?, 1]], 2]