Commit 324c58853081df4a009bf81678839b47b3cc83a2

Thomas de Grivel 2023-02-09T18:07:11

wip

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;