diff --git a/lib/c3/0.1/c3.facts b/lib/c3/0.1/c3.facts
index 848759c..10c0887 100644
--- a/lib/c3/0.1/c3.facts
+++ b/lib/c3/0.1/c3.facts
@@ -17,38 +17,47 @@ add {C3, :symbol, C3.>}
add {C3, :symbol, C3.break}
add {C3, :symbol, C3.first}
add {C3, :symbol, C3.||}
+add {C3.+, :arity, 2}
add {C3.+, :cfn, cfn :tag "tag_add" (:tag, :tag, :&result)}
add {C3.+, :is_a, :operator}
add {C3.+, :operator_precedence, 1}
add {C3.+, :operator_associativity, :left}
+add {C3.-, :arity, 2}
add {C3.-, :cfn, cfn :tag "tag_sub" (:tag, :tag, :&result)}
add {C3.-, :is_a, :operator}
add {C3.-, :operator_precedence, 1}
add {C3.-, :operator_associativity, :left}
+add {C3.*, :arity, 2}
add {C3.*, :cfn, cfn :tag "tag_mul" (:tag, :tag, :&result)}
add {C3.*, :is_a, :operator}
add {C3.*, :operator_precedence, 2}
add {C3.*, :operator_associativity, :left}
+add {C3./, :arity, 2}
add {C3./, :cfn, cfn :tag "tag_div" (:tag, :tag, :&result)}
add {C3./, :is_a, :operator}
add {C3./, :operator_precedence, 2}
add {C3./, :operator_associativity, :left}
+add {C3.<, :arity, 2}
add {C3.<, :cfn, cfn :bool "tag_lt" (:tag, :tag)}
add {C3.<, :is_a, :operator}
add {C3.<, :operator_precedence, 3}
add {C3.<, :operator_associativity, :left}
+add {C3.<=, :arity, 2}
add {C3.<=, :cfn, cfn :bool "tag_lte" (:tag, :tag)}
add {C3.<=, :is_a, :operator}
add {C3.<=, :operator_precedence, 3}
add {C3.<=, :operator_associativity, :left}
+add {C3.==, :arity, 2}
add {C3.==, :cfn, cfn :bool "tag_eq" (:tag, :tag)}
add {C3.==, :is_a, :operator}
add {C3.==, :operator_precedence, 3}
add {C3.==, :operator_associativity, :left}
+add {C3.>=, :arity, 2}
add {C3.>=, :cfn, cfn :bool "tag_gte" (:tag, :tag)}
add {C3.>=, :is_a, :operator}
add {C3.>=, :operator_precedence, 3}
add {C3.>=, :operator_associativity, :left}
+add {C3.>, :arity, 2}
add {C3.>, :cfn, cfn :bool "tag_gt" (:tag, :tag)}
add {C3.>, :is_a, :operator}
add {C3.>, :operator_precedence, 3}
@@ -58,10 +67,12 @@ add {C3.!, :cfn, cfn :bool "tag_not" (:tag)}
add {C3.!, :is_a, :operator}
add {C3.!, :operator_precedence, 4}
add {C3.!, :operator_associativity, :left}
+add {C3.&&, :arity, 2}
add {C3.&&, :cfn, cfn :bool "tag_and" (:tag, :tag)}
add {C3.&&, :is_a, :operator}
add {C3.&&, :operator_precedence, 4}
add {C3.&&, :operator_associativity, :left}
+add {C3.||, :arity, 2}
add {C3.||, :cfn, cfn :bool "tag_or" (:tag, :tag)}
add {C3.||, :is_a, :operator}
add {C3.||, :operator_precedence, 4}
diff --git a/libc3/buf.c b/libc3/buf.c
index ff2ef7f..bb44e4e 100644
--- a/libc3/buf.c
+++ b/libc3/buf.c
@@ -161,6 +161,26 @@ sw buf_ignore_spaces (s_buf *buf)
return result;
}
+sw buf_ignore_spaces_but_newline (s_buf *buf)
+{
+ character c;
+ sw csize;
+ sw r;
+ sw result = 0;
+ assert(buf);
+ while ((r = buf_peek_character_utf8(buf, &c)) > 0 &&
+ character_is_space(c) &&
+ c != '\n') {
+ csize = r;
+ if ((r = buf_ignore(buf, csize)) < 0)
+ return r;
+ result += csize;
+ }
+ if (! result && r < 0)
+ return r;
+ return result;
+}
+
s_buf * buf_init (s_buf *buf, bool free, uw size, s8 *p)
{
assert(buf);
diff --git a/libc3/buf.h b/libc3/buf.h
index f145112..dc51e07 100644
--- a/libc3/buf.h
+++ b/libc3/buf.h
@@ -47,6 +47,7 @@ sw buf_ignore (s_buf *buf, uw size);
sw buf_ignore_line (s_buf *buf);
sw buf_ignore_newline (s_buf *buf);
sw buf_ignore_spaces (s_buf *buf);
+sw buf_ignore_spaces_but_newline (s_buf *buf);
sw buf_peek_1 (s_buf *buf, const s8 *p);
sw buf_peek_character_utf8 (s_buf *buf, character *p);
sw buf_peek_f32 (s_buf *buf, f32 *p);
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index 9608d41..865200f 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -535,14 +535,12 @@ sw buf_parse_call_op (s_buf *buf, s_call *dest)
s_buf_save save;
assert(buf);
assert(dest);
- if ((r = buf_parse_call_op_unary(buf, dest)) > 0)
- return r;
buf_save_init(buf, &save);
call_init_op(&tmp);
if ((r = buf_parse_tag_primary(buf, &tmp.arguments->tag)) <= 0)
goto restore;
result += r;
- if ((r = buf_ignore_spaces(buf)) < 0)
+ if ((r = buf_ignore_spaces_but_newline(buf)) < 0)
goto restore;
result += r;
if ((r = buf_parse_call_op_rec(buf, &tmp, 0)) <= 0)
@@ -589,13 +587,15 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, u8 min_precedence)
r = 0;
goto restore;
}
+ if (! operator_is_binary(&next_op))
+ goto restore;
while (r > 0 && op_precedence >= min_precedence) {
if ((r = buf_parse_ident(buf, &next_op)) <= 0)
goto restore;
result += r;
op = next_op;
tmp.ident = op;
- if ((r = buf_ignore_spaces(buf)) < 0)
+ if ((r = buf_ignore_spaces_but_newline(buf)) < 0)
goto restore;
result += r;
if ((r = buf_parse_tag_primary(buf, right)) <= 0)
@@ -616,7 +616,8 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, u8 min_precedence)
next_op_precedence = operator_precedence(&next_op);
while (r > 0 && (next_op_precedence >= op_precedence ||
(operator_is_right_associative(&next_op) &&
- next_op_precedence == op_precedence))) {
+ next_op_precedence == op_precedence)) &&
+ operator_is_binary(&next_op)) {
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) {
@@ -641,6 +642,7 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, u8 min_precedence)
list_next(tmp3.arguments)->tag = *right;
tag_init_call(left, &tmp3);
}
+ ok:
call_clean(dest);
*dest = tmp;
r = result;
@@ -2066,6 +2068,16 @@ sw buf_parse_tag_call_op (s_buf *buf, s_tag *dest)
return r;
}
+sw buf_parse_tag_call_op_unary (s_buf *buf, s_tag *dest)
+{
+ sw r;
+ assert(buf);
+ assert(dest);
+ if ((r = buf_parse_call_op_unary(buf, &dest->data.call)) > 0)
+ dest->type = TAG_CALL;
+ return r;
+}
+
sw buf_parse_tag_cfn (s_buf *buf, s_tag *dest)
{
sw r;
@@ -2142,7 +2154,8 @@ sw buf_parse_tag_primary (s_buf *buf, s_tag *dest)
goto restore;
result += r;
}
- if ((r = buf_parse_tag_bool(buf, dest)) != 0 ||
+ if ((r = buf_parse_tag_call_op_unary(buf, dest)) != 0 ||
+ (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) {
diff --git a/libc3/env.c b/libc3/env.c
index da72bfd..453ebc1 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -535,6 +535,34 @@ s_module * env_module_load (s_env *env, s_module *module,
return module;
}
+bool env_operator_is_binary (s_env *env, const s_ident *op)
+{
+ s_facts_with_cursor cursor;
+ s8 r;
+ s_tag tag_ident;
+ s_tag tag_is_a;
+ s_tag tag_arity;
+ s_tag tag_operator;
+ s_tag tag_two;
+ s_ident tmp;
+ assert(env);
+ assert(op);
+ tmp = *op;
+ ident_resolve_module(&tmp, env);
+ tag_init_ident(&tag_ident, &tmp);
+ tag_init_1( &tag_is_a, ":is_a");
+ tag_init_1( &tag_operator, ":operator");
+ tag_init_1( &tag_arity, ":arity");
+ tag_init_1( &tag_two, "2");
+ facts_with(&env->facts, &cursor, (t_facts_spec) {
+ &tag_ident, &tag_is_a, &tag_operator,
+ &tag_arity, &tag_two,
+ NULL, NULL });
+ r = facts_with_cursor_next(&cursor) ? true : false;
+ facts_with_cursor_clean(&cursor);
+ return r;
+}
+
bool env_operator_is_right_associative (s_env *env, const s_ident *op)
{
s_facts_with_cursor cursor;
@@ -558,7 +586,7 @@ bool env_operator_is_right_associative (s_env *env, const s_ident *op)
return r;
}
-bool env_operator_is_unary(s_env *env, const s_ident *op)
+bool env_operator_is_unary (s_env *env, const s_ident *op)
{
s_facts_with_cursor cursor;
s8 r;
diff --git a/libc3/env.h b/libc3/env.h
index 3d56159..618fd8a 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -44,9 +44,10 @@ bool env_eval_progn (s_env *env, const s_list *program,
bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest);
s_module * env_module_load (s_env *env, s_module *module,
const s_sym *name, s_facts *facts);
+bool env_operator_is_binary (s_env *env, const s_ident *op);
bool env_operator_is_right_associative (s_env *env,
const s_ident *op);
-bool env_operator_is_unary(s_env *env, const s_ident *op);
+bool env_operator_is_unary (s_env *env, const s_ident *op);
s8 env_operator_precedence (s_env *env,
const s_ident *op);
diff --git a/libc3/operator.c b/libc3/operator.c
index 7fcbf28..b7371db 100644
--- a/libc3/operator.c
+++ b/libc3/operator.c
@@ -13,6 +13,11 @@
#include <assert.h>
#include "c3.h"
+bool operator_is_binary (const s_ident *op)
+{
+ return env_operator_is_binary(&g_c3_env, op);
+}
+
bool operator_is_right_associative (const s_ident *op)
{
return env_operator_is_right_associative(&g_c3_env, op);
diff --git a/libc3/operator.h b/libc3/operator.h
index fee1fa2..e859fe3 100644
--- a/libc3/operator.h
+++ b/libc3/operator.h
@@ -16,6 +16,7 @@
#include "types.h"
/* Observers */
+bool operator_is_binary (const s_ident *op);
bool operator_is_right_associative (const s_ident *op);
bool operator_is_unary (const s_ident *op);
s8 operator_precedence (const s_ident *op);