Commit 6d801ead0f771608e63a3da8b45b91cf111f6051

Thomas de Grivel 2024-04-29T22:57:41

wip def

diff --git a/lib/c3/0.1/c3.facts b/lib/c3/0.1/c3.facts
index d48c0a9..e18aa9b 100644
--- a/lib/c3/0.1/c3.facts
+++ b/lib/c3/0.1/c3.facts
@@ -234,3 +234,5 @@ replace {C3.defoperator, :is_a, :special_operator}
 replace {C3.defoperator, :symbol_value, cfn Tag "c3_defoperator" (Sym, Sym, Tag, U8, Sym, Result)}
 add {C3, :symbol, C3.module}
 replace {C3.module, :symbol_value, cfn Sym "c3_module" (Result)}
+add {C3, :symbol, C3.search_modules}
+replace {C3.search_modules, :symbol_value, cfn List "c3_search_modules" (Result)}
diff --git a/libc3/c3.c b/libc3/c3.c
index 890bff6..8f74f72 100644
--- a/libc3/c3.c
+++ b/libc3/c3.c
@@ -151,3 +151,8 @@ s_tag * c3_pin (const s_tag *a, s_tag *dest)
     return NULL;
   return dest;
 }
+
+s_list ** c3_search_modules (s_list **dest)
+{
+  return env_search_modules(&g_c3_env, dest);
+}
diff --git a/libc3/compare.c b/libc3/compare.c
index 24cc747..35f17a0 100644
--- a/libc3/compare.c
+++ b/libc3/compare.c
@@ -242,6 +242,8 @@ s8 compare_fn (const s_fn *a, const s_fn *b)
     return -1;
   if (!b)
     return 1;
+  if ((r = compare_sym(a->module, b->module)))
+    return r;
   if ((r = compare_bool(a->special_operator, b->special_operator)))
     return r;
   if ((r = compare_bool(a->macro, b->macro)))
diff --git a/libc3/env.c b/libc3/env.c
index 4f6b658..c3566d7 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -97,8 +97,9 @@ s_tag * env_def (s_env *env, const s_call *call, s_tag *dest)
     return NULL;
   }
   tag_ident.type = TAG_IDENT;
-  env_ident_resolve_module(env, &call->arguments->tag.data.ident,
-                           &tag_ident.data.ident);
+  if (! env_ident_resolve_module(env, &call->arguments->tag.data.ident,
+                                 &tag_ident.data.ident))
+    return NULL;
   tag_init_sym(&tag_module, tag_ident.data.ident.module);
   tag_init_sym(&tag_symbol, &g_sym_symbol);
   if (! facts_add_tags(&env->facts, &tag_module, &tag_symbol,
@@ -443,12 +444,17 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
   assert(env);
   assert(fn);
   assert(dest);
+  search_modules = env->search_modules;
+  if (! env_module_search_modules(env, fn->module, &env->search_modules))
+    return false;
   clause = fn->clauses;
   if (arguments) {
     if (fn->macro || fn->special_operator)
       args_final = arguments;
     else {
       if (! env_eval_call_arguments(env, arguments, &args)) {
+        list_delete_all(env->search_modules);
+        env->search_modules = search_modules;
         return false;
       }
       args_final = args;
@@ -474,6 +480,8 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
       err_inspect_fn_pattern(args);
       err_puts("\n");
       list_delete_all(args);
+      list_delete_all(env->search_modules);
+      env->search_modules = search_modules;
       return false;
     }
   }
@@ -481,8 +489,6 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
     frame_init(&frame, env->frame);
     env->frame = &frame;
   }
-  search_modules = env->search_modules;
-  env->search_modules = env_module_search_modules(env, fn->module);
   if (! env_eval_block(env, &clause->algo, &tag)) {
     list_delete_all(args);
     list_delete_all(tmp);
@@ -865,6 +871,7 @@ bool env_eval_fn (s_env *env, const s_fn *fn, s_tag *dest)
   return true;
 }
 
+/*
 // Like tag_init_copy excepted that the idents get resolved.
 bool env_eval_fn_tag (s_env *env, const s_tag *tag, s_tag *dest)
 {
@@ -1193,6 +1200,7 @@ bool env_eval_fn_tag_unquote (s_env *env, const s_unquote *unquote,
   *dest = tmp;
   return true;
 }
+*/
 
 bool env_eval_ident (s_env *env, const s_ident *ident, s_tag *dest)
 {
@@ -1201,9 +1209,9 @@ bool env_eval_ident (s_env *env, const s_ident *ident, s_tag *dest)
   s_ident tmp_ident;
   assert(env);
   assert(ident);
-  env_ident_resolve_module(env, ident, &tmp_ident);
-  if (! ((tag = env_frames_get(env, tmp_ident.sym)) ||
-         (tag = ident_get(&tmp_ident, &env->facts, &tmp)))) {
+  if (! (tag = env_frames_get(env, ident->sym)) &&
+      env_ident_resolve_module(env, ident, &tmp_ident) &&
+      ! (tag = ident_get(&tmp_ident, &env->facts, &tmp))) {
     err_write_1("env_eval_ident: unbound ident: ");
     err_inspect_ident(ident);
     err_write_1("\n");
@@ -1222,8 +1230,8 @@ bool env_eval_ident_is_bound (s_env *env, const s_ident *ident)
   assert(ident);
   if (env_frames_get(env, ident->sym))
     return true;
-  env_ident_resolve_module(env, ident, &tmp_ident);
-  if (ident_get(&tmp_ident, &env->facts, &tmp)) {
+  if (env_ident_resolve_module(env, ident, &tmp_ident) &&
+      ident_get(&tmp_ident, &env->facts, &tmp)) {
     tag_clean(&tmp);
     return true;
   }
@@ -1815,7 +1823,8 @@ bool env_ident_is_special_operator (s_env *env,
   assert(env);
   assert(ident);
   tag_ident.type = TAG_IDENT;
-  env_ident_resolve_module(env, ident, &tag_ident.data.ident);
+  if (! env_ident_resolve_module(env, ident, &tag_ident.data.ident))
+    return false;
   tag_init_sym(&tag_is_a, &g_sym_is_a);
   tag_init_sym(&tag_special_operator, &g_sym_special_operator);
   if (facts_find_fact_by_tags(&env->facts, &tag_ident, &tag_is_a,
@@ -2123,12 +2132,30 @@ bool env_module_maybe_reload (s_env *env, const s_sym *module,
   return r;
 }
 
-s_list * env_module_search_modules (s_env *env, const s_sym *module)
+s_list ** env_module_search_modules (s_env *env, const s_sym *module, s_list **dest)
 {
+  s_list *tmp;
+  s_list *tmp2;
   assert(env);
-  assert(module);
   (void) env;
-  return list_new_sym(module, NULL);
+  if (! module) {
+    err_puts("env_module_search_modules: NULL module");
+    assert(! "env_module_search_modules: NULL module");
+    return NULL;
+  }
+  if (! (tmp = list_new_sym(&g_sym_C3, NULL)))
+    return NULL;
+  if (module == &g_sym_C3) {
+    *dest = tmp;
+    return dest;
+  }
+  tmp2 = list_new_sym(module, tmp);
+  if (! tmp2) {
+    list_delete(tmp);
+    return NULL;
+  }
+  *dest = tmp2;
+  return dest;
 }
 
 s8 env_operator_arity (s_env *env, const s_ident *op)
@@ -2331,8 +2358,7 @@ s_list ** env_search_modules (s_env *env, s_list **dest)
   assert(dest);
   assert(env->search_modules);
   assert(env->search_modules->tag.type == TAG_SYM);
-  *dest = env->search_modules;
-  return dest;
+  return list_init_copy(dest, (const s_list * const *) &env->search_modules);
 }
 
 bool env_sym_search_modules (s_env *env, const s_sym *sym,
diff --git a/libc3/env.h b/libc3/env.h
index 0818e6c..ea96846 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -27,8 +27,10 @@ s_ident *      env_ident_resolve_module (s_env *env,
                                          const s_ident *ident,
                                          s_ident *dest);
 const s_sym ** env_module (s_env *env, const s_sym **dest);
-s_list *       env_module_search_modules (s_env *env,
-                                          const s_sym *module);
+s_list **      env_module_search_modules (s_env *env,
+                                          const s_sym *module,
+                                          s_list **dest);
+s_list **      env_search_modules (s_env *env, s_list **dest);
 bool           env_sym_search_modules (s_env *env,
                                        const s_sym *sym,
                                        const s_sym **dest);
diff --git a/libc3/hash.c b/libc3/hash.c
index cbc914a..94592e1 100644
--- a/libc3/hash.c
+++ b/libc3/hash.c
@@ -198,11 +198,13 @@ bool hash_update_fn (t_hash *hash, const s_fn *fn)
   const char type[] = "fn";
   assert(hash);
   assert(fn);
-  return hash_update(hash, type, sizeof(type)) &&
-    hash_update_bool(hash, &fn->macro) &&
-    hash_update_bool(hash, &fn->special_operator) &&
-    (! fn->module || hash_update_sym(hash, &fn->module)) &&
-    hash_update_fn_clauses(hash, fn->clauses);
+  if (! hash_update(hash, type, sizeof(type)) ||
+      ! hash_update_bool(hash, &fn->macro) ||
+      ! hash_update_bool(hash, &fn->special_operator))
+    return false;
+  if (fn->module && ! hash_update_sym(hash, &fn->module))
+    return false;
+  return hash_update_fn_clauses(hash, fn->clauses);
 }
 
 bool hash_update_fn_clauses (t_hash *hash, const s_fn_clause *clauses)
diff --git a/libc3/list.h b/libc3/list.h
index eda757e..229383e 100644
--- a/libc3/list.h
+++ b/libc3/list.h
@@ -50,6 +50,7 @@ s_list * list_new_tag_copy (const s_tag *tag, s_list *next);
 
 /* Observers */
 s_list ** list_cast (const s_tag *tag, s_list **list);
+bool      list_has (const s_list *list, const s_tag *tag);
 bool      list_is_plist (const s_list *list);
 sw        list_length (const s_list *list);
 s_list  * list_next (const s_list *list);
diff --git a/test/ic3/def.in b/test/ic3/def.in
index ec97557..663f2d0 100644
--- a/test/ic3/def.in
+++ b/test/ic3/def.in
@@ -84,6 +84,8 @@ quote reverse([1, 2, 3])
 reverse([1, 2, 3])
 quote module()
 module()
+quote search_modules()
+search_modules()
 quote reverse
 reverse
 quote def reverse = fn (x) { [:reversed | List.reverse(x)] }
@@ -92,6 +94,10 @@ quote reverse
 reverse
 quote reverse([1, 2, 3])
 reverse([1, 2, 3])
+quote module()
+module()
+quote search_modules()
+search_modules()
 quote reverse
 reverse
 quote def reverse = fn (x) { List.reverse(x) }
@@ -100,5 +106,9 @@ quote reverse
 reverse
 quote reverse([1, 2, 3])
 reverse([1, 2, 3])
+quote module()
+module()
+quote search_modules()
+search_modules()
 quote reverse
 reverse
diff --git a/test/ic3/def.out.expected b/test/ic3/def.out.expected
index 80d0f7b..e2980a2 100644
--- a/test/ic3/def.out.expected
+++ b/test/ic3/def.out.expected
@@ -84,6 +84,8 @@ reverse([1, 2, 3])
 [3, 2, 1]
 module()
 C3
+search_modules()
+[C3]
 reverse
 fn (x) { List.reverse(x) }
 def reverse = fn (x) { [:reversed | List.reverse(x)] }
@@ -92,6 +94,10 @@ reverse
 fn (x) { [:reversed | List.reverse(x)] }
 reverse([1, 2, 3])
 [:reversed, 3, 2, 1]
+module()
+C3
+search_modules()
+[C3]
 reverse
 fn (x) { [:reversed | List.reverse(x)] }
 def reverse = fn (x) { List.reverse(x) }
@@ -100,5 +106,9 @@ reverse
 fn (x) { List.reverse(x) }
 reverse([1, 2, 3])
 [3, 2, 1]
+module()
+C3
+search_modules()
+[C3]
 reverse
 fn (x) { List.reverse(x) }