Commit 149669c12832d3a3bf1a3f86edc3ec6f881738e2

Thomas de Grivel 2025-07-04T23:45:20

wip frame

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]"),