kc3-lang/kc3

diff --git a/libc3/bool.h b/libc3/bool.h
index c4f740c..083662e 100644
--- a/libc3/bool.h
+++ b/libc3/bool.h
@@ -25,4 +25,4 @@
 /* Observers */
 s_str * bool_inspect (e_bool b, s_str *dest);
 
-#endif /* SYM_H */
+#endif /* BOOL_H */
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index ec17510..ecbe2ba 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -62,10 +62,6 @@ 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;
@@ -204,12 +200,52 @@ sw buf_parse_call_op (s_buf *buf, s_call *dest)
 sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, s_tag *left,
                           u8 min_precedence)
 {
+  s_ident next_op;
+  s8 next_op_precedence;
   s_ident op;
+  s8 op_precedence;
   sw r;
   sw result = 0;
-  s_tag right;
-  if ((r = buf_parse_ident(buf, &op)) < 0)
-    
+  s_tag *right;
+  s_buf_save save;
+  assert(buf);
+  assert(dest);
+  buf_save_init(buf, &save);
+  if ((r = buf_parse_ident(buf, &next_op)) <= 0)
+    goto clean;
+  while (r && (op_precedence = operator_precedence(&next_op))
+         >= min_precedence) {
+    result += r;
+    op = next_op;
+    if ((r = buf_parse_tag_primary(buf, &right)) <= 0)
+      goto restore;
+    result += r;
+    if ((r = buf_parse_ident(buf, &next_op)) < 0)
+      goto restore;
+    result += r;
+    while (r && (next_op_precedence = operator_precedence(&next_op))
+           >= op_precedence ||
+           (operator_is_right_associative(&next_op) &&
+            next_op_precedence == op_precedence)) {
+      result += r;
+      if (next_op_precedence > op_precedence)
+        op_precedence++;
+      if ((r = buf_parse_call_op_rec(buf, (right = tag_new()), right,
+                                     op_precedence)) <= 0)
+        goto restore;
+      result += r;
+      if ((r = buf_parse_ident(buf, &next_op)) < 0)
+        goto restore;
+      left = tag_new_call_op(&op, left, right);
+    }
+  }
+  r = result;
+  goto clean;
+ restore:
+  buf_save_restore_rpos(buf, &save);
+ clean:
+  buf_save_clean(buf, &save);
+  return r;
 }
 
 sw buf_parse_cfn (s_buf *buf, s_cfn *dest)
@@ -1459,27 +1495,12 @@ sw buf_parse_tag (s_buf *buf, s_tag *dest)
   if (r > 0) {
     result += r;
     if ((r = buf_ignore_spaces(buf)) <= 0)
-      goto clean;
+      goto restore;
     result += r;
   }
-  if ((r = buf_parse_tag_bool(buf, dest)) != 0 ||
-      (r = buf_parse_tag_character(buf, dest)) != 0)
-    goto end;
-  if ((r = buf_parse_tag_integer(buf, dest)) != 0) {
-    tag_integer_reduce(dest);
-    goto end;
-  }
-  if ((r = buf_parse_tag_list(buf, dest)) != 0 ||
-      (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 ||
-      (r = buf_parse_tag_sym(buf, dest)) != 0)
+  if ((r = buf_parse_call_op(buf, dest)) != 0 ||
+      (r = buf_parse_tag_primary(buf, dest)) != 0)
     goto end;
-  goto restore;
  end:
   if (r < 0)
     goto restore;
@@ -1561,6 +1582,57 @@ sw buf_parse_tag_list (s_buf *buf, s_tag *dest)
   return r;
 }
 
+sw buf_parse_tag_primary (s_buf *buf, s_tag *dest)
+{
+  sw r;
+  sw result = 0;
+  s_buf_save save;
+  assert(buf);
+  assert(dest);
+  buf_save_init(buf, &save);
+  if ((r = buf_parse_comments(buf)) < 0)
+    goto clean;
+  if (r > 0) {
+    result += r;
+    if ((r = buf_ignore_spaces(buf)) <= 0)
+      goto restore;
+    result += r;
+  }
+  if ((r = buf_parse_tag_bool(buf, dest)) != 0 ||
+      (r = buf_parse_tag_character(buf, dest)) != 0)
+    goto end;
+  if ((r = buf_parse_tag_integer(buf, dest)) != 0) {
+    tag_integer_reduce(dest);
+    goto end;
+  }
+  if ((r = buf_parse_tag_list(buf, dest)) != 0 ||
+      (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 ||
+      (r = buf_parse_tag_sym(buf, dest)) != 0)
+    goto end;
+  goto restore;
+ end:
+  if (r < 0)
+    goto restore;
+  if (r > 0) {
+    result += r;
+    if ((r = buf_parse_comments(buf)) > 0)
+      result += r;
+  }
+  r = result;
+  goto clean;
+ restore:
+  buf_save_restore_rpos(buf, &save);
+ clean:
+  buf_save_clean(buf, &save);
+  return r;
+}
+
 sw buf_parse_tag_quote (s_buf *buf, s_tag *dest)
 {
   sw r;
diff --git a/libc3/buf_parse.h b/libc3/buf_parse.h
index b6263ea..8f2db29 100644
--- a/libc3/buf_parse.h
+++ b/libc3/buf_parse.h
@@ -75,6 +75,7 @@ sw buf_parse_tag_fn (s_buf *buf, s_tag *dest);
 sw buf_parse_tag_ident (s_buf *buf, s_tag *dest);
 sw buf_parse_tag_integer (s_buf *buf, s_tag *dest);
 sw buf_parse_tag_list (s_buf *buf, s_tag *dest);
+sw buf_parse_tag_primary (s_buf *buf, s_tag *dest);
 sw buf_parse_tag_quote (s_buf *buf, s_tag *dest);
 sw buf_parse_tag_str (s_buf *buf, s_tag *dest);
 sw buf_parse_tag_str_character (s_buf *buf, s_tag *dest);
diff --git a/libc3/c3.h b/libc3/c3.h
index 3de4164..ccb31ff 100644
--- a/libc3/c3.h
+++ b/libc3/c3.h
@@ -40,6 +40,7 @@
 #include "io.h"
 #include "list.h"
 #include "module.h"
+#include "operator.h"
 #include "quote.h"
 #include "str.h"
 #include "tag.h"
diff --git a/libc3/env.c b/libc3/env.c
index eae4ffd..e460488 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -486,6 +486,31 @@ s_module * env_module_load (s_env *env, s_module *module,
   return module;
 }
 
+bool env_operator_is_right_associative (const s_env *env, const s_ident *op)
+{
+  s_facts_with_cursor cursor;
+  s_tag tag_ident;
+  s_tag tag_operator_assoc;
+  s_tag tag_right;
+  assert(env);
+  assert(call);
+  assert(dest);
+  ident_resolve_module(op, env);
+  tag_init_ident(&tag_ident, op);
+  tag_init_1(    &tag_operator_assoc, ":operator_associativity");
+  tag_init_1(    &tag_right, ":right");
+  facts_with(&env->facts, &cursor, (t_facts_spec) {
+      &tag_ident, &tag_operator_assoc, &tag_right,
+      NULL, NULL });
+  if (! facts_with_cursor_next(&cursor))
+    return false;
+  if (tag_var.type.type != TAG_U8)
+    errx(1, "%s.%s: invalid operator_precedence type",
+         op->module_name->str.ptr.ps8,
+         op->sym->str.ptr.ps8);
+  return tag_var.data.u8;
+}
+
 s8 env_operator_precedence (const s_env *env, const s_ident *op)
 {
   s_facts_with_cursor cursor;
diff --git a/libc3/operator.c b/libc3/operator.c
index 6ee57aa..4041419 100644
--- a/libc3/operator.c
+++ b/libc3/operator.c
@@ -14,6 +14,11 @@
 #include <assert.h>
 #include "types.h"
 
+bool operator_is_right_associative (const s_ident *op)
+{
+  return env_operator_is_right_associative(&g_c3_env, op);
+}
+
 s8 operator_precedence (const s_ident *op)
 {
   return env_operator_precedence(&g_c3_env, op);
diff --git a/libc3/operator.h b/libc3/operator.h
index 89a6b65..afe3ae7 100644
--- a/libc3/operator.h
+++ b/libc3/operator.h
@@ -11,12 +11,13 @@
  * AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
  * THIS SOFTWARE.
  */
-#ifndef BOOL_H
-#define BOOL_H
+#ifndef OPERATOR_H
+#define OPERATOR_H
 
 #include "types.h"
 
 /* Observers */
-s8 operator_precedence (const s_ident *op);
+bool operator_is_right_associative (const s_ident *op);
+s8   operator_precedence (const s_ident *op);
 
-#endif /* SYM_H */
+#endif /* OPERATOR_H */
diff --git a/libc3/tag.c b/libc3/tag.c
index aee39a8..0469a87 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -647,6 +647,26 @@ s_tag * tag_new_1 (const s8 *p)
   return tag_init_1(tag, p);
 }
 
+s_tag * tag_new_call_op (const s_ident *ident, s_tag *left,
+                         s_tag *right)
+{
+  s_list *args;
+  s_tag *tag;
+  assert(ident);
+  assert(left);
+  assert(right);
+  if (! (tag = malloc(sizeof(s_tag))))
+    err(1, "tag_new_call_op");
+  tag->type.type = TAG_CALL;
+  tag->data.call.ident = *ident;
+  args = list_new(NULL);
+  tag_copy(right, &args->tag);
+  args = list_new(args);
+  tag_copy(left, &args->tag);
+  tag->data.call.arguments = args;
+  return tag;
+}
+
 s_tag * tag_new_copy (const s_tag *src)
 {
   s_tag *dest;
diff --git a/libc3/tag.h b/libc3/tag.h
index 3be4811..ba1f249 100644
--- a/libc3/tag.h
+++ b/libc3/tag.h
@@ -67,6 +67,8 @@ s_tag * tag_new ();
 s_tag * tag_new_1 (const s8 *p);
 s_tag * tag_new_str (s8 *free, uw size, const s8 *p);
 s_tag * tag_new_bool (bool p);
+s_tag * tag_new_call_op (const s_ident *ident, s_tag *left,
+                         s_tag *right);
 s_tag * tag_new_character (character c);
 s_tag * tag_new_copy (const s_tag *src);
 s_tag * tag_new_sym (const s_sym *sym);