Commit d25c1801b6e13f1fedf006e0dbc95e4d0750bb6e

Thomas de Grivel 2024-05-19T03:38:49

env_struct_type_has_spec

diff --git a/lib/c3/0.1/c3.facts b/lib/c3/0.1/c3.facts
index 07b446e..4c4365c 100644
--- a/lib/c3/0.1/c3.facts
+++ b/lib/c3/0.1/c3.facts
@@ -15,20 +15,6 @@ replace {C3.operator_brackets, :arity, 2}
 replace {C3.operator_brackets, :symbol_value, cfn Tag "tag_brackets" (Tag, Tag, Result)}
 replace {C3.operator_brackets, :operator_precedence, 13}
 replace {C3.operator_brackets, :operator_associativity, :left}
-add {C3, :operator, C3.operator_pin}
-replace {C3.operator_pin, :is_a, :operator}
-replace {C3.operator_pin, :symbol, :^}
-replace {C3.operator_pin, :arity, 1}
-replace {C3.operator_pin, :symbol_value, cfn Tag "c3_pin" (Tag, Result)}
-replace {C3.operator_pin, :operator_precedence, 12}
-replace {C3.operator_pin, :operator_associativity, :right}
-add {C3, :operator, C3.operator_not}
-replace {C3.operator_not, :is_a, :operator}
-replace {C3.operator_not, :symbol, :!}
-replace {C3.operator_not, :arity, 1}
-replace {C3.operator_not, :symbol_value, cfn Bool "tag_not" (Tag, Result)}
-replace {C3.operator_not, :operator_precedence, 12}
-replace {C3.operator_not, :operator_associativity, :right}
 add {C3, :operator, C3.operator_bnot}
 replace {C3.operator_bnot, :is_a, :operator}
 replace {C3.operator_bnot, :symbol, :~}
@@ -36,6 +22,20 @@ replace {C3.operator_bnot, :arity, 1}
 replace {C3.operator_bnot, :symbol_value, cfn Tag "tag_bnot" (Tag, Result)}
 replace {C3.operator_bnot, :operator_precedence, 12}
 replace {C3.operator_bnot, :operator_associativity, :right}
+add {C3, :operator, C3.operator_defstruct}
+replace {C3.operator_defstruct, :is_a, :operator}
+replace {C3.operator_defstruct, :symbol, :defstruct}
+replace {C3.operator_defstruct, :arity, 1}
+replace {C3.operator_defstruct, :symbol_value, cfn Tag "c3_defstruct" (List, Result)}
+replace {C3.operator_defstruct, :operator_precedence, 12}
+replace {C3.operator_defstruct, :operator_associativity, :right}
+add {C3, :operator, C3.operator_pin}
+replace {C3.operator_pin, :is_a, :operator}
+replace {C3.operator_pin, :symbol, :^}
+replace {C3.operator_pin, :arity, 1}
+replace {C3.operator_pin, :symbol_value, cfn Tag "c3_pin" (Tag, Result)}
+replace {C3.operator_pin, :operator_precedence, 12}
+replace {C3.operator_pin, :operator_associativity, :right}
 add {C3, :operator, C3.operator_neg}
 replace {C3.operator_neg, :is_a, :operator}
 replace {C3.operator_neg, :symbol, :-}
@@ -43,13 +43,13 @@ replace {C3.operator_neg, :arity, 1}
 replace {C3.operator_neg, :symbol_value, cfn Tag "tag_neg" (Tag, Result)}
 replace {C3.operator_neg, :operator_precedence, 12}
 replace {C3.operator_neg, :operator_associativity, :right}
-add {C3, :operator, C3.operator_mul}
-replace {C3.operator_mul, :is_a, :operator}
-replace {C3.operator_mul, :symbol, :*}
-replace {C3.operator_mul, :arity, 2}
-replace {C3.operator_mul, :symbol_value, cfn Tag "tag_mul" (Tag, Tag, Result)}
-replace {C3.operator_mul, :operator_precedence, 11}
-replace {C3.operator_mul, :operator_associativity, :left}
+add {C3, :operator, C3.operator_not}
+replace {C3.operator_not, :is_a, :operator}
+replace {C3.operator_not, :symbol, :!}
+replace {C3.operator_not, :arity, 1}
+replace {C3.operator_not, :symbol_value, cfn Bool "tag_not" (Tag, Result)}
+replace {C3.operator_not, :operator_precedence, 12}
+replace {C3.operator_not, :operator_associativity, :right}
 add {C3, :operator, C3.operator_div}
 replace {C3.operator_div, :is_a, :operator}
 replace {C3.operator_div, :symbol, :/}
@@ -64,6 +64,13 @@ replace {C3.operator_mod, :arity, 2}
 replace {C3.operator_mod, :symbol_value, cfn Tag "tag_mod" (Tag, Tag, Result)}
 replace {C3.operator_mod, :operator_precedence, 11}
 replace {C3.operator_mod, :operator_associativity, :left}
+add {C3, :operator, C3.operator_mul}
+replace {C3.operator_mul, :is_a, :operator}
+replace {C3.operator_mul, :symbol, :*}
+replace {C3.operator_mul, :arity, 2}
+replace {C3.operator_mul, :symbol_value, cfn Tag "tag_mul" (Tag, Tag, Result)}
+replace {C3.operator_mul, :operator_precedence, 11}
+replace {C3.operator_mul, :operator_associativity, :left}
 add {C3, :operator, C3.operator_add}
 replace {C3.operator_add, :is_a, :operator}
 replace {C3.operator_add, :symbol, :+}
diff --git a/libc3/c3.c b/libc3/c3.c
index e02d00f..c0a67c9 100644
--- a/libc3/c3.c
+++ b/libc3/c3.c
@@ -66,6 +66,18 @@ s_tag * c3_defoperator (const s_sym **name, const s_sym **sym,
                          operator_associativity, dest);
 }
 
+s_tag * c3_defstruct (const s_list *spec, s_tag *dest)
+{
+  s_tag tmp;
+  assert(spec);
+  if (! spec)
+    return NULL;
+  tmp.type = TAG_SYM;
+  tmp.data.sym = env_defstruct(&g_c3_env, spec);
+  *dest = tmp;
+  return dest;
+}
+
 void ** c3_dlopen (const s_str *path, void **dest)
 {
   assert(path);
diff --git a/libc3/c3_main.h b/libc3/c3_main.h
index 55a3efc..5a995ab 100644
--- a/libc3/c3_main.h
+++ b/libc3/c3_main.h
@@ -43,7 +43,7 @@ s_tag * c3_defoperator (const s_sym **name, const s_sym **sym,
                         u8 operator_precedence,
                         const s_sym **operator_associativity,
                         s_tag *dest);
-s_tag * c3_defstruct (const s_list *spec);
+s_tag * c3_defstruct (const s_list *spec, s_tag *dest);
 void ** c3_dlopen (const s_str *path, void **dest);
 void    c3_exit (sw code);
 s_tag * c3_pin (const s_tag *a, s_tag *dest);
diff --git a/libc3/env.c b/libc3/env.c
index 603d538..73e092f 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -1817,11 +1817,12 @@ bool env_module_is_loading_set (s_env *env, const s_sym *module,
 
 bool env_module_load (s_env *env, const s_sym *module, s_facts *facts)
 {
-  s_facts_transaction transaction;
+  bool has_spec;
   s_str path = {0};
   s_tag tag_module_name;
   s_tag tag_load_time;
   s_tag tag_time;
+  s_facts_transaction transaction;
   assert(env);
   assert(module);
   assert(facts);
@@ -1867,10 +1868,10 @@ bool env_module_load (s_env *env, const s_sym *module, s_facts *facts)
                            &tag_time))
     goto rollback;
   tag_clean(&tag_time);
-  if (env_struct_type_has_spec(env, module)) {
-    if (! env_module_load_defstruct(env, module))
-      goto rollback;
-  }
+  if (! env_struct_type_has_spec(env, module, &has_spec))
+    goto rollback;
+  if (has_spec && ! env_module_load_defstruct(env, module))
+    goto rollback;
   env_module_is_loading_set(env, module, false);
   return true;
  rollback:
@@ -2375,8 +2376,10 @@ s_list ** env_struct_type_get_spec (s_env *env,
   return dest;
 }
 
-bool env_struct_type_has_spec (s_env *env, const s_sym *module)
+bool * env_struct_type_has_spec (s_env *env, const s_sym *module,
+                                 bool *dest)
 {
+  s_facts_cursor cursor;
   s_fact *found;
   s_tag tag_defstruct;
   s_tag tag_module;
@@ -2386,11 +2389,12 @@ bool env_struct_type_has_spec (s_env *env, const s_sym *module)
   tag_init_sym(&tag_defstruct, &g_sym_defstruct);
   tag_init_sym(&tag_module, module);
   tag_init_var(&tag_var);
-  found = facts_find_fact_by_tags(&env->facts, &tag_module,
-                                  &tag_defstruct, &tag_var);
-  if (! found)
-    return false;
-  return true;
+  if (! facts_with_tags(&env->facts, &cursor, &tag_module,
+                        &tag_defstruct, &tag_var))
+    return NULL;
+  found = facts_cursor_next(&cursor);
+  *dest = found ? true : false;
+  return dest;
 }
 
 bool env_tag_ident_is_bound (const s_env *env, const s_tag *tag,
diff --git a/libc3/env.h b/libc3/env.h
index 128da91..eb90ced 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -193,8 +193,8 @@ f_clean       env_struct_type_get_clean (s_env *env,
                                          const s_sym *module);
 s_list **     env_struct_type_get_spec (s_env *env, const s_sym *module,
                                         s_list **dest);
-bool          env_struct_type_has_spec (s_env *env,
-                                        const s_sym *module);
+bool *        env_struct_type_has_spec (s_env *env, const s_sym *module,
+                                        bool *dest);
 bool          env_tag_ident_is_bound (const s_env *env,
                                       const s_tag *tag,
                                       s_facts *facts);