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