diff --git a/libc3/buf_inspect.c b/libc3/buf_inspect.c
index fc80257..4b3361f 100644
--- a/libc3/buf_inspect.c
+++ b/libc3/buf_inspect.c
@@ -230,8 +230,8 @@ sw buf_inspect_ident (s_buf *buf, const s_ident *ident)
assert(buf);
assert(ident);
result = 0;
- if (ident->module && ident->module != g_c3_env.current_module->name) {
- if ((r = buf_inspect_sym(buf, ident->module)) < 0)
+ if (ident->module_name) {
+ if ((r = buf_inspect_sym(buf, ident->module_name)) < 0)
return r;
result += r;
if ((r = buf_write_1(buf, ".")) < 0)
@@ -285,8 +285,8 @@ sw buf_inspect_ident_size (const s_ident *ident)
sw r;
sw result = 0;
assert(ident);
- if (ident->module && ident->module != g_c3_env.current_module->name) {
- if ((r = buf_inspect_sym_size(ident->module)) < 0)
+ if (ident->module_name) {
+ if ((r = buf_inspect_sym_size(ident->module_name)) < 0)
return r;
result += r;
result += strlen(".");
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index 28d5c9e..c646723 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -555,12 +555,8 @@ sw buf_parse_ident (s_buf *buf, s_ident *dest)
s_buf tmp;
assert(buf);
assert(dest);
- /* XXX cannot parse ident if there is no module */
- if (! g_c3_env.current_module)
- return 0;
- module_name = g_c3_env.current_module->name;
buf_save_init(buf, &save);
- if ((r = buf_parse_module(buf, &module_name)) < 0)
+ if ((r = buf_parse_module_name(buf, &module_name)) < 0)
goto clean;
if (r > 0) {
result += r;
@@ -599,7 +595,7 @@ sw buf_parse_ident (s_buf *buf, s_ident *dest)
}
buf_read_to_str(&tmp, &str);
str_to_ident(&str, dest);
- dest->module = module_name;
+ dest->module_name = module_name;
str_clean(&str);
r = result;
goto clean;
@@ -906,7 +902,7 @@ sw buf_parse_list (s_buf *buf, s_list **list)
return r;
}
-sw buf_parse_module (s_buf *buf, const s_sym **dest)
+sw buf_parse_module_name (s_buf *buf, const s_sym **dest)
{
sw r;
sw result = 0;
diff --git a/libc3/buf_parse.h b/libc3/buf_parse.h
index 814fa39..6286201 100644
--- a/libc3/buf_parse.h
+++ b/libc3/buf_parse.h
@@ -54,7 +54,7 @@ sw buf_parse_integer_unsigned_oct (s_buf *buf, s_integer *dest);
sw buf_parse_ident (s_buf *buf, s_ident *dest);
sw buf_parse_integer (s_buf *buf, s_integer *dest);
sw buf_parse_list (s_buf *buf, s_list **dest);
-sw buf_parse_module (s_buf *buf, const s_sym **dest);
+sw buf_parse_module_name (s_buf *buf, const s_sym **dest);
sw buf_parse_new_tag (s_buf *buf, s_tag **dest);
sw buf_parse_str (s_buf *buf, s_str *dest);
sw buf_parse_str_character (s_buf *buf, character *dest);
diff --git a/libc3/c3.c b/libc3/c3.c
index bfeed01..5a8a685 100644
--- a/libc3/c3.c
+++ b/libc3/c3.c
@@ -14,9 +14,6 @@
#include <stdio.h>
#include <stdlib.h>
#include "c3.h"
-#include "sym.h"
-
-s_env g_c3_env;
void c3_init (s_env *env)
{
diff --git a/libc3/c3.h b/libc3/c3.h
index 51ab640..7f8abe1 100644
--- a/libc3/c3.h
+++ b/libc3/c3.h
@@ -25,9 +25,13 @@
#include "character.h"
#include "compare.h"
#include "env.h"
+#include "error.h"
#include "eval.h"
#include "fact.h"
#include "facts.h"
+#include "facts_cursor.h"
+#include "facts_with.h"
+#include "facts_with_cursor.h"
#include "fn.h"
#include "hash.h"
#include "ident.h"
@@ -42,8 +46,6 @@
#define C3_EXT ".c3"
-extern s_env g_c3_env;
-
void c3_init (s_env *env);
void c3_clean (s_env *env);
diff --git a/libc3/compare.c b/libc3/compare.c
index 9312e42..3489b0a 100644
--- a/libc3/compare.c
+++ b/libc3/compare.c
@@ -145,7 +145,7 @@ s8 compare_ident (const s_ident *a, const s_ident *b)
return -1;
if (!b)
return 1;
- if ((r = compare_sym(a->module, b->module)))
+ if ((r = compare_sym(a->module_name, b->module_name)))
return r;
return compare_sym(a->sym, b->sym);
}
diff --git a/libc3/env.c b/libc3/env.c
index 0fb1589..97b2866 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -16,18 +16,11 @@
#include <stdio.h>
#include <stdlib.h>
#include "binding.h"
-#include "buf.h"
-#include "buf_file.h"
-#include "buf_inspect.h"
-#include "env.h"
+#include "c3.h"
#include "error_handler.h"
-#include "facts.h"
#include "frame.h"
-#include "list.h"
-#include "module.h"
-#include "str.h"
-#include "sym.h"
-#include "tag.h"
+
+s_env g_c3_env;
void env_clean (s_env *env)
{
@@ -77,6 +70,50 @@ void env_error_tag (s_env *env, const s_tag *tag)
}
}
+s_tag * env_eval_call (s_env *env, const s_call *call, s_tag *dest)
+{
+ s_call c;
+ s_facts_with_cursor cursor;
+ s_tag *result;
+ s_tag tag_fn;
+ s_tag tag_ident;
+ s_tag tag_is_a;
+ s_tag tag_macro;
+ s_tag tag_module;
+ s_tag tag_module_name;
+ s_tag tag_sym;
+ assert(env);
+ assert(call);
+ assert(dest);
+ call_copy(call, &c);
+ ident_resolve_module(&c.ident, env);
+ tag_init_ident(&tag_ident, &c.ident);
+ tag_init_1( &tag_is_a, ":is-a");
+ tag_init_1( &tag_macro, ":macro");
+ tag_init_1( &tag_module, ":module");
+ tag_init_sym( &tag_module_name, c.ident.module_name);
+ tag_init_sym( &tag_sym, call->ident.sym);
+ facts_with(&env->facts, &cursor, (t_facts_spec) {
+ &tag_module_name,
+ &tag_is_a, &tag_module, /* module exists */
+ &tag_sym, &tag_ident, NULL, /* module exports symbol */
+ &tag_ident, &tag_fn, /* function */
+ NULL, NULL });
+ if (! facts_with_cursor_next(&cursor))
+ errx(1, "symbol %s not found in module %s",
+ call->ident.sym->str.ptr.ps8,
+ call->ident.module_name->str.ptr.ps8);
+ facts_with_cursor_clean(&cursor);
+ facts_with(&env->facts, &cursor, (t_facts_spec) {
+ &tag_ident, &tag_is_a, &tag_macro, NULL, NULL });
+ if (facts_with_cursor_next(&cursor))
+ result = env_eval_call_macro(env, &c, dest);
+ else
+ result = env_eval_call_fn(env, &c, dest);
+ facts_with_cursor_clean(&cursor);
+ return result;
+}
+
s_tag * env_eval_call_fn (s_env *env, const s_call *call, s_tag *dest)
{
s_arg *args;
@@ -160,9 +197,7 @@ s_tag * env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
switch (tag->type.type) {
case TAG_VOID: return tag_init_void(dest);
case TAG_CALL:
- assert(! "env_eval_tag: invalid tag type: TAG_CALL");
- errx(1, "env_eval_tag: invalid tag type TAG_CALL");
- return NULL;
+ return env_eval_call(env, &tag->data.call, dest);
case TAG_CALL_FN:
return env_eval_call_fn(env, &tag->data.call, dest);
case TAG_CALL_MACRO:
diff --git a/libc3/env.h b/libc3/env.h
index b77dade..5371f8c 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -16,6 +16,8 @@
#include "types.h"
+extern s_env g_c3_env;
+
/* stack allocation compatible functions */
void env_clean (s_env *env);
s_env * env_init (s_env *env);
diff --git a/libc3/facts_with_cursor.c b/libc3/facts_with_cursor.c
index 547fe8d..f3d61b2 100644
--- a/libc3/facts_with_cursor.c
+++ b/libc3/facts_with_cursor.c
@@ -13,6 +13,9 @@
*/
#include <assert.h>
#include <stdlib.h>
+#include "buf.h"
+#include "buf_inspect.h"
+#include "env.h"
#include "facts_cursor.h"
#include "facts_spec.h"
#include "facts_with.h"
@@ -42,11 +45,11 @@ s_fact * facts_with_cursor_next (s_facts_with_cursor *cursor)
level = &cursor->levels[cursor->facts_count - 1];
#ifdef DEBUG
buf_write_1(&g_c3_env.err, "[debug] cursor->level=");
- buf_inspect_u64(&g_debug_buf, cursor->level);
+ buf_inspect_u64(&g_c3_env.err, cursor->level);
buf_write_1(&g_c3_env.err, " level->spec=");
- buf_inspect_fact_spec(&g_debug_buf, level->spec);
+ buf_inspect_fact_spec(&g_c3_env.err, level->spec);
buf_write_1(&g_c3_env.err, " ");
- buf_inspect_fact(&g_debug_buf, level->fact);
+ buf_inspect_fact(&g_c3_env.err, level->fact);
#endif
level->fact = facts_cursor_next(&level->cursor);
#ifdef DEBUG
diff --git a/libc3/ident.c b/libc3/ident.c
index 5939b84..9a7462b 100644
--- a/libc3/ident.c
+++ b/libc3/ident.c
@@ -34,7 +34,7 @@ e_bool ident_character_is_reserved (character c)
s_ident * ident_copy (const s_ident *src, s_ident *dest)
{
- dest->module = src->module;
+ dest->module_name = src->module_name;
dest->sym = src->sym;
return dest;
}
@@ -71,7 +71,7 @@ s_ident * ident_init (s_ident *ident, const s_sym *sym)
{
assert(ident);
assert(sym);
- ident->module = NULL;
+ ident->module_name = NULL;
ident->sym = sym;
return ident;
}
@@ -100,3 +100,14 @@ s_str * ident_inspect (const s_ident *ident, s_str *dest)
}
return buf_to_str(&buf, dest);
}
+
+void ident_resolve_module (s_ident *ident, const s_env *env)
+{
+ assert(env);
+ assert(ident);
+ if (! ident->module_name) {
+ assert(env->current_module);
+ ident->module_name = env->current_module->name;
+ }
+}
+
diff --git a/libc3/ident.h b/libc3/ident.h
index 6c40acd..b68b48c 100644
--- a/libc3/ident.h
+++ b/libc3/ident.h
@@ -23,6 +23,9 @@
/* Constructors, call ident_clean after use. */
s_ident * ident_init_1 (s_ident *ident, const s8 *p);
+/* Modifiers */
+s_ident * ident_resolve_module (s_ident *ident, const s_env *env);
+
/* Observers */
/* Returns true iff c is an ident reserved character. */
diff --git a/libc3/types.h b/libc3/types.h
index de81671..899be4e 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -120,6 +120,7 @@ typedef union tag_type u_tag_type;
/* typedefs */
typedef s32 character;
typedef s_tag **p_facts_spec;
+typedef s_tag *t_facts_spec[];
typedef SHA1_CTX t_hash;
typedef s_tag *p_quote;
typedef const s_tag *p_tag;
@@ -162,11 +163,6 @@ struct fn {
s_list *algo;
};
-struct ident {
- const s_sym *module;
- const s_sym *sym;
-};
-
struct module {
const s_sym *name;
s_facts *facts;
@@ -212,12 +208,6 @@ struct unwind_protect {
};
/* 2 */
-struct arg {
- const s_sym *name;
- s_ident type;
- s_arg *next;
-};
-
struct binding {
const s_sym *name;
const s_tag *value;
@@ -239,21 +229,18 @@ struct buf {
u64 wpos;
};
-struct call {
- /* key */
- s_ident ident;
- s_list *arguments;
- s_list_map *keyword;
- /* value */
- s_fn *fn;
-};
-
struct facts_spec_cursor {
p_facts_spec spec;
const s_tag *subject;
uw pos;
};
+struct ident {
+ /*const s_module *module;*/
+ const s_sym *module_name;
+ const s_sym *sym;
+};
+
struct integer {
mp_int mp_int;
};
@@ -265,6 +252,21 @@ struct str {
};
/* 3 */
+struct arg {
+ const s_sym *name;
+ s_ident type;
+ s_arg *next;
+};
+
+struct call {
+ /* key */
+ s_ident ident;
+ s_list *arguments;
+ s_list_map *keyword;
+ /* value */
+ s_fn *fn;
+};
+
struct log {
s_buf buf;
u64 count;