diff --git a/Makefile b/Makefile
index 3df9cfc..d474610 100644
--- a/Makefile
+++ b/Makefile
@@ -62,7 +62,7 @@ clean_cov:
${MAKE} -C test clean_cov
debug:
- ${GMAKE} -C libffi debug
+ ${GMAKE} -C libffi all
${MAKE} -C libtommath debug
${MAKE} -C libc3 debug
${MAKE} -C ic3 debug
diff --git a/README.md b/README.md
index f4f07d0..ab1ebf2 100644
--- a/README.md
+++ b/README.md
@@ -86,8 +86,9 @@ Script interpreter.
- DONE triple serial id
- math
- floating point numbers
- - boolean operators
- - comparison operators
+ - variables
+ - DONE boolean operators
+ - DONE comparison operators
- arrays
- lists
- defmodule
diff --git a/lib/c3/0.1/c3.facts b/lib/c3/0.1/c3.facts
index b9c8eda..250403b 100644
--- a/lib/c3/0.1/c3.facts
+++ b/lib/c3/0.1/c3.facts
@@ -11,6 +11,7 @@ add {C3, :symbol, C3.-}
add {C3, :symbol, C3./}
add {C3, :symbol, C3.<=}
add {C3, :symbol, C3.<}
+add {C3, :symbol, C3.=}
add {C3, :symbol, C3.==}
add {C3, :symbol, C3.>=}
add {C3, :symbol, C3.>}
@@ -49,6 +50,11 @@ 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 :tag "tag_equal" (:tag, :tag, :&result)}
+add {C3.=, :is_a, :operator}
+add {C3.=, :operator_precedence, 5}
+add {C3.=, :operator_associativity, :left}
add {C3.==, :arity, 2}
add {C3.==, :cfn, cfn :bool "tag_eq" (:tag, :tag)}
add {C3.==, :is_a, :operator}
diff --git a/libc3/binding.c b/libc3/binding.c
index e446b55..6330bd1 100644
--- a/libc3/binding.c
+++ b/libc3/binding.c
@@ -31,7 +31,7 @@ void binding_delete_all (s_binding *binding)
}
}
-const s_tag * binding_get (s_binding *binding, const s_sym *name)
+const s_tag * binding_get (const s_binding *binding, const s_sym *name)
{
while (binding) {
if (binding->name == name)
diff --git a/libc3/binding.h b/libc3/binding.h
index 7fc6411..d35a4cc 100644
--- a/libc3/binding.h
+++ b/libc3/binding.h
@@ -29,6 +29,8 @@ void binding_delete (s_binding *binding);
void binding_delete_all (s_binding *binding);
/* observers */
-const s_tag * binding_get (s_binding *binding, const s_sym *name);
+const s_tag * binding_get (const s_binding *binding, const s_sym *name);
+const s_tag * binding_is_bound (const s_binding *binding,
+ const s_sym *name);
#endif /* BINDING_H */
diff --git a/libc3/buf_inspect.c b/libc3/buf_inspect.c
index aaf9b21..1ead071 100644
--- a/libc3/buf_inspect.c
+++ b/libc3/buf_inspect.c
@@ -418,9 +418,21 @@ sw buf_inspect_cfn (s_buf *buf, const s_cfn *cfn)
sw r;
sw result = 0;
assert(cfn);
+ if ((r = buf_write_1(buf, "cfn ")) < 0)
+ return r;
+ result += r;
+ if ((r = buf_inspect_sym(buf, cfn->result_type)) < 0)
+ return r;
+ result += r;
+ if ((r = buf_write_1(buf, " ")) < 0)
+ return r;
+ result += r;
if ((r = buf_inspect_str(buf, &cfn->name->str)) < 0)
return r;
result += r;
+ if ((r = buf_write_1(buf, " ")) < 0)
+ return r;
+ result += r;
if ((r = buf_write_1(buf, "(")) < 0)
return r;
result += r;
@@ -428,6 +440,7 @@ sw buf_inspect_cfn (s_buf *buf, const s_cfn *cfn)
while (arg_type) {
if ((r = buf_inspect_tag(buf, &arg_type->tag)) < 0)
return r;
+ result += r;
arg_type = list_next(arg_type);
if (arg_type) {
if ((r = buf_write_1(buf, ", ")) < 0)
diff --git a/libc3/env.c b/libc3/env.c
index 453ebc1..0658af0 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -293,14 +293,17 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
assert(a);
assert(b);
assert(dest);
- if (a->type == TAG_IDENT) {
- if (b->type == TAG_IDENT)
- warnx("TAG_IDENT = TAG_IDENT");
+ if (a->type == TAG_IDENT && tag_ident_is_unbound(a) &&
+ b->type == TAG_IDENT && tag_ident_is_unbound(b)) {
+ warnx("TAG_IDENT = TAG_IDENT");
+ return false;
+ }
+ if (a->type == TAG_IDENT && tag_ident_is_unbound(a)) {
tag_copy(b, dest);
- frame_binding_new(env->frame, a->data.ident.sym, b);
+ frame_binding_new(env->frame, b->data.ident.sym, a);
return true;
}
- if (b->type == TAG_IDENT) {
+ if (b->type == TAG_IDENT && tag_ident_is_unbound(b)) {
tag_copy(a, dest);
frame_binding_new(env->frame, b->data.ident.sym, a);
return true;
@@ -323,11 +326,12 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
dest->type = TAG_TUPLE;
return env_eval_equal_tuple(env, &a->data.tuple, &b->data.tuple,
&dest->data.tuple);
- case TAG_ARRAY:
- case TAG_BOOL:
case TAG_CALL:
case TAG_CALL_FN:
case TAG_CALL_MACRO:
+ case TAG_QUOTE:
+ case TAG_ARRAY:
+ case TAG_BOOL:
case TAG_CFN:
case TAG_CHARACTER:
case TAG_F32:
@@ -335,7 +339,6 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
case TAG_FN:
case TAG_INTEGER:
case TAG_PTAG:
- case TAG_QUOTE:
case TAG_S16:
case TAG_S32:
case TAG_S64:
@@ -385,12 +388,14 @@ bool env_eval_equal_tuple (s_env *env, const s_tuple *a,
bool env_eval_ident (s_env *env, const s_ident *ident, s_tag *dest)
{
const s_tag *tag;
+ s_tag tmp;
assert(env);
assert(ident);
- if (! (tag = frame_get(env->frame, ident->sym))) {
- assert(! "env_eval_ident: unbound variable");
- errx(1, "env_eval_ident: %s: unbound variable",
- ident->sym->str.ptr.ps8);
+ if (! ((tag = frame_get(env->frame, ident->sym)) ||
+ (tag = module_get(env->current_module, ident->sym, &tmp)))) {
+ tag_init_var(dest);
+ frame_binding_new(env->frame, ident->sym, dest);
+ return true;
}
tag_copy(tag, dest);
return true;
@@ -464,7 +469,7 @@ s_env * env_init (s_env *env)
{
assert(env);
env->error_handler = NULL;
- env->frame = NULL;
+ env->frame = frame_new(NULL);
buf_init_alloc(&env->in, BUF_SIZE);
buf_file_open_r(&env->in, stdin);
buf_init_alloc(&env->out, BUF_SIZE);
diff --git a/libc3/frame.c b/libc3/frame.c
index ed41fe3..0a8a944 100644
--- a/libc3/frame.c
+++ b/libc3/frame.c
@@ -48,7 +48,7 @@ void frame_delete_all (s_frame *frame)
frame = frame_delete(frame);
}
-const s_tag * frame_get (s_frame *frame, const s_sym *sym)
+const s_tag * frame_get (const s_frame *frame, const s_sym *sym)
{
const s_tag *tag;
while (frame) {
diff --git a/libc3/frame.h b/libc3/frame.h
index fcc25d9..b7e0871 100644
--- a/libc3/frame.h
+++ b/libc3/frame.h
@@ -31,6 +31,6 @@ void frame_binding_new(s_frame *frame, const s_sym *name,
const s_tag *value);
/* observers */
-const s_tag * frame_get (s_frame *frame, const s_sym *sym);
+const s_tag * frame_get (const s_frame *frame, const s_sym *sym);
#endif /* FRAME_H */
diff --git a/libc3/module.c b/libc3/module.c
index e69ee0c..ddbf71b 100644
--- a/libc3/module.c
+++ b/libc3/module.c
@@ -14,6 +14,51 @@
#include <string.h>
#include "c3.h"
+s_tag * module_get (const s_module *module, const s_sym *sym,
+ s_tag *dest)
+{
+ s_ident ident;
+ s_tag tag_cfn;
+ s_tag tag_fn;
+ s_tag tag_ident;
+ s_tag tag_is_a;
+ s_tag tag_module;
+ s_tag tag_name;
+ s_tag tag_symbol;
+ s_tag tag_tmp;
+ assert(module);
+ assert(sym);
+ s_facts_with_cursor cursor;
+ tag_init_sym(&tag_name, module->name);
+ tag_init_1( &tag_is_a, ":is_a");
+ tag_init_1( &tag_module, ":module");
+ tag_init_1( &tag_symbol, ":symbol");
+ ident_init(&ident, sym);
+ ident.module_name = module->name;
+ tag_init_ident(&tag_ident, &ident);
+ facts_with(module->facts, &cursor, (t_facts_spec) {
+ &tag_name, &tag_is_a, &tag_module,
+ &tag_symbol, &tag_ident, NULL, NULL});
+ if (! facts_with_cursor_next(&cursor))
+ return NULL;
+ facts_with_cursor_clean(&cursor);
+ tag_init_1(&tag_cfn, ":cfn");
+ tag_init_1(&tag_fn, ":fn");
+ tag_init_var(&tag_tmp);
+ facts_with(module->facts, &cursor, (t_facts_spec) {
+ &tag_ident, &tag_cfn, &tag_tmp, NULL, NULL});
+ if (! facts_with_cursor_next(&cursor)) {
+ facts_with_cursor_clean(&cursor);
+ facts_with(module->facts, &cursor, (t_facts_spec) {
+ &tag_ident, &tag_fn, &tag_tmp, NULL, NULL});
+ if (! facts_with_cursor_next(&cursor))
+ tag_init_void(&tag_tmp);
+ }
+ facts_with_cursor_clean(&cursor);
+ *dest = tag_tmp;
+ return dest;
+}
+
s_module * module_load (s_module *module, const s_sym *name,
s_facts *facts)
{
diff --git a/libc3/module.h b/libc3/module.h
index ef19e9c..228d65b 100644
--- a/libc3/module.h
+++ b/libc3/module.h
@@ -29,4 +29,10 @@ s_str * module_name_path (const s_str *prefix, const s_sym *name,
sw module_name_path_size (const s_str *prefix,
const s_sym *name);
+/* Observers */
+s_tag * module_get (const s_module *module, const s_sym *sym,
+ s_tag *dest);
+s_tag * module_is_bound (const s_module *module, const s_sym *sym,
+ s_tag *dest);
+
#endif /* MODULE_H */
diff --git a/libc3/tag.c b/libc3/tag.c
index eddc5e7..fbfc156 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -16,6 +16,7 @@
#include <string.h>
#include <strings.h>
#include "c3.h"
+#include "frame.h"
s_tag g_tag_first;
s_tag g_tag_last;
@@ -1015,6 +1016,16 @@ bool tag_eq (const s_tag *a, const s_tag *b)
return compare_tag(a, b) == 0;
}
+s_tag * tag_equal (const s_tag *a, const s_tag *b, s_tag *dest)
+{
+ assert(a);
+ assert(b);
+ assert(dest);
+ if (! env_eval_equal_tag (&g_c3_env, a, b, dest))
+ return NULL;
+ return dest;
+}
+
s_tag * tag_f32 (s_tag *tag, f32 x)
{
assert(tag);
@@ -1071,6 +1082,17 @@ s_tag * tag_ident_1 (s_tag *tag, const s8 *p)
return tag_init_ident_1(tag, p);
}
+bool tag_ident_is_unbound (const s_tag *tag)
+{
+ s_tag tmp;
+ assert(tag);
+ assert(tag->type == TAG_IDENT);
+ return tag->type == TAG_IDENT &&
+ ! (frame_get(g_c3_env.frame, tag->data.ident.sym) ||
+ module_get(g_c3_env.current_module, tag->data.ident.sym,
+ &tmp));
+}
+
s_tag * tag_init (s_tag *tag)
{
bzero(tag, sizeof(s_tag));
@@ -1430,13 +1452,13 @@ s_tag * tag_integer_reduce (s_tag *tag)
return tag;
}
-e_bool tag_is_bound_var (const s_tag *tag)
+bool tag_is_bound_var (const s_tag *tag)
{
return (tag &&
tag->type != TAG_VAR);
}
-e_bool tag_is_number (const s_tag *tag)
+bool tag_is_number (const s_tag *tag)
{
assert(tag);
switch (tag->type) {
@@ -1455,7 +1477,7 @@ e_bool tag_is_number (const s_tag *tag)
return false;
}
-e_bool tag_is_unbound_var (const s_tag *tag)
+bool tag_is_unbound_var (const s_tag *tag)
{
return (tag &&
tag->type == TAG_VAR);
diff --git a/libc3/tag.h b/libc3/tag.h
index 19af629..6e9ba04 100644
--- a/libc3/tag.h
+++ b/libc3/tag.h
@@ -89,12 +89,15 @@ s_tag * tag_new_var ();
void tag_delete (s_tag *tag);
/* Observers */
+s_tag * tag_equal (const s_tag *a, const s_tag *b,
+ s_tag *dest);
u64 tag_hash_u64 (const s_tag *tag);
uw tag_hash_uw (const s_tag *tag);
s_str * tag_inspect (const s_tag *tag, s_str *dest);
-e_bool tag_is_bound_var (const s_tag *tag);
-e_bool tag_is_number (const s_tag *tag);
-e_bool tag_is_unbound_var (const s_tag *tag);
+bool tag_ident_is_unbound (const s_tag *tag);
+bool tag_is_bound_var (const s_tag *tag);
+bool tag_is_number (const s_tag *tag);
+bool tag_is_unbound_var (const s_tag *tag);
s8 tag_number_compare (const s_tag *a, const s_tag *b);
s_tag * tag_paren (const s_tag *tag, s_tag *dest);
sw tag_size (const s_tag *tag);