diff --git a/lib/c3/0.1/gl/object.facts b/lib/c3/0.1/gl/object.facts
index 2d28088..3cf4fb1 100644
--- a/lib/c3/0.1/gl/object.facts
+++ b/lib/c3/0.1/gl/object.facts
@@ -7,3 +7,4 @@ replace {GL.Object, :defstruct, [vertex: (GL.Vertex[]) {},
gl_vao: (U32) 0,
gl_vbo: (U32) 0,
gl_ebo: (U32) 0]}
+replace {GL.Object, :clean, cfn Void "gl_object_clean" (GL.Object)}
diff --git a/lib/c3/0.1/gl/sphere.facts b/lib/c3/0.1/gl/sphere.facts
index 86f9b80..30e03a4 100644
--- a/lib/c3/0.1/gl/sphere.facts
+++ b/lib/c3/0.1/gl/sphere.facts
@@ -4,3 +4,4 @@ replace {GL.Sphere, :is_a, :module}
replace {GL.Sphere, :defstruct, [object: %GL.Object{},
segments_u: (Uw) 3,
segments_v: (Uw) 2]}
+replace {GL.Sphere, :clean, cfn Void "gl_sphere_clean" (GL.Sphere)}
diff --git a/libc3/env.c b/libc3/env.c
index 6d127e4..6ef829d 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -810,48 +810,6 @@ bool env_eval_void (s_env *env, const void *_, s_tag *dest)
return true;
}
-s_list ** env_get_struct_type_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;
- s_tag tag_var;
- s_tag tmp;
- assert(env);
- assert(module);
- assert(dest);
- 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);
- if (! found) {
- facts_with_cursor_clean(&cursor);
- return NULL;
- }
- if (! env_eval_tag(env, found->object, &tmp)) {
- facts_with_cursor_clean(&cursor);
- return NULL;
- }
- facts_with_cursor_clean(&cursor);
- if (tmp.type != TAG_LIST ||
- ! list_is_plist(tmp.data.list)) {
- warnx("env_get_struct_type_spec: module %s"
- " has a defstruct that is not a property list",
- module->str.ptr.pchar);
- tag_clean(&tmp);
- return NULL;
- }
- *dest = tmp.data.list;
- return dest;
-}
-
s_env * env_init (s_env *env, int argc, char **argv)
{
s_str path;
@@ -935,6 +893,46 @@ void env_longjmp (s_env *env, jmp_buf *jmp_buf)
longjmp(*jmp_buf, 1);
}
+bool env_module_is_loading (s_env *env, const s_sym *module)
+{
+ s_facts_cursor cursor;
+ s_tag tag_module;
+ s_tag tag_is_loading;
+ s_tag tag_true;
+ assert(env);
+ assert(module);
+ tag_init_sym(&tag_module, module);
+ tag_init_sym(&tag_is_loading, sym_1("is_loading"));
+ tag_init_bool(&tag_true, true);
+ facts_with_tags(&env->facts, &cursor, &tag_module, &tag_is_loading,
+ &tag_true);
+ if (facts_cursor_next(&cursor)) {
+ facts_cursor_clean(&cursor);
+ return true;
+ }
+ facts_cursor_clean(&cursor);
+ return false;
+}
+
+void env_module_is_loading_set (s_env *env, const s_sym *module,
+ bool is_loading)
+{
+ s_tag tag_module;
+ s_tag tag_is_loading;
+ s_tag tag_true;
+ assert(env);
+ assert(module);
+ tag_init_sym(&tag_module, module);
+ tag_init_sym(&tag_is_loading, sym_1("is_loading"));
+ tag_init_bool(&tag_true, true);
+ if (is_loading)
+ facts_replace_tags(&env->facts, &tag_module, &tag_is_loading,
+ &tag_true);
+ else
+ facts_remove_fact_tags(&env->facts, &tag_module, &tag_is_loading,
+ &tag_true);
+}
+
bool env_module_load (s_env *env, const s_sym *module, s_facts *facts)
{
s_str path;
@@ -948,17 +946,21 @@ bool env_module_load (s_env *env, const s_sym *module, s_facts *facts)
assert(env);
assert(module);
assert(facts);
+ if (env_module_is_loading(env, module)) {
+ return true;
+ }
+ env_module_is_loading_set(env, module, true);
if (! module_path(module, &env->module_path, &path)) {
warnx("env_module_load: %s: module_path",
module->str.ptr.pchar);
- return false;
+ goto ko;
}
tag_init_time(&tag_time);
if (facts_load_file(facts, &path) < 0) {
warnx("env_module_load: %s: facts_load_file",
path.ptr.pchar);
str_clean(&path);
- return false;
+ goto ko;
}
str_clean(&path);
tag_init_sym(&tag_module_name, module);
@@ -966,16 +968,21 @@ bool env_module_load (s_env *env, const s_sym *module, s_facts *facts)
facts_replace_tags(facts, &tag_module_name, &tag_load_time,
&tag_time);
tag_clean(&tag_time);
- if (env_get_struct_type_spec(env, module, &st_spec)) {
+ 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;
struct_type_init(st, module, st_spec);
+ st->clean = env_struct_type_get_clean(env, module);
facts_replace_tags(facts, &tag_module_name, &tag_struct_type,
&tag_st);
list_delete_all(st_spec);
}
+ env_module_is_loading_set(env, module, false);
return true;
+ ko:
+ env_module_is_loading_set(env, module, false);
+ return false;
}
bool env_module_maybe_reload (s_env *env, const s_sym *module,
@@ -1253,6 +1260,93 @@ const s_struct_type * env_struct_type_find (s_env *env,
return result;
}
+f_clean env_struct_type_get_clean (s_env *env, const s_sym *module)
+{
+ s_facts_with_cursor cursor;
+ s_fact *found;
+ s_tag tag_clean;
+ s_tag tag_module;
+ s_tag tag_var;
+ f_clean tmp;
+ const s_sym *type;
+ tag_init_sym(&tag_module, module);
+ tag_init_sym(&tag_clean, sym_1("clean"));
+ tag_init_var(&tag_var);
+ facts_with(&env->facts, &cursor, (t_facts_spec) {
+ &tag_module, &tag_clean, &tag_var, NULL, NULL });
+ found = facts_with_cursor_next(&cursor);
+ if (! found) {
+ facts_with_cursor_clean(&cursor);
+ return NULL;
+ }
+ if (found->object->type != TAG_CFN) {
+ tag_type(found->object, &type);
+ err_write_1("env_struct_type_get_clean: ");
+ err_inspect_sym(&module);
+ err_write_1(": clean is actually a ");
+ err_inspect_sym(&type);
+ err_write_1(", it should be a Cfn.\n");
+ assert(! "env_struct_type_get_clean: invalid object");
+ facts_with_cursor_clean(&cursor);
+ return NULL;
+ }
+ if (found->object->data.cfn.arity != 1) {
+ err_write_1("env_struct_type_get_clean: ");
+ err_inspect_sym(&module);
+ err_write_1(": clean arity is ");
+ err_inspect_u8(&found->object->data.cfn.arity);
+ err_write_1(", it should be 1.\n");
+ assert(! "env_struct_type_get_clean: invalid arity");
+ facts_with_cursor_clean(&cursor);
+ return NULL;
+ }
+ tmp = (f_clean) found->object->data.cfn.ptr.f;
+ facts_with_cursor_clean(&cursor);
+ return tmp;
+}
+
+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;
+ s_tag tag_var;
+ s_tag tmp;
+ assert(env);
+ assert(module);
+ assert(dest);
+ 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);
+ if (! found) {
+ facts_with_cursor_clean(&cursor);
+ return NULL;
+ }
+ if (! env_eval_tag(env, found->object, &tmp)) {
+ facts_with_cursor_clean(&cursor);
+ return NULL;
+ }
+ facts_with_cursor_clean(&cursor);
+ if (tmp.type != TAG_LIST ||
+ ! list_is_plist(tmp.data.list)) {
+ warnx("env_get_struct_type_spec: module %s"
+ " has a defstruct that is not a property list",
+ module->str.ptr.pchar);
+ tag_clean(&tmp);
+ return NULL;
+ }
+ *dest = tmp.data.list;
+ return dest;
+}
+
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 377daa0..4e13a06 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -64,8 +64,10 @@ bool env_eval_tag (s_env *env, const s_tag *tag,
bool env_eval_tuple (s_env *env, const s_tuple *tuple,
s_tag *dest);
bool env_eval_void (s_env *env, const void *_, s_tag *dest);
-s_list ** env_get_struct_type_spec (s_env *env, const s_sym *module,
- s_list **dest);
+bool env_module_is_loading (s_env *env, const s_sym *module);
+void env_module_is_loading_set (s_env *env,
+ const s_sym *module,
+ bool value);
bool env_module_load (s_env *env, const s_sym *module,
s_facts *facts);
bool env_module_maybe_reload (s_env *env,
@@ -85,6 +87,10 @@ bool env_struct_type_exists (s_env *env,
const s_sym *module);
const s_struct_type *
env_struct_type_find (s_env *env, const s_sym *module);
+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_tag_ident_is_bound (const s_env *env,
const s_tag *tag,
s_facts *facts);
diff --git a/libc3/facts.c b/libc3/facts.c
index 9cc3304..e41ae7b 100644
--- a/libc3/facts.c
+++ b/libc3/facts.c
@@ -608,6 +608,20 @@ bool facts_remove_fact (s_facts *facts, const s_fact *fact)
return result;
}
+bool facts_remove_fact_tags (s_facts *facts, const s_tag *subject,
+ const s_tag *predicate,
+ const s_tag *object)
+{
+ s_fact fact;
+ assert(facts);
+ assert(subject);
+ assert(predicate);
+ assert(object);
+ fact.subject = subject;
+ fact.predicate = predicate;
+ fact.object = object;
+ return facts_remove_fact(facts, &fact);
+}
s_fact * facts_replace_fact (s_facts *facts, const s_fact *fact)
{
diff --git a/libc3/facts.h b/libc3/facts.h
index e76695e..9603dad 100644
--- a/libc3/facts.h
+++ b/libc3/facts.h
@@ -46,6 +46,9 @@ void facts_lock_w (s_facts *facts);
sw facts_open_file (s_facts *facts, const s_str *path);
s_tag * facts_ref_tag (s_facts *facts, const s_tag *tag);
bool facts_remove_fact (s_facts *facts, const s_fact *fact);
+bool facts_remove_fact_tags (s_facts *facts, const s_tag *subject,
+ const s_tag *predicate,
+ const s_tag *object);
void facts_remove_all (s_facts *facts);
s_fact * facts_replace_fact (s_facts *facts, const s_fact *fact);
s_fact * facts_replace_tags (s_facts *facts, const s_tag *subject,
diff --git a/libc3/struct.c b/libc3/struct.c
index 7f0463f..5945313 100644
--- a/libc3/struct.c
+++ b/libc3/struct.c
@@ -48,7 +48,9 @@ void struct_clean (s_struct *s)
assert(s);
assert(s->type);
if (s->data) {
- if (s->type->must_clean) {
+ if (s->type->clean)
+ s->type->clean(s->data);
+ else if (s->type->must_clean) {
i = 0;
while (i < s->type->map.count) {
if (tag_type(s->type->map.value + i, &sym))
diff --git a/libc3/struct_type.c b/libc3/struct_type.c
index 0510f4f..8aa15f1 100644
--- a/libc3/struct_type.c
+++ b/libc3/struct_type.c
@@ -142,7 +142,7 @@ s_struct_type * struct_type_init_from_env (s_struct_type *st,
assert(st);
assert(module);
assert(env);
- if (! env_get_struct_type_spec(env, module, &spec) ||
+ if (! env_struct_type_get_spec(env, module, &spec) ||
! spec)
return NULL;
if (! struct_type_init(st, module, spec))
diff --git a/libc3/types.h b/libc3/types.h
index ca47f11..7384bbe 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -185,6 +185,7 @@ typedef const s_tag *p_tag;
typedef u64 t_skiplist_height;
/* function typedefs */
+typedef void (* f_clean) (void *x);
typedef bool (* f_sequence) (s_sequence *seq);
typedef bool (* f_sequence_button) (s_sequence *seq, u8 button, sw x,
sw y);
@@ -337,6 +338,7 @@ struct struct_type {
bool must_clean;
uw *offset;
uw size;
+ f_clean clean;
};
/* 3 */
diff --git a/libc3/window/cairo/demo/flies.c b/libc3/window/cairo/demo/flies.c
index 9f9790c..170b5ad 100644
--- a/libc3/window/cairo/demo/flies.c
+++ b/libc3/window/cairo/demo/flies.c
@@ -70,7 +70,7 @@ bool flies_load (s_sequence *seq)
tag_init_sym(map->key + 3, sym_1("t"));
tag_init_uw( map->value + 3, 0);
board = &map->value[0].data.array;
- board->data = malloc(board->size);
+ array_allocate(board);
i = 0;
while (i < BOARD_SIZE) {
address[0] = i;
diff --git a/libc3/window/sdl2/demo/flies.c b/libc3/window/sdl2/demo/flies.c
index e115b53..aa23be9 100644
--- a/libc3/window/sdl2/demo/flies.c
+++ b/libc3/window/sdl2/demo/flies.c
@@ -75,7 +75,7 @@ bool flies_load (s_sequence *seq)
tag_init_sym( map->key + 3, sym_1("t"));
tag_init_uw( map->value + 3, 0);
board = &map->value[0].data.array;
- board->data = malloc(board->size);
+ array_allocate(board);
i = 0;
while (i < BOARD_SIZE) {
address[0] = i;