Commit 74b7f1e6420b2a9b4d6d5a21b8b96b5e002a6cb3
2024-05-18T20:48:23
env_defstruct
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
diff --git a/libc3/c3_main.h b/libc3/c3_main.h
index 45a5a0e..55a3efc 100644
--- a/libc3/c3_main.h
+++ b/libc3/c3_main.h
@@ -43,6 +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);
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 d3451fa..603d538 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -239,32 +239,24 @@ s_tag * env_defoperator (s_env *env, const s_sym **name,
return dest;
}
-const s_sym * env_defstruct (s_env *env, const s_sym *module)
+const s_sym * env_defstruct (s_env *env, const s_list *spec)
{
s_struct_type *st;
- s_list *st_spec;
s_tag tag_module_name;
s_tag tag_st = {0};
s_tag tag_struct_type;
- tag_init_sym(&tag_module_name, module);
- if (env_struct_type_get_spec(env, module, &st_spec)) {
- tag_init_sym(&tag_struct_type, &g_sym_struct_type);
- tag_st.type = TAG_STRUCT_TYPE;
- st = &tag_st.data.struct_type;
- if (! struct_type_init(st, module, st_spec)) {
- list_delete_all(st_spec);
- return NULL;
- }
- st->clean = env_struct_type_get_clean(env, module);
- if (! facts_replace_tags(&env->facts, &tag_module_name,
- &tag_struct_type, &tag_st)) {
+ tag_init_sym(&tag_module_name, env->current_defmodule);
+ tag_init_sym(&tag_struct_type, &g_sym_struct_type);
+ tag_st.type = TAG_STRUCT_TYPE;
+ st = &tag_st.data.struct_type;
+ if (! struct_type_init(st, env->current_defmodule, spec))
+ return NULL;
+ if (! facts_replace_tags(&env->facts, &tag_module_name,
+ &tag_struct_type, &tag_st)) {
struct_type_clean(st);
- list_delete_all(st_spec);
return NULL;
- }
- list_delete_all(st_spec);
}
- return module;
+ return env->current_defmodule;
}
void env_error_f (s_env *env, const char *fmt, ...)
@@ -1875,8 +1867,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_defstruct(env, module))
- goto rollback;
+ if (env_struct_type_has_spec(env, module)) {
+ if (! env_module_load_defstruct(env, module))
+ goto rollback;
+ }
env_module_is_loading_set(env, module, false);
return true;
rollback:
@@ -1887,6 +1881,35 @@ bool env_module_load (s_env *env, const s_sym *module, s_facts *facts)
return false;
}
+const s_sym * env_module_load_defstruct (s_env *env,
+ const s_sym *module)
+{
+ s_struct_type *st;
+ s_list *st_spec;
+ s_tag tag_module_name;
+ s_tag tag_st = {0};
+ s_tag tag_struct_type;
+ if (! env_struct_type_get_spec(env, module, &st_spec))
+ return NULL;
+ tag_st.type = TAG_STRUCT_TYPE;
+ st = &tag_st.data.struct_type;
+ if (! struct_type_init(st, module, st_spec)) {
+ list_delete_all(st_spec);
+ return NULL;
+ }
+ st->clean = env_struct_type_get_clean(env, module);
+ tag_init_sym(&tag_module_name, module);
+ tag_init_sym(&tag_struct_type, &g_sym_struct_type);
+ if (! facts_replace_tags(&env->facts, &tag_module_name,
+ &tag_struct_type, &tag_st)) {
+ struct_type_clean(st);
+ list_delete_all(st_spec);
+ return NULL;
+ }
+ list_delete_all(st_spec);
+ return module;
+}
+
bool env_module_maybe_reload (s_env *env, const s_sym *module,
s_facts *facts)
{
@@ -2318,7 +2341,6 @@ s_list ** env_struct_type_get_spec (s_env *env,
const s_sym *module,
s_list **dest)
{
- s_facts_with_cursor cursor;
s_fact *found;
s_tag tag_defstruct;
s_tag tag_module;
@@ -2330,20 +2352,17 @@ s_list ** env_struct_type_get_spec (s_env *env,
tag_init_sym(&tag_defstruct, &g_sym_defstruct);
tag_init_sym(&tag_module, module);
tag_init_var(&tag_var);
- if (! env_module_maybe_reload(env, module, &env->facts))
- return NULL;
- facts_with(&env->facts, &cursor, (t_facts_spec) {
- &tag_module, &tag_defstruct, &tag_var, NULL, NULL });
- found = facts_with_cursor_next(&cursor);
+ found = facts_find_fact_by_tags(&env->facts, &tag_module,
+ &tag_defstruct, &tag_var);
if (! found) {
- facts_with_cursor_clean(&cursor);
+ err_write_1("env_struct_type_get_spec: ");
+ err_inspect_sym(&module);
+ err_puts(": defstruct not found");
+ assert(! "env_struct_type_get_spec: defstruct not found");
return NULL;
}
- if (! env_eval_tag(env, found->object, &tmp)) {
- facts_with_cursor_clean(&cursor);
+ if (! env_eval_tag(env, found->object, &tmp))
return NULL;
- }
- facts_with_cursor_clean(&cursor);
if (tmp.type != TAG_LIST ||
! list_is_plist(tmp.data.list)) {
err_write_1("env_get_struct_type_spec: module ");
@@ -2356,6 +2375,24 @@ 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)
+{
+ s_fact *found;
+ s_tag tag_defstruct;
+ s_tag tag_module;
+ s_tag tag_var;
+ assert(env);
+ assert(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;
+}
+
bool env_tag_ident_is_bound (const s_env *env, const s_tag *tag,
s_facts *facts)
{
diff --git a/libc3/env.h b/libc3/env.h
index abc3cd5..128da91 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -45,6 +45,9 @@ s_tag * env_defoperator (s_env *env, const s_sym **name,
u8 operator_precedence,
const s_sym **operator_associativity,
s_tag *dest);
+const s_sym * env_defstruct (s_env *env, const s_list *spec);
+const s_sym * env_module_load_defstruct (s_env *env,
+ const s_sym *module);
bool env_eval_array (s_env *env, const s_array *array,
s_array *dest);
bool env_eval_array_tag (s_env *env, const s_array *array,
@@ -190,6 +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_tag_ident_is_bound (const s_env *env,
const s_tag *tag,
s_facts *facts);