Commit 5282e1c15d96f2b356879926d89f1733fb6adc0e
2023-09-04T17:16:02
wip
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
diff --git a/libc3/env.c b/libc3/env.c
index 8f5d84d..12125db 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -182,6 +182,7 @@ bool env_eval_call_fn (s_env *env, const s_call *call, s_tag *dest)
}
args_final = args;
}
+ /* FIXME: bindings go through clauses */
while (clause && ! env_eval_equal_list(env, clause->pattern,
args_final, &tmp))
clause = clause->next_clause;
@@ -260,7 +261,7 @@ bool env_eval_equal_list (s_env *env, const s_list *a, const s_list *b,
if (! a_next || ! b_next) {
if (! env_eval_equal_tag(env, &a->next, &b->next, &(*t)->next))
goto ko;
- break;
+ goto ok;
}
a = a_next;
b = b_next;
@@ -287,31 +288,21 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
assert(dest);
tag_init_void(&tmp_a);
tag_init_void(&tmp_b);
- is_unbound_a = a->type == TAG_IDENT && ! tag_ident_is_bound(a);
- is_unbound_b = b->type == TAG_IDENT && ! tag_ident_is_bound(b);
+ is_unbound_a = a->type == TAG_IDENT;
+ is_unbound_b = b->type == TAG_IDENT;
if (is_unbound_a && is_unbound_b) {
warnx("unbound equal on both sides: %s = %s",
a->data.ident.sym->str.ptr.ps8,
b->data.ident.sym->str.ptr.ps8);
return false;
}
- if (a->type == TAG_IDENT && tag_ident_is_bound(a)) {
- if (! env_eval_ident(env, &a->data.ident, &tmp_a))
- return false;
- a = &tmp_a;
- }
- if (b->type == TAG_IDENT && tag_ident_is_bound(b)) {
- if (! env_eval_ident(env, &b->data.ident, &tmp_b))
- return false;
- b = &tmp_b;
- }
- if (a->type == TAG_CALL) {
- if (! env_eval_call(env, &a->data.call, &tmp_a))
+ if (! is_unbound_a) {
+ if (! env_eval_tag(env, a, &tmp_a))
return false;
a = &tmp_a;
}
- if (b->type == TAG_CALL) {
- if (! env_eval_call(env, &b->data.call, &tmp_b))
+ if (! is_unbound_b) {
+ if (! env_eval_tag(env, b, &tmp_b))
return false;
b = &tmp_b;
}
@@ -461,17 +452,20 @@ bool env_eval_list (s_env *env, const s_list *list, s_tag *dest)
while (list) {
*tail = list_new(NULL, NULL);
if (! env_eval_tag(env, &list->tag, &(*tail)->tag))
- return false;
+ goto ko;
next = list_next(list);
if (! next)
if (! env_eval_tag(env, &list->next, &(*tail)->next))
- return false;
+ goto ko;
tail = &(*tail)->next.data.list;
list = next;
}
dest->type = TAG_LIST;
dest->data.list = tmp;
return true;
+ ko:
+ list_delete_all(tmp);
+ return false;
}
bool env_eval_progn (s_env *env, const s_list *program, s_tag *dest)
diff --git a/test/env_test.c b/test/env_test.c
index 0e9ce31..7fa0d5b 100644
--- a/test/env_test.c
+++ b/test/env_test.c
@@ -47,11 +47,7 @@ TEST_CASE(env_eval_equal_tag)
env_init(&env);
env.frame = frame_init(&frame, env.frame);
test_context("x = (1, 2)");
- TEST_ASSERT(env_eval_equal_tag(&env, tag_1(&x, "x"),
- tag_1(&y, "(1, 2)"), &z));
- TEST_ASSERT(frame_get(&frame, x.data.ident.sym));
- TEST_EQ(compare_tag(&z, &y), 0);
- tag_clean(&z);
+ TEST_ASSERT(frame_get(&frame, sym_1("x")));
env.frame = frame_clean(&frame);
env_clean(&env);
env_init(&env);
@@ -65,7 +61,7 @@ TEST_CASE(env_eval_equal_tag)
env_clean(&env);
env_init(&env);
env.frame = frame_init(&frame, env.frame);
- test_context("x = (1, 2)");
+ test_context("(a, b) = (1, 2)");
TEST_ASSERT(env_eval_equal_tag(&env, tag_1(&x, "(a, b)"),
tag_1(&y, "(1, 2)"), &z));
TEST_ASSERT(frame_get(&frame, sym_1("a")));