diff --git a/libkc3/buf_inspect.c b/libkc3/buf_inspect.c
index f3410de..97f982f 100644
--- a/libkc3/buf_inspect.c
+++ b/libkc3/buf_inspect.c
@@ -2339,18 +2339,6 @@ sw buf_inspect_frame (s_buf *buf, const s_frame *frame)
result += r;
}
}
- f = frame->fn_frame;
- while (f) {
- if ((r = buf_inspect_binding(buf, f->bindings)) < 0)
- goto clean;
- result += r;
- f = f->next;
- if (f) {
- if ((r = buf_write_1(buf, ",\n")) < 0)
- goto clean;
- result += r;
- }
- }
if ((r = buf_write_1(buf, "]")) < 0)
goto clean;
result += r;
diff --git a/libkc3/env.c b/libkc3/env.c
index a2c19cf..b4084ba 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -1053,7 +1053,7 @@ s_frame * env_frame_new_capture (s_env *env, s_fn *fn)
s_list *pattern;
assert(env);
assert(fn);
- frame = frame_new(NULL, NULL);
+ frame = frame_new(NULL);
clause = fn->clauses;
while (clause) {
pattern = clause->pattern;
@@ -1116,7 +1116,7 @@ s_env * env_globals_init (s_env *env)
s_tag *file_dir;
s_tag *file_path;
s_tag *ncpu;
- if (! (env->read_time_frame = frame_new(NULL, NULL)))
+ if (! (env->read_time_frame = frame_new(NULL)))
return NULL;
if (! (file_dir = frame_binding_new(env->read_time_frame,
&g_sym___DIR__)))
@@ -1129,7 +1129,7 @@ s_env * env_globals_init (s_env *env)
return NULL;
if (! tag_init_str_1(file_path, NULL, "stdin"))
return NULL;
- if (! (env->global_frame = frame_new(env->read_time_frame, NULL)))
+ if (! (env->global_frame = frame_new(env->read_time_frame)))
return NULL;
if (! (ncpu = frame_binding_new(env->read_time_frame,
&g_sym_ncpu)))
@@ -1423,7 +1423,7 @@ s_tag * env_let (s_env *env, s_tag *vars, s_tag *tag,
assert(vars);
assert(tag);
assert(dest);
- if (! frame_init(&frame, env->frame, NULL))
+ if (! frame_init(&frame, env->frame))
return NULL;
env->frame = &frame;
if (! env_eval_tag(env, vars, &tmp)) {
@@ -2297,13 +2297,15 @@ bool env_tag_ident_is_bound (s_env *env, const s_tag *tag)
void env_toplevel_clean (s_env *env)
{
- frame_delete_all(env->frame);
+ frame_clean(&env->toplevel_frame);
}
s_env * env_toplevel_init (s_env *env)
{
assert(! env->frame);
- env->frame = frame_new(NULL, NULL);
+ if (! frame_init(&env->toplevel_frame, NULL))
+ return NULL;
+ env->frame = &env->toplevel_frame;
return env;
}
diff --git a/libkc3/env_eval.c b/libkc3/env_eval.c
index 29bb192..be7541d 100644
--- a/libkc3/env_eval.c
+++ b/libkc3/env_eval.c
@@ -320,19 +320,22 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
args_final = args;
}
while (clause) {
- if (! frame_init(&frame, env->frame, fn->frame)) {
+ assert(! fn->frame->next);
+ if (! frame_init_copy(&frame, fn->frame)) {
list_delete_all(args);
env->silence_errors = silence_errors;
list_delete_all(env->search_modules);
env->search_modules = search_modules;
return false;
}
+ frame.next = env_frame;
env->frame = &frame;
env->silence_errors = true;
env_unwind_protect_push(env, &jump.unwind_pattern);
if (setjmp(jump.unwind_pattern.buf)) {
env_unwind_protect_pop(env, &jump.unwind_pattern);
env->silence_errors = silence_errors;
+ assert(env->frame == &frame);
env->frame = env_frame;
list_delete_all(args);
longjmp(*jump.unwind_pattern.jmp, 1);
@@ -372,7 +375,14 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
}
}
else {
- frame_init(&frame, env->frame, fn->frame);
+ if (! frame_init_copy(&frame, fn->frame)) {
+ list_delete_all(args);
+ list_delete_all(tmp);
+ list_delete_all(env->search_modules);
+ env->search_modules = search_modules;
+ return false;
+ }
+ frame.next = env->frame;
env->frame = &frame;
}
if (! (trace = list_new(env->stacktrace))) {
@@ -441,6 +451,7 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
env->search_modules = search_modules;
assert(env->frame == &frame);
env->frame = env_frame;
+ frame_clean(&frame);
ok:
block_clean(&jump.block);
if (fn->macro) {
diff --git a/libkc3/env_fork.c b/libkc3/env_fork.c
index e59aba7..704efcb 100644
--- a/libkc3/env_fork.c
+++ b/libkc3/env_fork.c
@@ -51,7 +51,7 @@ s_env * env_fork_init (s_env *env, s_env *src)
//tmp.error_handler = NULL;
tmp.facts = src->facts;
tmp.frame = frame_new_copy(src->frame);
- tmp.global_frame = src->global_frame;
+ tmp.global_frame = frame_new_copy(src->global_frame);
tmp.in = src->in;
tmp.loaded = true;
tmp.module_path = src->module_path;
@@ -61,10 +61,12 @@ s_env * env_fork_init (s_env *env, s_env *src)
tmp.pass_by_copy = src->pass_by_copy;
tmp.path = src->path;
tmp.quote_level = src->quote_level;
- if (! (tmp.read_time_frame = frame_new(NULL, NULL)))
+ if (! (tmp.read_time_frame = frame_new(NULL)))
return NULL;
tmp.search_modules = src->search_modules_default;
tmp.search_modules_default = src->search_modules_default;
+ if (! frame_init_copy(&tmp.toplevel_frame, &src->toplevel_frame))
+ return NULL;
tmp.trace = src->trace;
//tmp.unquote_level = 0;
//tmp.unwind_protect = NULL;
diff --git a/libkc3/env_frame_capture.c b/libkc3/env_frame_capture.c
index 84da2ba..3815491 100644
--- a/libkc3/env_frame_capture.c
+++ b/libkc3/env_frame_capture.c
@@ -131,7 +131,6 @@ s_frame * env_frame_capture_list (s_env *env, s_frame *frame,
s_list *l = list;
assert(env);
assert(frame);
- assert(list);
while (l) {
if (! env_frame_capture_tag(env, frame, &l->tag))
return NULL;
diff --git a/libkc3/frame.c b/libkc3/frame.c
index 6b9643a..b8cd7f9 100644
--- a/libkc3/frame.c
+++ b/libkc3/frame.c
@@ -114,8 +114,6 @@ s_frame * frame_clean (s_frame *frame)
assert(frame);
next = frame->next;
binding_delete_all(frame->bindings);
- if (frame->fn_frame)
- frame_delete_all(frame->fn_frame);
return next;
}
@@ -149,15 +147,6 @@ s_tag * frame_get (s_frame *frame, const s_sym *sym)
return result;
f = f->next;
}
- f = frame;
- while (f) {
- if (f->fn_frame) {
- result = frame_get(f->fn_frame, sym);
- if (result)
- return result;
- }
- f = f->next;
- }
return NULL;
}
@@ -173,36 +162,38 @@ s_tag * frame_get_w (s_frame *frame, const s_sym *sym)
return result;
f = f->next;
}
- f = frame;
- while (f) {
- if (f->fn_frame) {
- result = frame_get_w(f->fn_frame, sym);
- if (result)
- return result;
- }
- f = f->next;
- }
return NULL;
}
-s_frame * frame_init (s_frame *frame, s_frame *next,
- const s_frame *fn_frame)
+s_frame * frame_init (s_frame *frame, s_frame *next)
{
s_frame tmp = {0};
assert(frame);
tmp.next = next;
- tmp.fn_frame = frame_new_copy(fn_frame);
+ *frame = tmp;
+ return frame;
+}
+s_frame * frame_init_copy (s_frame *frame, s_frame *src)
+{
+ s_frame tmp = {0};
+ if (! frame_init(&tmp, NULL))
+ return NULL;
+ if (src->bindings &&
+ ! (tmp.bindings = binding_new_copy(src->bindings))) {
+ frame_clean(&tmp);
+ return NULL;
+ }
*frame = tmp;
return frame;
}
-s_frame * frame_new (s_frame *next, const s_frame *fn_frame)
+s_frame * frame_new (s_frame *next)
{
s_frame *frame;
frame = alloc(sizeof(s_frame));
if (! frame)
return NULL;
- if (! frame_init(frame, next, fn_frame)) {
+ if (! frame_init(frame, next)) {
free(frame);
return NULL;
}
@@ -218,7 +209,7 @@ s_frame * frame_new_copy (const s_frame *src)
f = &frame;
s = src;
while (s) {
- *f = frame_new(NULL, s->fn_frame);
+ *f = frame_new(NULL);
if (s->bindings &&
! ((*f)->bindings = binding_new_copy(s->bindings)))
goto clean;
diff --git a/libkc3/frame.h b/libkc3/frame.h
index 22a7846..0dff029 100644
--- a/libkc3/frame.h
+++ b/libkc3/frame.h
@@ -17,11 +17,11 @@
/* Stack-allocation compatible functions, call frame_clean after use. */
s_frame * frame_clean (s_frame *frame);
-s_frame * frame_init (s_frame *frame, s_frame *next,
- const s_frame *fn_frame);
+s_frame * frame_init (s_frame *frame, s_frame *next);
+s_frame * frame_init_copy (s_frame *frame, s_frame *src);
/* Constructors. */
-s_frame * frame_new (s_frame *next, const s_frame *fn_frame);
+s_frame * frame_new (s_frame *next);
s_frame * frame_new_copy (const s_frame *src);
/* Destructors. */
diff --git a/libkc3/types.h b/libkc3/types.h
index c990da9..7c48754 100644
--- a/libkc3/types.h
+++ b/libkc3/types.h
@@ -320,7 +320,6 @@ struct fn_clause {
struct frame {
s_binding *bindings;
s_frame *next;
- s_frame *fn_frame;
};
struct fact_list {
@@ -848,6 +847,7 @@ struct env {
s_list *search_modules_default;
bool silence_errors;
s_list *stacktrace;
+ s_frame toplevel_frame;
bool trace;
uw unquote_level;
s_unwind_protect *unwind_protect;
diff --git a/test/env_test.c b/test/env_test.c
index 1a561a1..905f0b6 100644
--- a/test/env_test.c
+++ b/test/env_test.c
@@ -65,7 +65,7 @@ TEST_CASE(env_eval_equal_tag)
s_tag y;
s_tag z;
env_init(&env, 0, NULL);
- env.frame = frame_init(&frame, env.frame, NULL);
+ env.frame = frame_init(&frame, env.frame);
test_context("x = 1");
TEST_ASSERT(env_eval_equal_tag(&env, false,
tag_init_1(&x, "x"),
@@ -77,7 +77,7 @@ TEST_CASE(env_eval_equal_tag)
env.frame = frame_clean(&frame);
env_clean(&env);
env_init(&env, 0, NULL);
- env.frame = frame_init(&frame, env.frame, NULL);
+ env.frame = frame_init(&frame, env.frame);
test_context("x = (1, 2]");
TEST_ASSERT(env_eval_equal_tag(&env, false,
tag_init_1(&x, "x"),
@@ -89,7 +89,7 @@ TEST_CASE(env_eval_equal_tag)
env.frame = frame_clean(&frame);
env_clean(&env);
env_init(&env, 0, NULL);
- env.frame = frame_init(&frame, env.frame, NULL);
+ env.frame = frame_init(&frame, env.frame);
test_context("[] = []");
TEST_ASSERT(env_eval_equal_tag(&env, false,
tag_1(&x, "[]"),
@@ -100,7 +100,7 @@ TEST_CASE(env_eval_equal_tag)
env.frame = frame_clean(&frame);
env_clean(&env);
env_init(&env, 0, NULL);
- env.frame = frame_init(&frame, env.frame, NULL);
+ env.frame = frame_init(&frame, env.frame);
test_context("[a, b] = [1, 2]");
TEST_ASSERT(env_eval_equal_tag(&env, false,
tag_1(&x, "[a, b]"),
@@ -113,7 +113,7 @@ TEST_CASE(env_eval_equal_tag)
env.frame = frame_clean(&frame);
env_clean(&env);
env_init(&env, 0, NULL);
- env.frame = frame_init(&frame, env.frame, NULL);
+ env.frame = frame_init(&frame, env.frame);
test_context("x = [1, 2]");
TEST_ASSERT(env_eval_equal_tag(&env, false,
tag_1(&x, "[a | b]"),