Commit 79b545799441b7b984798d5d66bf7f3793447ab8

Thomas de Grivel 2023-02-02T17:31:53

wip

diff --git a/lib/c3.facts b/lib/c3.facts
new file mode 100644
index 0000000..98750fb
--- /dev/null
+++ b/lib/c3.facts
@@ -0,0 +1,7 @@
+%{module: C3.Facts.Dump,
+  version: 0x0000000000000001,
+  count: 0x0000000000000003}
+{C3, :is-a, :module}
+{C3, :name, "C3"}
+{C3, :path, "c3.facts"}
+%{hash: 0x0000000000000000}
diff --git a/libc3/buf.c b/libc3/buf.c
index 5c139a0..ebf2342 100644
--- a/libc3/buf.c
+++ b/libc3/buf.c
@@ -156,9 +156,20 @@ s_buf * buf_init (s_buf *buf, bool free, uw size, s8 *p)
   return buf;
 }
 
+s_buf * buf_init_str (s_buf *buf, const s_str *str)
+{
+  assert(buf);
+  assert(str);
+  buf_init_alloc(buf, str->size);
+  memcpy(buf->ptr.p, str->ptr.p, str->size);
+  buf->wpos = str->size;
+  return buf;
+}
+
 s_buf * buf_init_1 (s_buf *buf, const s8 *p)
 {
   uw size;
+  assert(buf);
   assert(p);
   size = strlen(p);
   buf_init_alloc(buf, size);
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index 524420a..28d5c9e 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -555,7 +555,9 @@ sw buf_parse_ident (s_buf *buf, s_ident *dest)
   s_buf tmp;
   assert(buf);
   assert(dest);
-  assert(g_c3_env.current_module);
+  /* 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)
diff --git a/libc3/c3.c b/libc3/c3.c
index bfba734..87aa10b 100644
--- a/libc3/c3.c
+++ b/libc3/c3.c
@@ -22,7 +22,8 @@ void c3_init (s_env *env)
 {
   if (! env)
     env = &g_c3_env;
-  env_init(env);
+  if (! env_init(env))
+    exit(1);
 #ifdef DEBUG
   buf_init_alloc(&g_debug_buf, 1024);
   buf_file_open_w(&g_debug_buf, stderr);
diff --git a/libc3/c3.h b/libc3/c3.h
index c46d063..ebe49c8 100644
--- a/libc3/c3.h
+++ b/libc3/c3.h
@@ -34,12 +34,15 @@
 #include "ident.h"
 #include "integer.h"
 #include "list.h"
+#include "module.h"
 #include "quote.h"
 #include "str.h"
 #include "tag.h"
 #include "tuple.h"
 #include "ucd.h"
 
+#define C3_EXT ".c3"
+
 extern s_env g_c3_env;
 
 void c3_init (s_env *env);
diff --git a/libc3/env.c b/libc3/env.c
index 02226d5..092e0d6 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -196,7 +196,10 @@ s_env * env_init (s_env *env)
   env->error_handler = NULL;
   env->frame = NULL;
   facts_init(&env->facts);
-  module_load(&env->c3_module, sym_1("C3"), &env->facts);
+  str_init_1(&env->module_path, NULL, "/home/dx/c/c3-lang/c3/lib");
+  if (! module_load(&env->c3_module, sym_1("C3"), &env->facts))
+    return NULL;
+  env->current_module = &env->c3_module;
   return env;
 }
 
@@ -214,6 +217,24 @@ void env_longjmp (s_env *env, jmp_buf *jmp_buf)
   longjmp(*jmp_buf, 1);
 }
 
+s_module * env_module_load (s_env *env, s_module *module,
+                            const s_sym *name, s_facts *facts)
+{
+  s_str path;
+  assert(env);
+  assert(module);
+  assert(name);
+  assert(facts);
+  module->name = name;
+  module->facts = facts;
+  if (! module_name_path(&env->module_path, name, &path))
+    return 0;
+  printf("module_load %s -> %s\n", name->str.ptr.ps8, path.ptr.ps8);
+  if (facts_load_file(facts, path.ptr.ps8) < 0)
+    return 0;
+  return module;
+}
+
 void env_pop_error_handler (s_env *env)
 {
   if (env->error_handler)
diff --git a/libc3/env.h b/libc3/env.h
index 7930517..b77dade 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -28,6 +28,8 @@ s_tag *       env_eval_fn (s_env *env, const s_fn *fn, s_tag *dest);
 const s_tag * env_eval_ident (s_env *env, const s_ident *ident);
 s_tag *       env_eval_progn (s_env *env, const s_list *program, s_tag *dest);
 s_tag *       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);
 
 /* control structures */
 void env_error_f (s_env *env, const char *fmt, ...);
diff --git a/libc3/facts.c b/libc3/facts.c
index 4dff40b..dc84a0d 100644
--- a/libc3/facts.c
+++ b/libc3/facts.c
@@ -285,7 +285,10 @@ sw facts_load_file (s_facts *facts, const s8 *path)
   assert(facts);
   assert(path);
   buf_init(&buf, false, sizeof(b), b);
-  fp = fopen(path, "r");
+  if (! (fp = fopen(path, "r"))) {
+    warn("facts_load_file: %s", path);
+    return -1;
+  }
   buf_file_open_r(&buf, fp);
   result = facts_load(facts, &buf);
   buf_file_close(&buf);
diff --git a/libc3/facts.h b/libc3/facts.h
index b253245..38506a4 100644
--- a/libc3/facts.h
+++ b/libc3/facts.h
@@ -16,6 +16,8 @@
 
 #include "types.h"
 
+#define FACTS_EXT ".facts"
+
 #define facts_count(f) ((f)->facts.count)
 
 /* Stack allocation compatible functions */
diff --git a/libc3/module.c b/libc3/module.c
index a51cbff..e12aa7e 100644
--- a/libc3/module.c
+++ b/libc3/module.c
@@ -11,50 +11,77 @@
  * AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
  * THIS SOFTWARE.
  */
-#include "module.h"
+#include <assert.h>
+#include <string.h>
+#include "c3.h"
 
 s_module * module_load (s_module *module, const s_sym *name,
                         s_facts *facts)
 {
-  s_str path;
-  assert(module);
-  module->name = name;
-  module->facts = facts;
-  module_path_from_name(&path, name);
-  facts_load()
+  return env_module_load(&g_c3_env, module, name, facts);
 }
 
-s_str * module_path_from_name (s_str *str, const s_sym *name)
+s_str * module_name_path (const s_str *prefix, const s_sym *name,
+                          s_str *dest)
 {
   character b = -1;
   character c;
   s_buf in;
   s_buf out;
+  sw out_size;
   sw r;
-  sw result;
-  assert(str);
+  assert(dest);
   assert(name);
-  buf_init(&in, false, name->str.size, name->str.ptr.p);
-  buf_init_alloc(&out, i * 2);
-  while ((r = buf_read_character(&in, &c)) > 0) {
+  buf_init_str(&in, &name->str);
+  out_size = module_name_path_size(prefix, name);
+  buf_init_alloc(&out, out_size);
+  if ((r = buf_write_str(&out, prefix)) < 0)
+    goto error;
+  if ((r = buf_write_s8(&out, '/')) < 0)
+    goto error;
+  while ((r = buf_read_character_utf8(&in, &c)) > 0) {
     if (c == '.')
       c = '/';
-    else if (character_is_uppercase(c))
+    else if (character_is_uppercase(c)) {
       if (character_is_lowercase(b)) {
         if ((r = buf_write_s8(&out, '_')) < 0)
           goto error;
-        result += r;
-        
-             
-      
-      c = *in;
-      if ((r = buf_write_s8(&out, '_')) < 0)
-        goto error;
-      result += r;
-    in++;
+      }
+      c = character_to_lower(c);
+    }
+    if ((r = buf_write_character_utf8(&out, c)) < 0)
+      goto error;
+    b = c;
   }
-  
+  buf_write_1(&out, FACTS_EXT);
+  buf_clean(&in);
+  return buf_to_str(&out, dest);
  error:
+  buf_clean(&in);
   buf_clean(&out);
   return NULL;
 }
+
+sw module_name_path_size (const s_str *prefix, const s_sym *name)
+{
+  character b;
+  character c;
+  s_buf in;
+  sw r;
+  sw result = 0;
+  assert(prefix);
+  assert(name);
+  buf_init_str(&in, &name->str);
+  result += prefix->size;
+  result++;
+  while ((r = buf_read_character_utf8(&in, &c)) > 0) {
+    if (character_is_uppercase(c))
+      if (character_is_lowercase(b))
+        result += 1;
+    result += character_utf8_size(c);
+    b = c;
+  }
+  result += strlen(FACTS_EXT);
+  buf_clean(&in);
+  return result;
+}
diff --git a/libc3/module.h b/libc3/module.h
index 8f4c2d2..d617b24 100644
--- a/libc3/module.h
+++ b/libc3/module.h
@@ -21,7 +21,13 @@
 #ifndef MODULE_H
 #define MODULE_H
 
+#include "types.h"
+
 s_module * module_load (s_module *module, const s_sym *name,
                         s_facts *facts);
+s_str *    module_name_path (const s_str *prefix, const s_sym *name,
+                             s_str *dest);
+sw         module_name_path_size (const s_str *prefix,
+                                  const s_sym *name);
 
 #endif /* MODULE_H */
diff --git a/libc3/types.h b/libc3/types.h
index 83f86d6..de81671 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -404,6 +404,7 @@ struct env {
   s_facts           facts;
   s_frame          *frame;
   s_buf             in;
+  s_str             module_path;
   s_buf             out;
   s_unwind_protect *unwind_protect;
 };
diff --git a/test/ic3/function_call.in b/test/ic3/function_call.in
new file mode 100644
index 0000000..a6db9d7
--- /dev/null
+++ b/test/ic3/function_call.in
@@ -0,0 +1,17 @@
+a = fn {
+  (u8 x) { 8 * x }
+  (s8 x) { -8 * x }
+  (u16 x) { 16 * x }
+  (s16 x) {
+    -16 * x
+  }
+}
+
+a(1)
+a(2)
+a(-1)
+a(-2)
+a(1000)
+a(2000)
+a(-1000)
+a(-2000)