diff --git a/libc3/env.c b/libc3/env.c
index cb56321..fd10d3a 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -334,8 +334,8 @@ bool env_eval_equal_list (s_env *env, const s_list *a, const s_list *b,
bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
s_tag *dest)
{
- e_tag_type type_a;
- e_tag_type type_b;
+ bool is_unbound_a;
+ bool is_unbound_b;
s_tag tmp_a;
s_tag tmp_b;
assert(env);
@@ -344,29 +344,40 @@ 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);
- type_a = a->type;
- type_b = b->type;
- if (type_a == TAG_IDENT &&
- b->type == TAG_IDENT) {
- warnx("TAG_IDENT = TAG_IDENT");
+ is_unbound_a = a->type == TAG_IDENT && ! tag_ident_is_bound(a);
+ is_unbound_b = b->type == TAG_IDENT && ! tag_ident_is_bound(b);
+ 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 (type_a == TAG_CALL) {
+ 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))
return false;
a = &tmp_a;
}
- if (type_b == TAG_CALL) {
+ if (b->type == TAG_CALL) {
if (! env_eval_call(env, &b->data.call, &tmp_b))
return false;
b = &tmp_b;
}
- if (type_a == TAG_IDENT) {
+ if (is_unbound_a) {
tag_copy(b, dest);
frame_binding_new(env->frame, a->data.ident.sym, dest);
return true;
}
- if (type_b == TAG_IDENT) {
+ if (is_unbound_b) {
tag_copy(a, dest);
frame_binding_new(env->frame, b->data.ident.sym, dest);
return true;
@@ -379,8 +390,6 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
case TAG_VOID:
tag_init_void(dest);
return true;
- case TAG_IDENT:
- error("env_eval_equal_tag: TAG_IDENT");
case TAG_LIST:
tag_init_list(dest, NULL);
return env_eval_equal_list(env, a->data.list, b->data.list,
@@ -400,6 +409,7 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
case TAG_F32:
case TAG_F64:
case TAG_FN:
+ case TAG_IDENT:
case TAG_INTEGER:
case TAG_PTAG:
case TAG_S16:
@@ -456,9 +466,8 @@ bool env_eval_ident (s_env *env, const s_ident *ident, s_tag *dest)
assert(ident);
if (! ((tag = frame_get(env->frame, ident->sym)) ||
(tag = module_get(env->current_module, ident->sym, &tmp)))) {
- tag_init_var(dest);
- frame_binding_new(env->frame, ident->sym, dest);
- return true;
+ warnx("unbound ident: %s", ident->sym->str.ptr.ps8);
+ return false;
}
tag_copy(tag, dest);
return true;
diff --git a/libc3/tag.c b/libc3/tag.c
index 4b4d1cc..387bd7e 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -1088,15 +1088,15 @@ s_tag * tag_ident_1 (s_tag *tag, const s8 *p)
return tag_init_ident_1(tag, p);
}
-bool tag_ident_is_unbound (const s_tag *tag)
+bool tag_ident_is_bound (const s_tag *tag)
{
s_tag tmp;
assert(tag);
assert(tag->type == TAG_IDENT);
return tag->type == TAG_IDENT &&
- ! (frame_get(g_c3_env.frame, tag->data.ident.sym) ||
- module_get(g_c3_env.current_module, tag->data.ident.sym,
- &tmp));
+ (frame_get(g_c3_env.frame, tag->data.ident.sym) ||
+ module_get(g_c3_env.current_module, tag->data.ident.sym,
+ &tmp));
}
s_tag * tag_init (s_tag *tag)
@@ -1516,6 +1516,7 @@ bool tag_lte (const s_tag *a, const s_tag *b)
s_tag * tag_mul (const s_tag *a, const s_tag *b, s_tag *dest)
{
s_integer tmp;
+ s_integer tmp2;
assert(a);
assert(b);
assert(dest);
@@ -1859,7 +1860,13 @@ s_tag * tag_mul (const s_tag *a, const s_tag *b, s_tag *dest)
case TAG_U32:
return tag_init_u32(dest, a->data.u32 * b->data.u32);
case TAG_U64:
- return tag_init_u64(dest, (u64) a->data.u32 * b->data.u64);
+ integer_init_u32(&tmp, a->data.u32);
+ integer_init_u64(&tmp2, b->data.u64);
+ tag_init_integer_zero(dest);
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
default:
goto ko;
}
@@ -1876,21 +1883,69 @@ s_tag * tag_mul (const s_tag *a, const s_tag *b, s_tag *dest)
integer_clean(&tmp);
return dest;
case TAG_S8:
- return tag_init_s64(dest, (s64) a->data.u64 * (s64) b->data.s8);
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s32(&tmp2, (s32) b->data.s8);
+ tag_init_integer_zero(dest);
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
case TAG_S16:
- return tag_init_s64(dest, (s64) a->data.u64 * (s64) b->data.s16);
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s32(&tmp2, (s32) b->data.s16);
+ tag_init_integer_zero(dest);
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
case TAG_S32:
- return tag_init_s64(dest, (s64) a->data.u64 * (s64) b->data.s32);
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s32(&tmp2, b->data.s32);
+ tag_init_integer_zero(dest);
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
case TAG_S64:
- return tag_init_s64(dest, (s64) a->data.u64 * b->data.s64);
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s64(&tmp2, b->data.s64);
+ tag_init_integer_zero(dest);
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
case TAG_U8:
- return tag_init_u64(dest, a->data.u64 * (u64) b->data.u8);
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_u32(&tmp2, (u32) b->data.u8);
+ tag_init_integer_zero(dest);
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
case TAG_U16:
- return tag_init_u64(dest, a->data.u64 * (u64) b->data.u16);
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_u32(&tmp2, (u32) b->data.u16);
+ tag_init_integer_zero(dest);
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
case TAG_U32:
- return tag_init_u64(dest, a->data.u64 * (u64) b->data.u32);
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_u32(&tmp2, b->data.u32);
+ tag_init_integer_zero(dest);
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
case TAG_U64:
- return tag_init_u64(dest, a->data.u64 * b->data.u64);
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_u64(&tmp2, b->data.u64);
+ tag_init_integer_zero(dest);
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
default:
goto ko;
}
diff --git a/libc3/tag.h b/libc3/tag.h
index 6e9ba04..be3d406 100644
--- a/libc3/tag.h
+++ b/libc3/tag.h
@@ -94,7 +94,7 @@ s_tag * tag_equal (const s_tag *a, const s_tag *b,
u64 tag_hash_u64 (const s_tag *tag);
uw tag_hash_uw (const s_tag *tag);
s_str * tag_inspect (const s_tag *tag, s_str *dest);
-bool tag_ident_is_unbound (const s_tag *tag);
+bool tag_ident_is_bound (const s_tag *tag);
bool tag_is_bound_var (const s_tag *tag);
bool tag_is_number (const s_tag *tag);
bool tag_is_unbound_var (const s_tag *tag);