Commit 4f551b1602966c98caac8cc8ba24713cfe01c61a

Thomas de Grivel 2024-09-17T17:27:18

fix closures

diff --git a/.ikc3_history b/.ikc3_history
index f905207..72d0cdd 100644
--- a/.ikc3_history
+++ b/.ikc3_history
@@ -1,8 +1,3 @@
-a = 1
-a
-to_lisp(quote a = ? <- 1 ; 2)
-a = ?
-Facts.with_tags(Facts.env_facts(), KC3, :operator, a, fn (fact) { puts(a); 1 })
 to_lisp(quote a = ? <- 1 ; 2)
 to_lisp(quote a = 1 ; 2)
 to_lisp(quote a = ? <- 1 ; 2)
@@ -97,3 +92,8 @@ a
 a = cow 1 + 1
 a
 Str.split("./fx/README", "/")
+op = ?
+op <- 1
+op
+type(op)
+?0x4c21af5a1f0
diff --git a/libkc3/env.c b/libkc3/env.c
index 414146b..f78a4e4 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -690,7 +690,7 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
       args_final = args;
     }
     while (clause) {
-      if (! frame_init(&frame, fn->frame)) {
+      if (! frame_init(&frame, env->frame, fn->frame)) {
         list_delete_all(env->search_modules);
         env->search_modules = search_modules;
         return false;
@@ -721,7 +721,7 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
     }
   }
   else {
-    frame_init(&frame, env->frame);
+    frame_init(&frame, env->frame, fn->frame);
     env->frame = &frame;
   }
   if (! env_eval_block(env, &clause->algo, &tag)) {
@@ -2528,7 +2528,7 @@ s_env * env_init_globals (s_env *env)
 {
   s_tag *file_dir;
   s_tag *file_path;
-  if (! frame_init(&env->read_time_frame, NULL))
+  if (! frame_init(&env->read_time_frame, NULL, NULL))
     return NULL;
   if (! (file_dir = frame_binding_new(&env->read_time_frame,
                                       &g_sym___DIR__)))
@@ -2541,14 +2541,14 @@ s_env * env_init_globals (s_env *env)
     return NULL;
   if (! tag_init_str_1(file_path, NULL, "stdin"))
     return NULL;
-  if (! frame_init(&env->global_frame, &env->read_time_frame))
+  if (! frame_init(&env->global_frame, &env->read_time_frame, NULL))
     return NULL;
   return env;
 }
 
 s_env * env_init_toplevel (s_env *env)
 {
-  env->frame = frame_new(NULL);
+  env->frame = frame_new(NULL, NULL);
   return env;
 }
 
@@ -2595,7 +2595,7 @@ s_tag * env_kc3_def (s_env *env, const s_call *call, s_tag *dest)
 s_tag * env_let (s_env *env, const s_tag *tag, const s_block *block,
                  s_tag *dest)
 {
-  s_frame *frame;
+  s_frame frame;
   uw i;
   const s_map *map;
   s_tag tmp = {0};
@@ -2603,11 +2603,11 @@ s_tag * env_let (s_env *env, const s_tag *tag, const s_block *block,
   assert(tag);
   assert(block);
   assert(dest);
-  if (! (frame = frame_new(env->frame)))
+  if (! frame_init(&frame, env->frame, NULL))
     return NULL;
-  env->frame = frame;
+  env->frame = &frame;
   if (! env_eval_tag(env, tag, &tmp)) {
-    env->frame = frame_delete(frame);
+    env->frame = frame_clean(&frame);
     return NULL;
   }
   switch(tag->type) {
@@ -2625,7 +2625,7 @@ s_tag * env_let (s_env *env, const s_tag *tag, const s_block *block,
     err_inspect_tag(tag);
     err_write_1("\n");
     assert(! "env_let: unsupported associative tag type");
-    env->frame = frame_delete(frame);
+    env->frame = frame_clean(&frame);
     return NULL;
   }
   i = 0;
@@ -2636,25 +2636,25 @@ s_tag * env_let (s_env *env, const s_tag *tag, const s_block *block,
       err_inspect_tag(map->key + i);
       err_write_1("\n");
       assert(! "env_let: binding key is not a symbol");
-      env->frame = frame_delete(frame);
+      env->frame = frame_clean(&frame);
       return NULL;
     }
-    if (! frame_binding_new_copy(env->frame,
+    if (! frame_binding_new_copy(&frame,
                                  map->key[i].data.sym,
                                  map->value + i)) {
       tag_clean(&tmp);
-      env->frame = frame_delete(frame);
+      env->frame = frame_clean(&frame);
       return NULL;
     }
     i++;
   }
   if (! env_eval_block(env, block, dest)) {
     tag_clean(&tmp);
-    env->frame = frame_delete(frame);
+    env->frame = frame_clean(&frame);
     return NULL;
   }
   tag_clean(&tmp);
-  env->frame = frame_delete(frame);
+  env->frame = frame_clean(&frame);
   return dest;
 }
 
diff --git a/libkc3/frame.c b/libkc3/frame.c
index cd37217..b87572a 100644
--- a/libkc3/frame.c
+++ b/libkc3/frame.c
@@ -130,6 +130,13 @@ const s_tag * frame_get (const s_frame *frame, const s_sym *sym)
       return result;
     f = f->next;
   }
+  f = frame->fn_frame;
+  while (f) {
+    result = binding_get(f->bindings, sym);
+    if (result)
+      return result;
+    f = f->next;
+  }
   return NULL;
 }
 
@@ -145,25 +152,33 @@ s_tag * frame_get_w (s_frame *frame, const s_sym *sym)
       return result;
     f = f->next;
   }
+  f = frame->fn_frame;
+  while (f) {
+    result = binding_get_w(f->bindings, sym);
+    if (result)
+      return result;
+    f = f->next;
+  }
   return NULL;
 }
 
-s_frame * frame_init (s_frame *frame, s_frame *next)
+s_frame * frame_init (s_frame *frame, s_frame *next, s_frame *fn_frame)
 {
   s_frame tmp = {0};
   assert(frame);
   tmp.next = next;
+  tmp.fn_frame = fn_frame;
   *frame = tmp;
   return frame;
 }
 
-s_frame * frame_new (s_frame *next)
+s_frame * frame_new (s_frame *next, s_frame *fn_frame)
 {
   s_frame *frame;
   frame = alloc(sizeof(s_frame));
   if (! frame)
     return NULL;
-  if (! frame_init(frame, next)) {
+  if (! frame_init(frame, next, fn_frame)) {
     free(frame);
     return NULL;
   }
@@ -179,7 +194,7 @@ s_frame * frame_new_copy (const s_frame *src)
   f = &frame;
   s = src;
   while (s) {
-    *f = frame_new(NULL);
+    *f = frame_new(NULL, s->fn_frame);
     if (s->bindings &&
         ! ((*f)->bindings = binding_new_copy(s->bindings)))
       goto clean;
diff --git a/libkc3/frame.h b/libkc3/frame.h
index 5c924f3..0c0407b 100644
--- a/libkc3/frame.h
+++ b/libkc3/frame.h
@@ -17,10 +17,10 @@
 
 /* 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);
+s_frame * frame_init (s_frame *frame, s_frame *next, s_frame *fn_frame);
 
 /* Constructors. */
-s_frame * frame_new (s_frame *next);
+s_frame * frame_new (s_frame *next, s_frame *fn_frame);
 s_frame * frame_new_copy (const s_frame *src);
 
 /* Destructors. */
diff --git a/libkc3/types.h b/libkc3/types.h
index d30961f..d5b651d 100644
--- a/libkc3/types.h
+++ b/libkc3/types.h
@@ -270,6 +270,7 @@ struct fn_clause {
 struct frame {
   s_binding *bindings;
   s_frame *next;
+  s_frame *fn_frame;
 };
 
 struct fact_list {
diff --git a/test/env_test.c b/test/env_test.c
index 49000a4..dfad9a9 100644
--- a/test/env_test.c
+++ b/test/env_test.c
@@ -66,7 +66,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);
+  env.frame = frame_init(&frame, env.frame, NULL);
   test_context("x = 1");
   TEST_ASSERT(env_eval_equal_tag(&env, false,
                                  tag_init_1(&x, "x"),
@@ -78,7 +78,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);
+  env.frame = frame_init(&frame, env.frame, NULL);
   test_context("x = (1, 2]");
   TEST_ASSERT(env_eval_equal_tag(&env, false,
                                  tag_init_1(&x, "x"),
@@ -90,7 +90,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);
+  env.frame = frame_init(&frame, env.frame, NULL);
   test_context("[] = []");
   TEST_ASSERT(env_eval_equal_tag(&env, false,
                                  tag_1(&x, "[]"),
@@ -101,7 +101,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);
+  env.frame = frame_init(&frame, env.frame, NULL);
   test_context("[a, b] = [1, 2]");
   TEST_ASSERT(env_eval_equal_tag(&env, false,
                                  tag_1(&x, "[a, b]"),
@@ -114,7 +114,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);
+  env.frame = frame_init(&frame, env.frame, NULL);
   test_context("x = [1, 2]");
   TEST_ASSERT(env_eval_equal_tag(&env, false,
                                  tag_1(&x, "[a | b]"),