Commit c21c3d33fc7a9b0d9b215e70239e278544538db3

Thomas de Grivel 2024-08-25T22:17:00

wip buf_parse

diff --git a/.ikc3_history b/.ikc3_history
index 2dde24f..2368e15 100644
--- a/.ikc3_history
+++ b/.ikc3_history
@@ -1,13 +1,3 @@
-Facts.with(Facts.env_facts(), quote [[KC3, :operator, op], [^ op, :symbol_value, value]], fn (fact) { puts(op); 1 })
-Facts.with(Facts.env_facts(), quote [[KC3, :operator, op], [op, :symbol_value, value]], fn (fact) { puts(op); 1 })
-Facts.with(Facts.env_facts(), quote [[KC3, :operator, unquote(op)], [unquote(op), :symbol_value, value]], fn (fact) { puts(op); 1 })
-op = ?
-Facts.with(Facts.env_facts(), quote [[KC3, :operator, unquote(op)], [unquote(op), :symbol_value, value]], fn (fact) { puts(op); 1 })
-op
-Facts.with(Facts.env_facts(), quote [[KC3, :operator, op = ?], [op, :symbol_value, value]], fn (fact) { puts(op); 1 })
-Facts.with(Facts.env_facts(), quote [[KC3, :operator, op], [^ op, :symbol_value, value]], fn (fact) { puts(op); 1 })
-Facts.with(Facts.env_facts(), quote [[KC3, :operator, op]], fn (fact) { puts(op); 1 })
-Facts.with_tags(Facts.env_facts(), KC3, :operator, ?, fn (fact) { puts(fact.object); 1 })
 ?
 a = ?
 ?
@@ -97,3 +87,13 @@ a
 to_lisp(quote a = ? <- 1 ; 2)
 a = ?
 Facts.with_tags(Facts.env_facts(), KC3, :operator, a, fn (fact) { puts(a); 1 })
+to_lisp(quote a = ? <- 1 ; 2)
+to_lisp(quote a = 1 ; 2)
+to_lisp(quote a = ? <- 1 ; 2)
+q
+exit
+to_lisp(quote a = ? <- 1 ; 2)
+quote if true do if true do %KC3.Operator{} end end
+quote if true do if true do unquote(%KC3.Operator{}) end end
+quote if true do if true do %KC3.Operator{sym: :a} end end
+to_lisp(quote a = ? <- 1 ; 2)
diff --git a/lib/kc3/0.1/kc3.facts b/lib/kc3/0.1/kc3.facts
index 10e82e1..77f399b 100644
--- a/lib/kc3/0.1/kc3.facts
+++ b/lib/kc3/0.1/kc3.facts
@@ -217,8 +217,8 @@ replace {KC3.operator_semicolumn, :is_a, :operator}
 replace {KC3.operator_semicolumn, :arity, 2}
 replace {KC3.operator_semicolumn, :sym, :";"}
 replace {KC3.operator_semicolumn, :symbol_value, cfn Tag "tag_semicolumn" (Tag, Tag, Result)}
-replace {KC3.operator_semicolumn, :operator_precedence, 1}
-replace {KC3.operator_semicolumn, :operator_associativity, :right}
+replace {KC3.operator_semicolumn, :operator_precedence, 0}
+replace {KC3.operator_semicolumn, :operator_associativity, :left}
 replace {KC3, :symbol, KC3.license}
 replace {KC3.license, :symbol_value, cfn Void "kc3_license" ()}
 add {KC3, :symbol, KC3.break}
diff --git a/libkc3/buf_parse.c b/libkc3/buf_parse.c
index 330a017..4cf94b9 100644
--- a/libkc3/buf_parse.c
+++ b/libkc3/buf_parse.c
@@ -866,10 +866,10 @@ 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_call tmp;
   sw r;
   sw result = 0;
   s_buf_save save;
+  s_call tmp;
   assert(buf);
   assert(dest);
   buf_save_init(buf, &save);
@@ -907,15 +907,15 @@ sw buf_parse_call_op (s_buf *buf, s_call *dest)
   return r;
 }
 
-sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, u8 min_precedence)
+sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, sw min_precedence)
 {
   bool b;
   character c;
   s_tag *left;
   s_ident next_op;
-  s8 next_op_precedence;
+  sw next_op_precedence;
   s_ident op;
-  s8 op_precedence;
+  sw op_precedence;
   sw r;
   sw result = 0;
   s_tag *right;
@@ -967,23 +967,27 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, u8 min_precedence)
     next_op_precedence = operator_precedence(&next_op);
     while (1) {
       if (r <= 0 ||
-          operator_arity(&next_op) != 2)
+          operator_arity(&next_op) != 2) {
+        r = -1;
         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)
+            next_op_precedence != op_precedence) {
+          r = -1;
           break;
+        }
       }
       call_init_op(&tmp2);
       tmp2.arguments->tag = *right;
       if ((r = buf_parse_call_op_rec(buf, &tmp2,
-                                     (next_op_precedence > op_precedence) ?
-                                     op_precedence + 1 :
-                                     op_precedence)) <= 0) {
+                                     next_op_precedence > op_precedence
+                                     ? op_precedence + 1
+                                     : op_precedence)) <= 0) {
         tmp2.arguments->tag.type = TAG_VOID;
         call_clean(&tmp2);
         break;
@@ -1012,10 +1016,11 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, u8 min_precedence)
       break;
     call_init_op(&tmp3);
     tmp3.ident = op;
-    tmp3.arguments->tag = *left;
+    tag_init_call(&tmp3.arguments->tag);
+    tmp3.arguments->tag.data.call = tmp;
     list_next(tmp3.arguments)->tag = *right;
-    tag_init_call(left);
-    left->data.call = tmp3;
+    call_init(&tmp);
+    tmp = tmp3;
   }
   call_clean(dest);
   *dest = tmp;
@@ -1769,7 +1774,7 @@ sw buf_parse_fn_clause (s_buf *buf, s_fn_clause *dest)
   assert(dest);
   fn_clause_init(&tmp, NULL);
   if ((r = buf_parse_fn_pattern(buf, &tmp.pattern)) <= 0) {
-    err_puts("buf_parse_fn: invalid pattern");
+    err_puts("buf_parse_fn_clause: invalid pattern");
     goto clean;
   }
   result += r;
@@ -1778,8 +1783,8 @@ sw buf_parse_fn_clause (s_buf *buf, s_fn_clause *dest)
     goto clean;
   result += r;
   if ((r = buf_parse_block(buf, &tmp.algo)) <= 0) {
-    buf_inspect_fn_clause(&g_kc3_env.err, &tmp);
-    buf_flush(&g_kc3_env.err);
+    err_inspect_fn_clause(&tmp);
+    err_write_1("\n");
     err_puts("buf_parse_fn: invalid program");
     goto clean;
   }
@@ -4074,6 +4079,7 @@ sw buf_parse_tag_primary_3 (s_buf *buf, s_tag *dest)
 
 sw buf_parse_tag_primary_4 (s_buf *buf, s_tag *dest)
 {
+  character c;
   sw r;
   sw result = 0;
   s_buf_save save;
@@ -4088,31 +4094,99 @@ sw buf_parse_tag_primary_4 (s_buf *buf, s_tag *dest)
       goto restore;
     result += r;
   }
-  if ((r = buf_parse_tag_var(buf, dest)) != 0 ||
-      (r = buf_parse_tag_void(buf, dest)) != 0 ||
-      (r = buf_parse_tag_number(buf, dest)) != 0 ||
-      (r = buf_parse_tag_array(buf, dest)) != 0 ||
-      (r = buf_parse_tag_cow(buf, dest)) != 0 ||
-      (r = buf_parse_tag_cast(buf, dest)) != 0 ||
-      (r = buf_parse_tag_unquote(buf, dest)) != 0 ||
-      (r = buf_parse_tag_if(buf, dest)) != 0 ||
-      (r = buf_parse_tag_call(buf, dest)) != 0 ||
-      (r = buf_parse_tag_call_paren(buf, dest)) != 0 ||
-      (r = buf_parse_tag_quote(buf, dest)) != 0 ||
-      (r = buf_parse_tag_bool(buf, dest)) != 0 ||
-      (r = buf_parse_tag_character(buf, dest)) != 0 ||
-      (r = buf_parse_tag_map(buf, dest)) != 0 ||
-      (r = buf_parse_tag_str(buf, dest)) != 0 ||
-      (r = buf_parse_tag_tuple(buf, dest)) != 0 ||
-      (r = buf_parse_tag_cfn(buf, dest)) != 0 ||
-      (r = buf_parse_tag_fn(buf, dest)) != 0 ||
-      (r = buf_parse_tag_time(buf, dest)) != 0 ||
-      (r = buf_parse_tag_struct(buf, dest)) != 0 ||
-      (r = buf_parse_tag_list(buf, dest)) != 0 ||
-      (r = buf_parse_tag_ident(buf, dest)) != 0 ||
-      (r = buf_parse_tag_sym(buf, dest)) != 0)
+  if ((r = buf_peek_character_utf8(buf, &c)) <= 0)
     goto end;
-  goto restore;
+  switch (c) {
+  case '(':
+    if ((r = buf_parse_tag_var(buf, dest)) ||
+        (r = buf_parse_tag_number(buf, dest)) ||
+        (r = buf_parse_tag_array(buf, dest)) ||
+        (r = buf_parse_tag_cast(buf, dest)) ||
+        (r = buf_parse_tag_call_paren(buf, dest)))
+      goto end;
+    goto restore;
+  case 'v':
+    if ((r = buf_parse_tag_void(buf, dest)) ||
+        (r = buf_parse_tag_call(buf, dest)) ||
+        (r = buf_parse_tag_ident(buf, dest)))
+      goto end;
+    goto restore;
+  case '-':
+  case '0':
+  case '1':
+  case '2':
+  case '3':
+  case '4':
+  case '5':
+  case '6':
+  case '7':
+  case '8':
+  case '9':
+    if ((r = buf_parse_tag_number(buf, dest)))
+      goto end;
+    goto restore;
+  case 'c':
+    if ((r = buf_parse_tag_cow(buf, dest)) ||
+        (r = buf_parse_tag_call(buf, dest)) ||
+        (r = buf_parse_tag_cfn(buf, dest)) ||
+        (r = buf_parse_tag_ident(buf, dest)))
+      goto end;
+    goto restore;
+  case 'u':
+    if ((r = buf_parse_tag_unquote(buf, dest)) ||
+        (r = buf_parse_tag_call(buf, dest)) ||
+        (r = buf_parse_tag_ident(buf, dest)))
+      goto end;
+    goto restore;
+  case 'i':
+    if ((r = buf_parse_tag_if(buf, dest)) ||
+        (r = buf_parse_tag_call(buf, dest)) ||
+        (r = buf_parse_tag_ident(buf, dest)))
+      goto end;
+    goto restore;
+  case 'q':
+    if ((r = buf_parse_tag_quote(buf, dest)) ||
+        (r = buf_parse_tag_call(buf, dest)) ||
+        (r = buf_parse_tag_ident(buf, dest)))
+      goto end;
+    goto restore;
+  case 'b':
+    if ((r = buf_parse_tag_bool(buf, dest)) ||
+        (r = buf_parse_tag_call(buf, dest)) ||
+        (r = buf_parse_tag_ident(buf, dest)))
+      goto end;
+    goto restore;
+  case '\'':
+    r = buf_parse_tag_character(buf, dest);
+    goto end;
+  case '%':
+    if ((r = buf_parse_tag_map(buf, dest)) ||
+        (r = buf_parse_tag_time(buf, dest)) ||
+        (r = buf_parse_tag_struct(buf, dest)))
+      goto end;
+    goto restore;
+  case '"':
+    r = buf_parse_tag_str(buf, dest);
+    goto end;
+  case '{':
+    r = buf_parse_tag_tuple(buf, dest);
+    goto end;
+  case 'f':
+    r = buf_parse_tag_fn(buf, dest);
+    goto end;
+  case '[':
+    r = buf_parse_tag_list(buf, dest);
+    goto end;
+  case ':':
+    r = buf_parse_tag_sym(buf, dest);
+    goto end;
+  default:
+    if ((r = buf_parse_tag_call(buf, dest)) ||
+        (r = buf_parse_tag_ident(buf, dest)) ||
+        (r = buf_parse_tag_sym(buf, dest)))
+      goto end;
+    goto restore;
+  }
  end:
   if (r < 0)
     goto restore;
diff --git a/libkc3/buf_parse.h b/libkc3/buf_parse.h
index e61f77a..4f3ac42 100644
--- a/libkc3/buf_parse.h
+++ b/libkc3/buf_parse.h
@@ -52,7 +52,7 @@ sw buf_parse_brackets (s_buf *buf, s_call *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_rec (s_buf *buf, s_call *dest, u8 min_precedence);
+sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, sw min_precedence);
 sw buf_parse_call_op_unary (s_buf *buf, s_call *dest);
 sw buf_parse_call_paren (s_buf *buf, s_call *dest);
 sw buf_parse_cast (s_buf *buf, s_call *dest);
diff --git a/libkc3/io.c b/libkc3/io.c
index 3745a1e..aa6e31f 100644
--- a/libkc3/io.c
+++ b/libkc3/io.c
@@ -191,6 +191,8 @@ DEF_ERR_IO_INSPECT(character,       const character *)
 DEF_ERR_IO_INSPECT(f32,             const f32 *)
 DEF_ERR_IO_INSPECT(fact,            const s_fact *)
 DEF_ERR_IO_INSPECT(facts_spec,      const p_facts_spec)
+DEF_ERR_IO_INSPECT(fn,              const s_fn *)
+DEF_ERR_IO_INSPECT(fn_clause,       const s_fn_clause *)
 DEF_ERR_IO_INSPECT(fn_pattern,      const s_list *)
 DEF_ERR_IO_INSPECT(ident,           const s_ident *)
 DEF_ERR_IO_INSPECT(list,            const s_list * const *)
diff --git a/libkc3/io.h b/libkc3/io.h
index 9e084c7..8bbae76 100644
--- a/libkc3/io.h
+++ b/libkc3/io.h
@@ -52,6 +52,7 @@ PROTOTYPES_ERR_IO_INSPECT(f64,             const f64 *);
 PROTOTYPES_ERR_IO_INSPECT(fact,            const s_fact *);
 PROTOTYPES_ERR_IO_INSPECT(facts_spec,      const p_facts_spec);
 PROTOTYPES_ERR_IO_INSPECT(fn,              const s_fn *);
+PROTOTYPES_ERR_IO_INSPECT(fn_clause,       const s_fn_clause *);
 PROTOTYPES_ERR_IO_INSPECT(fn_pattern,      const s_list *);
 PROTOTYPES_ERR_IO_INSPECT(ident,           const s_ident *);
 PROTOTYPES_ERR_IO_INSPECT(integer,         const s_integer *);
diff --git a/test/buf_parse_test.c b/test/buf_parse_test.c
index 027187e..5feabfc 100644
--- a/test/buf_parse_test.c
+++ b/test/buf_parse_test.c
@@ -63,6 +63,17 @@
     test_context(NULL);                                                \
   } while (0)
 
+#define BUF_PARSE_TEST_CALL_PAREN(test)                                \
+  do {                                                                 \
+    s_buf buf;                                                         \
+    s_call dest = {0};                                                 \
+    test_context("buf_parse_call_paren(" # test ")");                  \
+    buf_init_1(&buf, false, (test));                                   \
+    TEST_EQ(buf_parse_call_paren(&buf, &dest), strlen(test));          \
+    call_clean(&dest);                                                 \
+    test_context(NULL);                                                \
+  } while (0)
+
 #define BUF_PARSE_TEST_CFN(test)                                       \
   do {                                                                 \
     s_buf buf;                                                         \
@@ -597,6 +608,7 @@ TEST_CASE_PROTOTYPE(buf_parse_array);
 TEST_CASE_PROTOTYPE(buf_parse_bool);
 TEST_CASE_PROTOTYPE(buf_parse_call);
 TEST_CASE_PROTOTYPE(buf_parse_call_op);
+TEST_CASE_PROTOTYPE(buf_parse_call_paren);
 TEST_CASE_PROTOTYPE(buf_parse_cfn);
 TEST_CASE_PROTOTYPE(buf_parse_character);
 TEST_CASE_PROTOTYPE(buf_parse_digit_bin);
@@ -627,6 +639,7 @@ void buf_parse_test (void)
   TEST_CASE_RUN(buf_parse_bool);
   TEST_CASE_RUN(buf_parse_call);
   TEST_CASE_RUN(buf_parse_call_op);
+  TEST_CASE_RUN(buf_parse_call_paren);
   TEST_CASE_RUN(buf_parse_digit_bin);
   TEST_CASE_RUN(buf_parse_digit_hex);
   TEST_CASE_RUN(buf_parse_digit_oct);
@@ -771,6 +784,16 @@ TEST_CASE(buf_parse_call_op)
 }
 TEST_CASE_END(buf_parse_call_op)
 
+TEST_CASE(buf_parse_call_paren)
+{
+  BUF_PARSE_TEST_CALL_PAREN("(1 + 2)");
+  BUF_PARSE_TEST_CALL_PAREN("(1 + 2 + 3)");
+  BUF_PARSE_TEST_CALL_PAREN("(1 + 2 / 3)");
+  BUF_PARSE_TEST_CALL_PAREN("(1 + 2 / 3 ; 4)");
+  BUF_PARSE_TEST_CALL_PAREN("(1 + 2 / 3 ; 4 - 5)");
+}
+TEST_CASE_END(buf_parse_call_paren)
+
 TEST_CASE(buf_parse_cfn)
 {
   BUF_PARSE_TEST_NOT_CFN("0");