diff --git a/libc3/env.c b/libc3/env.c
index 174dcb4..51bbed7 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -751,15 +751,15 @@ bool env_module_maybe_reload (s_env *env, const s_sym *name,
return r;
}
-bool env_operator_is_binary (s_env *env, const s_ident *op)
+s8 env_operator_arity (s_env *env, const s_ident *op)
{
s_facts_with_cursor cursor;
s8 r;
s_tag tag_ident;
s_tag tag_is_a;
- s_tag tag_arity;
s_tag tag_operator;
- s_tag tag_two;
+ s_tag tag_arity;
+ s_tag tag_var;
s_ident tmp;
assert(env);
assert(op);
diff --git a/libc3/env.h b/libc3/env.h
index dc8bf5d..bf80d67 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -57,12 +57,10 @@ bool env_module_load (s_env *env, const s_sym *name,
s_facts *facts);
bool env_module_maybe_reload (s_env *env, const s_sym *name,
s_facts *facts);
-bool env_operator_is_binary (s_env *env, const s_ident *op);
+s8 env_operator_arity (s_env *env, const s_ident *op);
bool env_operator_is_right_associative (s_env *env,
const s_ident *op);
-bool env_operator_is_unary (s_env *env, const s_ident *op);
-s8 env_operator_precedence (s_env *env,
- const s_ident *op);
+s8 env_operator_precedence (s_env *env, const s_ident *op);
bool env_tag_ident_is_bound (const s_env *env, const s_tag *tag,
s_facts *facts);
diff --git a/libc3/integer.c b/libc3/integer.c
index a487ee2..34c57c2 100644
--- a/libc3/integer.c
+++ b/libc3/integer.c
@@ -357,7 +357,7 @@ s_integer * integer_lcm (const s_integer *a, const s_integer *b,
return dest;
}
-s_integer * integer_lshift (s_integer *a, sw b, s_integer *dest)
+s_integer * integer_lshift (const s_integer *a, sw b, s_integer *dest)
{
sw r;
assert(a);
diff --git a/libc3/integer.h b/libc3/integer.h
index 74d6c80..1594d79 100644
--- a/libc3/integer.h
+++ b/libc3/integer.h
@@ -72,7 +72,7 @@ s_integer * integer_gcd (const s_integer *a, const s_integer *b,
s_integer *dest);
s_integer * integer_lcm (const s_integer *a, const s_integer *b,
s_integer *dest);
-s_integer * integer_lshift (s_integer *a, sw b, s_integer *dest);
+s_integer * integer_lshift (const s_integer *a, sw b, s_integer *dest);
s_integer * integer_mod (const s_integer *a, const s_integer *b,
s_integer *dest);
s_integer * integer_mul (const s_integer *a, const s_integer *b,
diff --git a/libc3/operator.c b/libc3/operator.c
index b7371db..83648fe 100644
--- a/libc3/operator.c
+++ b/libc3/operator.c
@@ -13,9 +13,9 @@
#include <assert.h>
#include "c3.h"
-bool operator_is_binary (const s_ident *op)
+s8 operator_arity (const s_ident *op)
{
- return env_operator_is_binary(&g_c3_env, op);
+ return env_operator_arity(&g_c3_env, op);
}
bool operator_is_right_associative (const s_ident *op)
@@ -23,11 +23,6 @@ bool operator_is_right_associative (const s_ident *op)
return env_operator_is_right_associative(&g_c3_env, op);
}
-bool operator_is_unary (const s_ident *op)
-{
- return env_operator_is_unary(&g_c3_env, op);
-}
-
s8 operator_precedence (const s_ident *op)
{
return env_operator_precedence(&g_c3_env, op);
diff --git a/libc3/operator.h b/libc3/operator.h
index e859fe3..e609b7a 100644
--- a/libc3/operator.h
+++ b/libc3/operator.h
@@ -16,9 +16,8 @@
#include "types.h"
/* Observers */
-bool operator_is_binary (const s_ident *op);
+s8 operator_arity (const s_ident *op);
bool operator_is_right_associative (const s_ident *op);
-bool operator_is_unary (const s_ident *op);
s8 operator_precedence (const s_ident *op);
#endif /* OPERATOR_H */
diff --git a/libc3/tag.c b/libc3/tag.c
index d0780b7..6725a6f 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -2007,7 +2007,7 @@ s_tag * tag_band (const s_tag *a, const s_tag *b, s_tag *result)
goto error;
}
error:
- warnx("tag_band: invalid tag type %s band %s",
+ warnx("tag_band: invalid tag type: %s & %s",
tag_type_to_string(a->type),
tag_type_to_string(b->type));
return NULL;
@@ -2060,12 +2060,19 @@ s_tag * tag_bnot (const s_tag *tag, s_tag *result)
case TAG_TUPLE:
case TAG_VAR:
case TAG_VOID:
- warnx("tag_bnot: invalid tag type %s",
+ warnx("tag_bnot: invalid tag type: %s",
tag_type_to_string(tag->type));
}
return NULL;
}
+s_tag * tag_bool (s_tag *tag, bool b)
+{
+ assert(tag);
+ tag_clean(tag);
+ return tag_init_bool(tag, b);
+}
+
s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
{
s_integer tmp;
@@ -2076,7 +2083,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
tmp_a.data.bool = a->data.bool ? 1 : 0;
switch (b->type) {
case TAG_BOOL:
- return tag_init_bool(result, tmp_a.data.bool &
+ return tag_init_bool(result, tmp_a.data.bool |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_bool(result, tmp_a.data.bool | b->data.character);
@@ -2128,7 +2135,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
case TAG_CHARACTER:
switch (b->type) {
case TAG_BOOL:
- return tag_init_character(result, a->data.character &
+ return tag_init_character(result, a->data.character |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_character(result, a->data.character | b->data.character);
@@ -2277,7 +2284,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
case TAG_SW:
switch (b->type) {
case TAG_BOOL:
- return tag_init_sw(result, a->data.sw &
+ return tag_init_sw(result, a->data.sw |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_sw(result, a->data.sw | b->data.character);
@@ -2329,7 +2336,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
case TAG_S64:
switch (b->type) {
case TAG_BOOL:
- return tag_init_s64(result, a->data.s64 &
+ return tag_init_s64(result, a->data.s64 |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_s64(result, a->data.s64 | b->data.character);
@@ -2381,7 +2388,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
case TAG_S32:
switch (b->type) {
case TAG_BOOL:
- return tag_init_s32(result, a->data.s32 &
+ return tag_init_s32(result, a->data.s32 |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_s32(result, a->data.s32 | b->data.character);
@@ -2433,7 +2440,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
case TAG_S16:
switch (b->type) {
case TAG_BOOL:
- return tag_init_s16(result, a->data.s16 &
+ return tag_init_s16(result, a->data.s16 |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_s16(result, a->data.s16 | b->data.character);
@@ -2485,7 +2492,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
case TAG_S8:
switch (b->type) {
case TAG_BOOL:
- return tag_init_s8(result, a->data.s8 &
+ return tag_init_s8(result, a->data.s8 |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_s8(result, a->data.s8 | b->data.character);
@@ -2537,7 +2544,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
case TAG_U8:
switch (b->type) {
case TAG_BOOL:
- return tag_init_u8(result, a->data.u8 &
+ return tag_init_u8(result, a->data.u8 |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_u8(result, a->data.u8 | b->data.character);
@@ -2589,7 +2596,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
case TAG_U16:
switch (b->type) {
case TAG_BOOL:
- return tag_init_u16(result, a->data.u16 &
+ return tag_init_u16(result, a->data.u16 |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_u16(result, a->data.u16 | b->data.character);
@@ -2641,7 +2648,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
case TAG_U32:
switch (b->type) {
case TAG_BOOL:
- return tag_init_u32(result, a->data.u32 &
+ return tag_init_u32(result, a->data.u32 |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_u32(result, a->data.u32 | b->data.character);
@@ -2693,7 +2700,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
case TAG_U64:
switch (b->type) {
case TAG_BOOL:
- return tag_init_u64(result, a->data.u64 &
+ return tag_init_u64(result, a->data.u64 |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_u64(result, a->data.u64 | b->data.character);
@@ -2745,7 +2752,7 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
case TAG_UW:
switch (b->type) {
case TAG_BOOL:
- return tag_init_uw(result, a->data.uw &
+ return tag_init_uw(result, a->data.uw |
(b->data.bool ? 1 : 0));
case TAG_CHARACTER:
return tag_init_uw(result, a->data.uw | b->data.character);
@@ -2813,2333 +2820,4627 @@ s_tag * tag_bor (const s_tag *a, const s_tag *b, s_tag *result)
goto error;
}
error:
- warnx("tag_bor: invalid tag type: %s bor %s",
+ warnx("tag_bor: invalid tag type: %s | %s",
tag_type_to_string(a->type),
tag_type_to_string(b->type));
return NULL;
}
-s_tag * tag_bool (s_tag *tag, bool b)
-{
- assert(tag);
- tag_clean(tag);
- return tag_init_bool(tag, b);
-}
-
-s_tag * tag_cast_integer_to_s8 (s_tag *tag)
-{
- s8 i;
- assert(tag);
- assert(tag->type == TAG_INTEGER);
- i = integer_to_s8(&tag->data.integer);
- return tag_s8(tag, i);
-}
-
-s_tag * tag_cast_integer_to_s16 (s_tag *tag)
-{
- s16 i;
- assert(tag);
- assert(tag->type == TAG_INTEGER);
- i = integer_to_s16(&tag->data.integer);
- return tag_s16(tag, i);
-}
-
-s_tag * tag_cast_integer_to_s32 (s_tag *tag)
-{
- s32 i;
- assert(tag);
- assert(tag->type == TAG_INTEGER);
- i = integer_to_s32(&tag->data.integer);
- return tag_s32(tag, i);
-}
-
-s_tag * tag_cast_integer_to_s64 (s_tag *tag)
-{
- s64 i;
- assert(tag);
- assert(tag->type == TAG_INTEGER);
- i = integer_to_s64(&tag->data.integer);
- return tag_s64(tag, i);
-}
-
-s_tag * tag_cast_integer_to_u8 (s_tag *tag)
-{
- u8 i;
- assert(tag);
- assert(tag->type == TAG_INTEGER);
- i = integer_to_u8(&tag->data.integer);
- return tag_u8(tag, i);
-}
-
-s_tag * tag_cast_integer_to_u16 (s_tag *tag)
-{
- u16 i;
- assert(tag);
- assert(tag->type == TAG_INTEGER);
- i = integer_to_u16(&tag->data.integer);
- return tag_u16(tag, i);
-}
-
-s_tag * tag_cast_integer_to_u32 (s_tag *tag)
-{
- u32 i;
- assert(tag);
- assert(tag->type == TAG_INTEGER);
- i = integer_to_u32(&tag->data.integer);
- return tag_u32(tag, i);
-}
-
-s_tag * tag_cast_integer_to_u64 (s_tag *tag)
-{
- u64 i;
- assert(tag);
- assert(tag->type == TAG_INTEGER);
- i = integer_to_u64(&tag->data.integer);
- return tag_u64(tag, i);
-}
-
-s_tag * tag_character (s_tag *tag, character x)
-{
- assert(tag);
- tag_clean(tag);
- return tag_init_character(tag, x);
-}
-
-void tag_clean (s_tag *tag)
-{
- assert(tag);
- switch (tag->type) {
- case TAG_ARRAY: array_clean(&tag->data.array); break;
- case TAG_CALL: call_clean(&tag->data.call); break;
- case TAG_CFN: cfn_clean(&tag->data.cfn); break;
- case TAG_FN: fn_clean(&tag->data.fn); break;
- case TAG_INTEGER: integer_clean(&tag->data.integer); break;
- case TAG_LIST: list_delete_all(tag->data.list); break;
- case TAG_QUOTE: quote_clean(&tag->data.quote); break;
- case TAG_STR: str_clean(&tag->data.str); break;
- case TAG_TUPLE: tuple_clean(&tag->data.tuple); break;
- case TAG_BOOL:
- case TAG_CHARACTER:
- case TAG_F32:
- case TAG_F64:
- case TAG_FACT:
- case TAG_IDENT:
- case TAG_PTAG:
- case TAG_S8:
- case TAG_S16:
- case TAG_S32:
- case TAG_S64:
- case TAG_SW:
- case TAG_SYM:
- case TAG_U8:
- case TAG_U16:
- case TAG_U32:
- case TAG_U64:
- case TAG_UW:
- case TAG_VAR:
- case TAG_VOID:
- break;
- }
-}
-
-s_tag * tag_brackets (s_tag *tag, const s_tag *address,
- s_tag *dest)
-{
- assert(tag);
- assert(address);
- assert(dest);
- switch (tag->type) {
- case TAG_ARRAY:
- switch (address->type) {
- case TAG_ARRAY:
- return array_data_tag(tag, address, dest);
- default:
- break;
- }
- default:
- break;
- }
- warnx("tag_brackets: invalid arguments");
- return NULL;
-}
-
-s_tag * tag_copy (const s_tag *src, s_tag *dest)
-{
- assert(src);
- assert(dest);
- switch (src->type) {
- case TAG_VAR:
- tag_init_var(dest);
- break;
- case TAG_VOID:
- break;
- case TAG_ARRAY:
- array_copy(&src->data.array, &dest->data.array);
- break;
- case TAG_CALL:
- call_copy(&src->data.call, &dest->data.call);
- break;
- case TAG_CFN:
- cfn_copy(&src->data.cfn, &dest->data.cfn);
- break;
- case TAG_FN:
- fn_copy(&src->data.fn, &dest->data.fn);
- break;
- case TAG_INTEGER:
- integer_copy(&src->data.integer, &dest->data.integer);
- break;
- case TAG_LIST:
- list_copy((const s_list **) &src->data.list, &dest->data.list);
- break;
- case TAG_QUOTE:
- quote_copy(&src->data.quote, &dest->data.quote);
- break;
- case TAG_STR:
- str_copy(&src->data.str, &dest->data.str);
- break;
- case TAG_TUPLE:
- tuple_copy(&src->data.tuple, &dest->data.tuple);
- break;
- case TAG_BOOL:
- case TAG_CHARACTER:
- case TAG_F32:
- case TAG_F64:
- case TAG_FACT:
- case TAG_IDENT:
- case TAG_PTAG:
- case TAG_S8:
- case TAG_S16:
- case TAG_S32:
- case TAG_S64:
- case TAG_SW:
- case TAG_SYM:
- case TAG_U8:
- case TAG_U16:
- case TAG_U32:
- case TAG_U64:
- case TAG_UW:
- dest->data = src->data;
- }
- dest->type = src->type;
- return dest;
-}
-
-void tag_delete (s_tag *tag)
-{
- tag_clean(tag);
- free(tag);
-}
-
-s_tag * tag_div (const s_tag *a, const s_tag *b, s_tag *dest)
+s_tag * tag_bxor (const s_tag *a, const s_tag *b, s_tag *result)
{
s_integer tmp;
s_integer tmp2;
- assert(a);
- assert(b);
- assert(dest);
+ s_tag tmp_a;
switch (a->type) {
- case TAG_F32:
+ case TAG_BOOL:
+ tmp_a.data.bool = a->data.bool ? 1 : 0;
switch (b->type) {
- case TAG_F32:
- return tag_init_f32(dest, a->data.f32 / b->data.f32);
- case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.f32 / b->data.f64);
+ case TAG_BOOL:
+ return tag_init_bool(result, tmp_a.data.bool ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_bool(result, tmp_a.data.bool ^ b->data.character);
case TAG_INTEGER:
- integer_init_f32(&tmp, a->data.f32);
- integer_div(&tmp, &b->data.integer, &tmp);
- tag_init_integer(dest, &tmp);
+ integer_init_u8(&tmp, tmp_a.data.bool);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_bool(result, integer_to_u8(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_f32(dest, a->data.f32 / (f32) b->data.s8);
- case TAG_S16:
- return tag_init_f32(dest, a->data.f32 / (f32) b->data.s16);
- case TAG_S32:
- return tag_init_f32(dest, a->data.f32 / (f32) b->data.s32);
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_bool(result, tmp_a.data.bool ^ b->data.sw);
case TAG_S64:
- return tag_init_f32(dest, a->data.f32 / (f32) b->data.s64);
+ return tag_init_bool(result, tmp_a.data.bool ^ b->data.s64);
+ case TAG_S32:
+ return tag_init_bool(result, tmp_a.data.bool ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_bool(result, tmp_a.data.bool ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_bool(result, tmp_a.data.bool ^ b->data.s8);
case TAG_U8:
- return tag_init_f32(dest, a->data.f32 / (f32) b->data.u8);
+ return tag_init_bool(result, tmp_a.data.bool ^ b->data.u8);
case TAG_U16:
- return tag_init_f32(dest, a->data.f32 / (f32) b->data.u16);
+ return tag_init_bool(result, tmp_a.data.bool ^ b->data.u16);
case TAG_U32:
- return tag_init_f32(dest, a->data.f32 / (f32) b->data.u32);
+ return tag_init_bool(result, tmp_a.data.bool ^ b->data.u32);
case TAG_U64:
- return tag_init_f32(dest, a->data.f32 / (f32) b->data.u64);
- default:
- goto ko;
- }
- case TAG_F64:
- switch (b->type) {
+ return tag_init_bool(result, tmp_a.data.bool ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_bool(result, tmp_a.data.bool ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f64(dest, a->data.f64 / (f64) b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, a->data.f64 / b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_CHARACTER:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_character(result, a->data.character ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_character(result, a->data.character ^ b->data.character);
case TAG_INTEGER:
- integer_init_f64(&tmp, a->data.f64);
- integer_div(&tmp, &b->data.integer, &tmp);
- tag_init_integer(dest, &tmp);
+ integer_init_u32(&tmp, a->data.character);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_character(result, integer_to_u32(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_f64(dest, a->data.f64 / (f64) b->data.s8);
- case TAG_S16:
- return tag_init_f64(dest, a->data.f64 / (f64) b->data.s16);
- case TAG_S32:
- return tag_init_f64(dest, a->data.f64 / (f64) b->data.s32);
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_character(result, a->data.character ^ b->data.sw);
case TAG_S64:
- return tag_init_f64(dest, a->data.f64 / (f64) b->data.s64);
+ return tag_init_character(result, a->data.character ^ b->data.s64);
+ case TAG_S32:
+ return tag_init_character(result, a->data.character ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_character(result, a->data.character ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_character(result, a->data.character ^ b->data.s8);
case TAG_U8:
- return tag_init_f64(dest, a->data.f64 / (f64) b->data.u8);
+ return tag_init_character(result, a->data.character ^ b->data.u8);
case TAG_U16:
- return tag_init_f64(dest, a->data.f64 / (f64) b->data.u16);
+ return tag_init_character(result, a->data.character ^ b->data.u16);
case TAG_U32:
- return tag_init_f64(dest, a->data.f64 / (f64) b->data.u32);
+ return tag_init_character(result, a->data.character ^ b->data.u32);
case TAG_U64:
- return tag_init_f64(dest, a->data.f64 / (f64) b->data.u64);
- default:
- goto ko;
- }
- case TAG_INTEGER:
- switch (b->type) {
+ return tag_init_character(result, a->data.character ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_character(result, a->data.character ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) integer_to_f64(&a->data.integer) /
- b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, integer_to_f64(&a->data.integer) /
- b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_INTEGER:
+ switch (b->type) {
+ case TAG_BOOL:
+ integer_init_u8(&tmp, b->data.bool ? 1 : 0);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
+ integer_clean(&tmp);
+ return result;
+ case TAG_CHARACTER:
+ integer_init_u32(&tmp, b->data.character);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
+ integer_clean(&tmp);
+ return result;
case TAG_INTEGER:
- dest->type = TAG_INTEGER;
- integer_div(&a->data.integer, &b->data.integer,
- &dest->data.integer);
- return dest;
- case TAG_S8:
- integer_init_s32(&tmp, b->data.s8);
- dest->type = TAG_INTEGER;
- integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &b->data.integer,
+ &result->data.integer);
+ return result;
+ case TAG_SW:
+ integer_init_sw(&tmp, b->data.sw);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
integer_clean(&tmp);
- return dest;
- case TAG_S16:
- integer_init_s32(&tmp, b->data.s16);
- dest->type = TAG_INTEGER;
- integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ return result;
+ case TAG_S64:
+ integer_init_s64(&tmp, b->data.s64);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
integer_clean(&tmp);
- return dest;
+ return result;
case TAG_S32:
integer_init_s32(&tmp, b->data.s32);
- dest->type = TAG_INTEGER;
- integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
integer_clean(&tmp);
- return dest;
- case TAG_S64:
- integer_init_s64(&tmp, b->data.s64);
- dest->type = TAG_INTEGER;
- integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ return result;
+ case TAG_S16:
+ integer_init_s16(&tmp, b->data.s16);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
integer_clean(&tmp);
- return dest;
+ return result;
+ case TAG_S8:
+ integer_init_s8(&tmp, b->data.s8);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
+ integer_clean(&tmp);
+ return result;
case TAG_U8:
- integer_init_u32(&tmp, (u32) b->data.u8);
- dest->type = TAG_INTEGER;
- integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ integer_init_u8(&tmp, b->data.u8);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
integer_clean(&tmp);
- return dest;
+ return result;
case TAG_U16:
- integer_init_u32(&tmp, (u32) b->data.u16);
- dest->type = TAG_INTEGER;
- integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ integer_init_u16(&tmp, b->data.u16);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
integer_clean(&tmp);
- return dest;
+ return result;
case TAG_U32:
integer_init_u32(&tmp, b->data.u32);
- dest->type = TAG_INTEGER;
- integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
integer_clean(&tmp);
- return dest;
+ return result;
case TAG_U64:
integer_init_u64(&tmp, b->data.u64);
- dest->type = TAG_INTEGER;
- integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
integer_clean(&tmp);
- return dest;
- default:
- goto ko;
- }
- case TAG_S8:
- switch (b->type) {
+ return result;
+ case TAG_UW:
+ integer_init_uw(&tmp, b->data.uw);
+ result->type = TAG_INTEGER;
+ integer_bxor(&a->data.integer, &tmp, &result->data.integer);
+ integer_clean(&tmp);
+ return result;
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.s8 / b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.s8 / b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_SW:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_sw(result, a->data.sw ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_sw(result, a->data.sw ^ b->data.character);
case TAG_INTEGER:
- integer_init_s32(&tmp, (s32) a->data.s8);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_sw(&tmp, a->data.sw);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_sw(result, integer_to_sw(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s8(dest, a->data.s8 / b->data.s8);
- case TAG_S16:
- return tag_init_s8(dest, (s8) ((s16) a->data.s8 / b->data.s16));
- case TAG_S32:
- return tag_init_s8(dest, (s8) ((s32) a->data.s8 / b->data.s32));
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_sw(result, a->data.sw ^ b->data.sw);
case TAG_S64:
- return tag_init_s8(dest, (s8) ((s64) a->data.s8 / b->data.s64));
+ return tag_init_sw(result, a->data.sw ^ b->data.s64);
+ case TAG_S32:
+ return tag_init_sw(result, a->data.sw ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_sw(result, a->data.sw ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_sw(result, a->data.sw ^ b->data.s8);
case TAG_U8:
- return tag_init_s8(dest, (s8) ((s16) a->data.s8 / (s16) b->data.u8));
+ return tag_init_sw(result, a->data.sw ^ b->data.u8);
case TAG_U16:
- return tag_init_s8(dest, (s8) ((s32) a->data.s8 / (s32) b->data.u16));
+ return tag_init_sw(result, a->data.sw ^ b->data.u16);
case TAG_U32:
- return tag_init_s8(dest, (s8) ((s64) a->data.s8 / (s64) b->data.u32));
+ return tag_init_sw(result, a->data.sw ^ b->data.u32);
case TAG_U64:
- if (b->data.u64 > S8_MAX)
- return tag_init_s8(dest, 0);
- else
- return tag_init_s8(dest, a->data.s8 / (s8) b->data.u64);
- default:
- goto ko;
- }
- case TAG_S16:
- switch (b->type) {
+ return tag_init_sw(result, a->data.sw ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_sw(result, a->data.sw ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.s16 / b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.s16 / b->data.f64);
- case TAG_INTEGER:
- integer_init_s32(&tmp, (s32) a->data.s16);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &b->data.integer, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s16(dest, a->data.s16 / (s16) b->data.s8);
- case TAG_S16:
- return tag_init_s16(dest, a->data.s16 / b->data.s16);
- case TAG_S32:
- return tag_init_s16(dest, ((s16) ((s32) a->data.s16 / b->data.s32)));
- case TAG_S64:
- return tag_init_s16(dest, ((s16) ((s64) a->data.s16 / b->data.s64)));
- case TAG_U8:
- return tag_init_s16(dest, a->data.s16 / (s16) b->data.u8);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_S64:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_s64(result, a->data.s64 ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s64(result, a->data.s64 ^ b->data.character);
+ case TAG_INTEGER:
+ integer_init_s64(&tmp, a->data.s64);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_s64(result, integer_to_s64(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_s64(result, a->data.s64 ^ b->data.sw);
+ case TAG_S64:
+ return tag_init_s64(result, a->data.s64 ^ b->data.s64);
+ case TAG_S32:
+ return tag_init_s64(result, a->data.s64 ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_s64(result, a->data.s64 ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_s64(result, a->data.s64 ^ b->data.s8);
+ case TAG_U8:
+ return tag_init_s64(result, a->data.s64 ^ b->data.u8);
case TAG_U16:
- return tag_init_s16(dest, (s16) ((s32) a->data.s16 / (s32) b->data.u16));
+ return tag_init_s64(result, a->data.s64 ^ b->data.u16);
case TAG_U32:
- return tag_init_s16(dest, (s16) ((s64) a->data.s16 / (s64) b->data.u32));
+ return tag_init_s64(result, a->data.s64 ^ b->data.u32);
case TAG_U64:
- if (b->data.u64 > S16_MAX)
- return tag_init_s16(dest, 0);
- else
- return tag_init_s16(dest, (s16) a->data.s16 / (s16) b->data.u64);
- default:
- goto ko;
- }
- case TAG_S32:
- switch (b->type) {
+ return tag_init_s64(result, a->data.s64 ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_s64(result, a->data.s64 ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.s32 / b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.s32 / b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_S32:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_s32(result, a->data.s32 ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s32(result, a->data.s32 ^ b->data.character);
case TAG_INTEGER:
integer_init_s32(&tmp, a->data.s32);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_s32(result, integer_to_s32(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s32(dest, a->data.s32 / (s32) b->data.s8);
- case TAG_S16:
- return tag_init_s32(dest, a->data.s32 / (s32) b->data.s16);
- case TAG_S32:
- return tag_init_s32(dest, a->data.s32 / b->data.s32);
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_s32(result, a->data.s32 ^ b->data.sw);
case TAG_S64:
- return tag_init_s32(dest, (s32) ((s64) a->data.s32 / b->data.s64));
+ return tag_init_s32(result, a->data.s32 ^ b->data.s64);
+ case TAG_S32:
+ return tag_init_s32(result, a->data.s32 ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_s32(result, a->data.s32 ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_s32(result, a->data.s32 ^ b->data.s8);
case TAG_U8:
- return tag_init_s32(dest, a->data.s32 / (s32) b->data.u8);
+ return tag_init_s32(result, a->data.s32 ^ b->data.u8);
case TAG_U16:
- return tag_init_s32(dest, a->data.s32 / (s32) b->data.u16);
+ return tag_init_s32(result, a->data.s32 ^ b->data.u16);
case TAG_U32:
- return tag_init_s32(dest, a->data.s32 / (s64) b->data.u32);
+ return tag_init_s32(result, a->data.s32 ^ b->data.u32);
case TAG_U64:
- if (b->data.u64 > S32_MAX)
- return tag_init_s32(dest, 0);
- else
- return tag_init_s32(dest, a->data.s32 / (s32) b->data.u64);
- default:
- goto ko;
- }
- case TAG_S64:
- switch (b->type) {
+ return tag_init_s32(result, a->data.s32 ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_s32(result, a->data.s32 ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.s64 / b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.s64 / b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_S16:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_s16(result, a->data.s16 ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s16(result, a->data.s16 ^ b->data.character);
case TAG_INTEGER:
- integer_init_s64(&tmp, a->data.s64);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_s16(&tmp, a->data.s16);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_s16(result, integer_to_s16(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s64(dest, a->data.s64 / (s64) b->data.s8);
- case TAG_S16:
- return tag_init_s64(dest, a->data.s64 / (s64) b->data.s16);
- case TAG_S32:
- return tag_init_s64(dest, a->data.s64 / (s64) b->data.s32);
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_s16(result, a->data.s16 ^ b->data.sw);
case TAG_S64:
- return tag_init_s64(dest, a->data.s64 / b->data.s64);
+ return tag_init_s16(result, a->data.s16 ^ b->data.s64);
+ case TAG_S32:
+ return tag_init_s16(result, a->data.s16 ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_s16(result, a->data.s16 ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_s16(result, a->data.s16 ^ b->data.s8);
case TAG_U8:
- return tag_init_s64(dest, a->data.s64 / (s64) b->data.u8);
+ return tag_init_s16(result, a->data.s16 ^ b->data.u8);
case TAG_U16:
- return tag_init_s64(dest, a->data.s64 / (s64) b->data.u16);
+ return tag_init_s16(result, a->data.s16 ^ b->data.u16);
case TAG_U32:
- return tag_init_s64(dest, a->data.s64 / (s64) b->data.u32);
+ return tag_init_s16(result, a->data.s16 ^ b->data.u32);
case TAG_U64:
- if (b->data.u64 > S64_MAX)
- return tag_init_s64(dest, 0);
- else
- return tag_init_s64(dest, a->data.s64 / (s64) b->data.u64);
- default:
- goto ko;
- }
- case TAG_U8:
- switch (b->type) {
+ return tag_init_s16(result, a->data.s16 ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_s16(result, a->data.s16 ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.u8 / b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.u8 / b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_S8:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_s8(result, a->data.s8 ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s8(result, a->data.s8 ^ b->data.character);
case TAG_INTEGER:
- integer_init_u32(&tmp, a->data.u8);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_s8(&tmp, a->data.s8);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_s8(result, integer_to_s8(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s16(dest, (s16) a->data.u8 / (s16) b->data.s8);
- case TAG_S16:
- return tag_init_s16(dest, (s16) a->data.u8 / b->data.s16);
- case TAG_S32:
- return tag_init_s16(dest, (s16) ((s32) a->data.u8 / b->data.s32));
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_s8(result, a->data.s8 ^ b->data.sw);
case TAG_S64:
- return tag_init_s16(dest, (s16) ((s64) a->data.u8 / b->data.s64));
+ return tag_init_s8(result, a->data.s8 ^ b->data.s64);
+ case TAG_S32:
+ return tag_init_s8(result, a->data.s8 ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_s8(result, a->data.s8 ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_s8(result, a->data.s8 ^ b->data.s8);
case TAG_U8:
- return tag_init_u8(dest, a->data.u8 / b->data.u8);
+ return tag_init_s8(result, a->data.s8 ^ b->data.u8);
case TAG_U16:
- return tag_init_u16(dest, (u8) ((u16) a->data.u8 / b->data.u16));
+ return tag_init_s8(result, a->data.s8 ^ b->data.u16);
case TAG_U32:
- return tag_init_u32(dest, (u8) ((u32) a->data.u8 / b->data.u32));
+ return tag_init_s8(result, a->data.s8 ^ b->data.u32);
case TAG_U64:
- return tag_init_u64(dest, (u8) ((u64) a->data.u8 / b->data.u64));
- default:
- goto ko;
- }
- case TAG_U16:
- switch (b->type) {
+ return tag_init_s8(result, a->data.s8 ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_s8(result, a->data.s8 ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.u16 / b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.u16 / b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_U8:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_u8(result, a->data.u8 ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u8(result, a->data.u8 ^ b->data.character);
case TAG_INTEGER:
- integer_init_u32(&tmp, (u32) a->data.u16);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_u8(&tmp, a->data.u8);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_u8(result, integer_to_u8(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s32(dest, (s32) a->data.u16 / (s32) b->data.s8);
- case TAG_S16:
- return tag_init_s32(dest, (s32) a->data.u16 / (s32) b->data.s16);
- case TAG_S32:
- return tag_init_s32(dest, (s32) a->data.u16 / b->data.s32);
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_u8(result, a->data.u8 ^ b->data.sw);
case TAG_S64:
- return tag_init_s32(dest, (s32) ((s64) a->data.u16 /
- b->data.s64));
+ return tag_init_u8(result, a->data.u8 ^ b->data.s64);
+ case TAG_S32:
+ return tag_init_u8(result, a->data.u8 ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_u8(result, a->data.u8 ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_u8(result, a->data.u8 ^ b->data.s8);
case TAG_U8:
- return tag_init_u16(dest, a->data.u16 / (u16) b->data.u8);
+ return tag_init_u8(result, a->data.u8 ^ b->data.u8);
case TAG_U16:
- return tag_init_u16(dest, a->data.u16 / b->data.u16);
+ return tag_init_u8(result, a->data.u8 ^ b->data.u16);
case TAG_U32:
- return tag_init_u16(dest, (u16) ((u32) a->data.u16 / b->data.u32));
+ return tag_init_u8(result, a->data.u8 ^ b->data.u32);
case TAG_U64:
- return tag_init_u16(dest, (u16) ((u64) a->data.u16 / b->data.u64));
- default:
- goto ko;
- }
- case TAG_U32:
- switch (b->type) {
- case TAG_F32:
- return tag_init_f32(dest, a->data.u32 / b->data.f32);
+ return tag_init_u8(result, a->data.u8 ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_u8(result, a->data.u8 ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
case TAG_F64:
- return tag_init_f64(dest, a->data.u32 / b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_U16:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_u16(result, a->data.u16 ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u16(result, a->data.u16 ^ b->data.character);
case TAG_INTEGER:
- integer_init_u32(&tmp, a->data.u32);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_u16(&tmp, a->data.u16);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_u16(result, integer_to_u16(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s64(dest, (s64) a->data.u32 / (s64) b->data.s8);
- case TAG_S16:
- return tag_init_s64(dest, (s64) a->data.u32 / (s64) b->data.s16);
- case TAG_S32:
- return tag_init_s64(dest, (s64) a->data.u32 / (s64) b->data.s32);
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_u16(result, a->data.u16 ^ b->data.sw);
case TAG_S64:
- return tag_init_s64(dest, (s64) a->data.u32 / b->data.s64);
+ return tag_init_u16(result, a->data.u16 ^ b->data.s64);
+ case TAG_S32:
+ return tag_init_u16(result, a->data.u16 ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_u16(result, a->data.u16 ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_u16(result, a->data.u16 ^ b->data.s8);
case TAG_U8:
- return tag_init_u32(dest, a->data.u32 / b->data.u8);
+ return tag_init_u16(result, a->data.u16 ^ b->data.u8);
case TAG_U16:
- return tag_init_u32(dest, a->data.u32 / b->data.u16);
+ return tag_init_u16(result, a->data.u16 ^ b->data.u16);
case TAG_U32:
- return tag_init_u32(dest, a->data.u32 / b->data.u32);
+ return tag_init_u16(result, a->data.u16 ^ b->data.u32);
case TAG_U64:
- return tag_init_u64(dest, a->data.u32 / b->data.u64);
- default:
- goto ko;
- }
- case TAG_U64:
+ return tag_init_u16(result, a->data.u16 ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_u16(result, a->data.u16 ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_U32:
switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_u32(result, a->data.u32 ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u32(result, a->data.u32 ^ b->data.character);
+ case TAG_INTEGER:
+ integer_init_u32(&tmp, a->data.u32);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_u32(result, integer_to_u32(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_u32(result, a->data.u32 ^ b->data.sw);
+ case TAG_S64:
+ return tag_init_u32(result, a->data.u32 ^ b->data.s64);
+ case TAG_S32:
+ return tag_init_u32(result, a->data.u32 ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_u32(result, a->data.u32 ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_u32(result, a->data.u32 ^ b->data.s8);
+ case TAG_U8:
+ return tag_init_u32(result, a->data.u32 ^ b->data.u8);
+ case TAG_U16:
+ return tag_init_u32(result, a->data.u32 ^ b->data.u16);
+ case TAG_U32:
+ return tag_init_u32(result, a->data.u32 ^ b->data.u32);
+ case TAG_U64:
+ return tag_init_u32(result, a->data.u32 ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_u32(result, a->data.u32 ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, a->data.u64 / b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, a->data.u64 / b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_U64:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_u64(result, a->data.u64 ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u64(result, a->data.u64 ^ b->data.character);
case TAG_INTEGER:
integer_init_u64(&tmp, a->data.u64);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_u64(result, integer_to_u64(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- if (a->data.u64 > S64_MAX) {
- integer_init_u64(&tmp, a->data.u64);
- integer_init_s32(&tmp2, (s32) b->data.s8);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- }
- else
- return tag_init_s64(dest, (s64) a->data.u64 / (s64) b->data.s8);
- case TAG_S16:
- if (a->data.u64 > S64_MAX) {
- integer_init_u64(&tmp, a->data.u64);
- integer_init_s32(&tmp2, (s32) b->data.s16);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- }
- else
- return tag_init_s64(dest, (s64) a->data.u64 /
- (s64) b->data.s16);
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_u64(result, a->data.u64 ^ b->data.sw);
+ case TAG_S64:
+ return tag_init_u64(result, a->data.u64 ^ b->data.s64);
case TAG_S32:
- if (a->data.u64 > S64_MAX) {
- integer_init_u64(&tmp, a->data.u64);
- integer_init_s32(&tmp2, b->data.s32);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- }
- else
- return tag_init_s64(dest, (s64) a->data.u64 /
- (s64) b->data.s32);
+ return tag_init_u64(result, a->data.u64 ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_u64(result, a->data.u64 ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_u64(result, a->data.u64 ^ b->data.s8);
+ case TAG_U8:
+ return tag_init_u64(result, a->data.u64 ^ b->data.u8);
+ case TAG_U16:
+ return tag_init_u64(result, a->data.u64 ^ b->data.u16);
+ case TAG_U32:
+ return tag_init_u64(result, a->data.u64 ^ b->data.u32);
+ case TAG_U64:
+ return tag_init_u64(result, a->data.u64 ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_u64(result, a->data.u64 ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_UW:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_uw(result, a->data.uw ^
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_uw(result, a->data.uw ^ b->data.character);
+ case TAG_INTEGER:
+ integer_init_uw(&tmp, a->data.uw);
+ integer_bxor(&tmp, &b->data.integer, &tmp2);
+ tag_init_uw(result, integer_to_uw(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_uw(result, a->data.uw ^ b->data.sw);
case TAG_S64:
- if (a->data.u64 > S64_MAX) {
- integer_init_u64(&tmp, a->data.u64);
- integer_init_s64(&tmp2, b->data.s64);
- dest->type = TAG_INTEGER;
- integer_div(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- }
- else
- return tag_init_s64(dest, (s64) a->data.u64 / b->data.s64);
+ return tag_init_uw(result, a->data.uw ^ b->data.s64);
+ case TAG_S32:
+ return tag_init_uw(result, a->data.uw ^ b->data.s32);
+ case TAG_S16:
+ return tag_init_uw(result, a->data.uw ^ b->data.s16);
+ case TAG_S8:
+ return tag_init_uw(result, a->data.uw ^ b->data.s8);
case TAG_U8:
- return tag_init_u64(dest, a->data.u64 / (u64) b->data.u8);
+ return tag_init_uw(result, a->data.uw ^ b->data.u8);
case TAG_U16:
- return tag_init_u64(dest, a->data.u64 / (u64) b->data.u16);
+ return tag_init_uw(result, a->data.uw ^ b->data.u16);
case TAG_U32:
- return tag_init_u64(dest, a->data.u64 / (u64) b->data.u32);
+ return tag_init_uw(result, a->data.uw ^ b->data.u32);
case TAG_U64:
- return tag_init_u64(dest, a->data.u64 / b->data.u64);
- default:
- goto ko;
+ return tag_init_uw(result, a->data.uw ^ b->data.u64);
+ case TAG_UW:
+ return tag_init_uw(result, a->data.uw ^ b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
}
- default:
- goto ko;
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
}
- ko:
- errx(1, "cannot divide %s by %s",
- tag_type_to_string(a->type),
- tag_type_to_string(b->type));
-}
-
-bool tag_eq (const s_tag *a, const s_tag *b)
-{
- return compare_tag(a, b) == 0;
+ error:
+ warnx("tag_bxor: invalid tag type: %s ^ %s",
+ tag_type_to_string(a->type),
+ tag_type_to_string(b->type));
+ return NULL;
}
-s_tag * tag_equal (const s_tag *a, const s_tag *b, s_tag *dest)
+s_tag * tag_cast_integer_to_s8 (s_tag *tag)
{
- assert(a);
- assert(b);
- assert(dest);
- if (! env_eval_equal_tag (&g_c3_env, a, b, dest))
- return NULL;
- return dest;
+ s8 i;
+ assert(tag);
+ assert(tag->type == TAG_INTEGER);
+ i = integer_to_s8(&tag->data.integer);
+ return tag_s8(tag, i);
}
-s_tag * tag_f32 (s_tag *tag, f32 x)
+s_tag * tag_cast_integer_to_s16 (s_tag *tag)
{
+ s16 i;
assert(tag);
- tag_clean(tag);
- return tag_init_f32(tag, x);
+ assert(tag->type == TAG_INTEGER);
+ i = integer_to_s16(&tag->data.integer);
+ return tag_s16(tag, i);
}
-s_tag * tag_f64 (s_tag *tag, f64 x)
+s_tag * tag_cast_integer_to_s32 (s_tag *tag)
{
+ s32 i;
assert(tag);
- tag_clean(tag);
- return tag_init_f64(tag, x);
+ assert(tag->type == TAG_INTEGER);
+ i = integer_to_s32(&tag->data.integer);
+ return tag_s32(tag, i);
}
-bool tag_gt (const s_tag *a, const s_tag *b)
+s_tag * tag_cast_integer_to_s64 (s_tag *tag)
{
- return compare_tag(a, b) > 0;
+ s64 i;
+ assert(tag);
+ assert(tag->type == TAG_INTEGER);
+ i = integer_to_s64(&tag->data.integer);
+ return tag_s64(tag, i);
}
-bool tag_gte (const s_tag *a, const s_tag *b)
+s_tag * tag_cast_integer_to_u8 (s_tag *tag)
{
- return compare_tag(a, b) >= 0;
+ u8 i;
+ assert(tag);
+ assert(tag->type == TAG_INTEGER);
+ i = integer_to_u8(&tag->data.integer);
+ return tag_u8(tag, i);
}
-u64 tag_hash_u64 (const s_tag *tag)
+s_tag * tag_cast_integer_to_u16 (s_tag *tag)
{
- t_hash hash;
+ u16 i;
assert(tag);
- hash_init(&hash);
- hash_update_tag(&hash, tag);
- return hash_to_u64(&hash);
+ assert(tag->type == TAG_INTEGER);
+ i = integer_to_u16(&tag->data.integer);
+ return tag_u16(tag, i);
}
-uw tag_hash_uw (const s_tag *tag)
+s_tag * tag_cast_integer_to_u32 (s_tag *tag)
{
- t_hash hash;
+ u32 i;
assert(tag);
- hash_init(&hash);
- hash_update_tag(&hash, tag);
- return hash_to_uw(&hash);
+ assert(tag->type == TAG_INTEGER);
+ i = integer_to_u32(&tag->data.integer);
+ return tag_u32(tag, i);
}
-s_tag * tag_ident (s_tag *tag, const s_ident *x)
+s_tag * tag_cast_integer_to_u64 (s_tag *tag)
{
+ u64 i;
assert(tag);
- tag_clean(tag);
- return tag_init_ident(tag, x);
+ assert(tag->type == TAG_INTEGER);
+ i = integer_to_u64(&tag->data.integer);
+ return tag_u64(tag, i);
}
-s_tag * tag_ident_1 (s_tag *tag, const s8 *p)
+s_tag * tag_character (s_tag *tag, character x)
{
assert(tag);
tag_clean(tag);
- return tag_init_ident_1(tag, p);
-}
-
-bool tag_ident_is_bound (const s_tag *tag)
-{
- return env_tag_ident_is_bound(&g_c3_env, tag, &g_c3_env.facts);
-}
-
-s_tag * tag_init (s_tag *tag)
-{
- bzero(tag, sizeof(s_tag));
- return tag;
+ return tag_init_character(tag, x);
}
-s_tag * tag_init_1 (s_tag *tag, const s8 *p)
+void tag_clean (s_tag *tag)
{
- s_buf buf;
assert(tag);
- tag_init_void(tag);
- if (! p)
- return tag;
- buf_init_1(&buf, p);
- if (buf_parse_tag(&buf, tag) != (sw) strlen(p)) {
- assert(! "invalid tag");
- errx(1, "invalid tag");
- buf_clean(&buf);
- return NULL;
+ switch (tag->type) {
+ case TAG_ARRAY: array_clean(&tag->data.array); break;
+ case TAG_CALL: call_clean(&tag->data.call); break;
+ case TAG_CFN: cfn_clean(&tag->data.cfn); break;
+ case TAG_FN: fn_clean(&tag->data.fn); break;
+ case TAG_INTEGER: integer_clean(&tag->data.integer); break;
+ case TAG_LIST: list_delete_all(tag->data.list); break;
+ case TAG_QUOTE: quote_clean(&tag->data.quote); break;
+ case TAG_STR: str_clean(&tag->data.str); break;
+ case TAG_TUPLE: tuple_clean(&tag->data.tuple); break;
+ case TAG_BOOL:
+ case TAG_CHARACTER:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_IDENT:
+ case TAG_PTAG:
+ case TAG_S8:
+ case TAG_S16:
+ case TAG_S32:
+ case TAG_S64:
+ case TAG_SW:
+ case TAG_SYM:
+ case TAG_U8:
+ case TAG_U16:
+ case TAG_U32:
+ case TAG_U64:
+ case TAG_UW:
+ case TAG_VAR:
+ case TAG_VOID:
+ break;
}
- buf_clean(&buf);
- return tag;
-}
-
-s_tag * tag_init_array (s_tag *tag, const s_array *a)
-{
- assert(tag);
- assert(a);
- tag->type = TAG_ARRAY;
- array_copy(a, &tag->data.array);
- return tag;
}
-s_tag * tag_init_bool (s_tag *tag, bool b)
+s_tag * tag_brackets (s_tag *tag, const s_tag *address,
+ s_tag *dest)
{
assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_BOOL;
- tag->data.bool = b;
- return tag;
+ assert(address);
+ assert(dest);
+ switch (tag->type) {
+ case TAG_ARRAY:
+ switch (address->type) {
+ case TAG_ARRAY:
+ return array_data_tag(tag, address, dest);
+ default:
+ break;
+ }
+ default:
+ break;
+ }
+ warnx("tag_brackets: invalid arguments");
+ return NULL;
}
-s_tag * tag_init_call (s_tag *tag, const s_call *call)
+s_tag * tag_copy (const s_tag *src, s_tag *dest)
{
- assert(tag);
- assert(call);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_CALL;
- tag->data.call = *call;
- return tag;
+ assert(src);
+ assert(dest);
+ switch (src->type) {
+ case TAG_VAR:
+ tag_init_var(dest);
+ break;
+ case TAG_VOID:
+ break;
+ case TAG_ARRAY:
+ array_copy(&src->data.array, &dest->data.array);
+ break;
+ case TAG_CALL:
+ call_copy(&src->data.call, &dest->data.call);
+ break;
+ case TAG_CFN:
+ cfn_copy(&src->data.cfn, &dest->data.cfn);
+ break;
+ case TAG_FN:
+ fn_copy(&src->data.fn, &dest->data.fn);
+ break;
+ case TAG_INTEGER:
+ integer_copy(&src->data.integer, &dest->data.integer);
+ break;
+ case TAG_LIST:
+ list_copy((const s_list **) &src->data.list, &dest->data.list);
+ break;
+ case TAG_QUOTE:
+ quote_copy(&src->data.quote, &dest->data.quote);
+ break;
+ case TAG_STR:
+ str_copy(&src->data.str, &dest->data.str);
+ break;
+ case TAG_TUPLE:
+ tuple_copy(&src->data.tuple, &dest->data.tuple);
+ break;
+ case TAG_BOOL:
+ case TAG_CHARACTER:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_IDENT:
+ case TAG_PTAG:
+ case TAG_S8:
+ case TAG_S16:
+ case TAG_S32:
+ case TAG_S64:
+ case TAG_SW:
+ case TAG_SYM:
+ case TAG_U8:
+ case TAG_U16:
+ case TAG_U32:
+ case TAG_U64:
+ case TAG_UW:
+ dest->data = src->data;
+ }
+ dest->type = src->type;
+ return dest;
}
-s_tag * tag_init_character (s_tag *tag, character c)
+void tag_delete (s_tag *tag)
{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_CHARACTER;
- tag->data.character = c;
- return tag;
+ tag_clean(tag);
+ free(tag);
}
-s_tag * tag_init_f32 (s_tag *tag, f32 x)
+s_tag * tag_div (const s_tag *a, const s_tag *b, s_tag *dest)
{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_F32;
- tag->data.f32 = x;
- return tag;
-}
-
+ s_integer tmp;
+ s_integer tmp2;
+ assert(a);
+ assert(b);
+ assert(dest);
+ switch (a->type) {
+ case TAG_F32:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, a->data.f32 / b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.f32 / b->data.f64);
+ case TAG_INTEGER:
+ integer_init_f32(&tmp, a->data.f32);
+ integer_div(&tmp, &b->data.integer, &tmp);
+ tag_init_integer(dest, &tmp);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_f32(dest, a->data.f32 / (f32) b->data.s8);
+ case TAG_S16:
+ return tag_init_f32(dest, a->data.f32 / (f32) b->data.s16);
+ case TAG_S32:
+ return tag_init_f32(dest, a->data.f32 / (f32) b->data.s32);
+ case TAG_S64:
+ return tag_init_f32(dest, a->data.f32 / (f32) b->data.s64);
+ case TAG_U8:
+ return tag_init_f32(dest, a->data.f32 / (f32) b->data.u8);
+ case TAG_U16:
+ return tag_init_f32(dest, a->data.f32 / (f32) b->data.u16);
+ case TAG_U32:
+ return tag_init_f32(dest, a->data.f32 / (f32) b->data.u32);
+ case TAG_U64:
+ return tag_init_f32(dest, a->data.f32 / (f32) b->data.u64);
+ default:
+ goto ko;
+ }
+ case TAG_F64:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f64(dest, a->data.f64 / (f64) b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, a->data.f64 / b->data.f64);
+ case TAG_INTEGER:
+ integer_init_f64(&tmp, a->data.f64);
+ integer_div(&tmp, &b->data.integer, &tmp);
+ tag_init_integer(dest, &tmp);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_f64(dest, a->data.f64 / (f64) b->data.s8);
+ case TAG_S16:
+ return tag_init_f64(dest, a->data.f64 / (f64) b->data.s16);
+ case TAG_S32:
+ return tag_init_f64(dest, a->data.f64 / (f64) b->data.s32);
+ case TAG_S64:
+ return tag_init_f64(dest, a->data.f64 / (f64) b->data.s64);
+ case TAG_U8:
+ return tag_init_f64(dest, a->data.f64 / (f64) b->data.u8);
+ case TAG_U16:
+ return tag_init_f64(dest, a->data.f64 / (f64) b->data.u16);
+ case TAG_U32:
+ return tag_init_f64(dest, a->data.f64 / (f64) b->data.u32);
+ case TAG_U64:
+ return tag_init_f64(dest, a->data.f64 / (f64) b->data.u64);
+ default:
+ goto ko;
+ }
+ case TAG_INTEGER:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) integer_to_f64(&a->data.integer) /
+ b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, integer_to_f64(&a->data.integer) /
+ b->data.f64);
+ case TAG_INTEGER:
+ dest->type = TAG_INTEGER;
+ integer_div(&a->data.integer, &b->data.integer,
+ &dest->data.integer);
+ return dest;
+ case TAG_S8:
+ integer_init_s32(&tmp, b->data.s8);
+ dest->type = TAG_INTEGER;
+ integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S16:
+ integer_init_s32(&tmp, b->data.s16);
+ dest->type = TAG_INTEGER;
+ integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S32:
+ integer_init_s32(&tmp, b->data.s32);
+ dest->type = TAG_INTEGER;
+ integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S64:
+ integer_init_s64(&tmp, b->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_U8:
+ integer_init_u32(&tmp, (u32) b->data.u8);
+ dest->type = TAG_INTEGER;
+ integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_U16:
+ integer_init_u32(&tmp, (u32) b->data.u16);
+ dest->type = TAG_INTEGER;
+ integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_U32:
+ integer_init_u32(&tmp, b->data.u32);
+ dest->type = TAG_INTEGER;
+ integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_U64:
+ integer_init_u64(&tmp, b->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_div(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ default:
+ goto ko;
+ }
+ case TAG_S8:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.s8 / b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.s8 / b->data.f64);
+ case TAG_INTEGER:
+ integer_init_s32(&tmp, (s32) a->data.s8);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s8(dest, a->data.s8 / b->data.s8);
+ case TAG_S16:
+ return tag_init_s8(dest, (s8) ((s16) a->data.s8 / b->data.s16));
+ case TAG_S32:
+ return tag_init_s8(dest, (s8) ((s32) a->data.s8 / b->data.s32));
+ case TAG_S64:
+ return tag_init_s8(dest, (s8) ((s64) a->data.s8 / b->data.s64));
+ case TAG_U8:
+ return tag_init_s8(dest, (s8) ((s16) a->data.s8 / (s16) b->data.u8));
+ case TAG_U16:
+ return tag_init_s8(dest, (s8) ((s32) a->data.s8 / (s32) b->data.u16));
+ case TAG_U32:
+ return tag_init_s8(dest, (s8) ((s64) a->data.s8 / (s64) b->data.u32));
+ case TAG_U64:
+ if (b->data.u64 > S8_MAX)
+ return tag_init_s8(dest, 0);
+ else
+ return tag_init_s8(dest, a->data.s8 / (s8) b->data.u64);
+ default:
+ goto ko;
+ }
+ case TAG_S16:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.s16 / b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.s16 / b->data.f64);
+ case TAG_INTEGER:
+ integer_init_s32(&tmp, (s32) a->data.s16);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s16(dest, a->data.s16 / (s16) b->data.s8);
+ case TAG_S16:
+ return tag_init_s16(dest, a->data.s16 / b->data.s16);
+ case TAG_S32:
+ return tag_init_s16(dest, ((s16) ((s32) a->data.s16 / b->data.s32)));
+ case TAG_S64:
+ return tag_init_s16(dest, ((s16) ((s64) a->data.s16 / b->data.s64)));
+ case TAG_U8:
+ return tag_init_s16(dest, a->data.s16 / (s16) b->data.u8);
+ case TAG_U16:
+ return tag_init_s16(dest, (s16) ((s32) a->data.s16 / (s32) b->data.u16));
+ case TAG_U32:
+ return tag_init_s16(dest, (s16) ((s64) a->data.s16 / (s64) b->data.u32));
+ case TAG_U64:
+ if (b->data.u64 > S16_MAX)
+ return tag_init_s16(dest, 0);
+ else
+ return tag_init_s16(dest, (s16) a->data.s16 / (s16) b->data.u64);
+ default:
+ goto ko;
+ }
+ case TAG_S32:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.s32 / b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.s32 / b->data.f64);
+ case TAG_INTEGER:
+ integer_init_s32(&tmp, a->data.s32);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s32(dest, a->data.s32 / (s32) b->data.s8);
+ case TAG_S16:
+ return tag_init_s32(dest, a->data.s32 / (s32) b->data.s16);
+ case TAG_S32:
+ return tag_init_s32(dest, a->data.s32 / b->data.s32);
+ case TAG_S64:
+ return tag_init_s32(dest, (s32) ((s64) a->data.s32 / b->data.s64));
+ case TAG_U8:
+ return tag_init_s32(dest, a->data.s32 / (s32) b->data.u8);
+ case TAG_U16:
+ return tag_init_s32(dest, a->data.s32 / (s32) b->data.u16);
+ case TAG_U32:
+ return tag_init_s32(dest, a->data.s32 / (s64) b->data.u32);
+ case TAG_U64:
+ if (b->data.u64 > S32_MAX)
+ return tag_init_s32(dest, 0);
+ else
+ return tag_init_s32(dest, a->data.s32 / (s32) b->data.u64);
+ default:
+ goto ko;
+ }
+ case TAG_S64:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.s64 / b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.s64 / b->data.f64);
+ case TAG_INTEGER:
+ integer_init_s64(&tmp, a->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s64(dest, a->data.s64 / (s64) b->data.s8);
+ case TAG_S16:
+ return tag_init_s64(dest, a->data.s64 / (s64) b->data.s16);
+ case TAG_S32:
+ return tag_init_s64(dest, a->data.s64 / (s64) b->data.s32);
+ case TAG_S64:
+ return tag_init_s64(dest, a->data.s64 / b->data.s64);
+ case TAG_U8:
+ return tag_init_s64(dest, a->data.s64 / (s64) b->data.u8);
+ case TAG_U16:
+ return tag_init_s64(dest, a->data.s64 / (s64) b->data.u16);
+ case TAG_U32:
+ return tag_init_s64(dest, a->data.s64 / (s64) b->data.u32);
+ case TAG_U64:
+ if (b->data.u64 > S64_MAX)
+ return tag_init_s64(dest, 0);
+ else
+ return tag_init_s64(dest, a->data.s64 / (s64) b->data.u64);
+ default:
+ goto ko;
+ }
+ case TAG_U8:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.u8 / b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.u8 / b->data.f64);
+ case TAG_INTEGER:
+ integer_init_u32(&tmp, a->data.u8);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s16(dest, (s16) a->data.u8 / (s16) b->data.s8);
+ case TAG_S16:
+ return tag_init_s16(dest, (s16) a->data.u8 / b->data.s16);
+ case TAG_S32:
+ return tag_init_s16(dest, (s16) ((s32) a->data.u8 / b->data.s32));
+ case TAG_S64:
+ return tag_init_s16(dest, (s16) ((s64) a->data.u8 / b->data.s64));
+ case TAG_U8:
+ return tag_init_u8(dest, a->data.u8 / b->data.u8);
+ case TAG_U16:
+ return tag_init_u16(dest, (u8) ((u16) a->data.u8 / b->data.u16));
+ case TAG_U32:
+ return tag_init_u32(dest, (u8) ((u32) a->data.u8 / b->data.u32));
+ case TAG_U64:
+ return tag_init_u64(dest, (u8) ((u64) a->data.u8 / b->data.u64));
+ default:
+ goto ko;
+ }
+ case TAG_U16:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.u16 / b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.u16 / b->data.f64);
+ case TAG_INTEGER:
+ integer_init_u32(&tmp, (u32) a->data.u16);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s32(dest, (s32) a->data.u16 / (s32) b->data.s8);
+ case TAG_S16:
+ return tag_init_s32(dest, (s32) a->data.u16 / (s32) b->data.s16);
+ case TAG_S32:
+ return tag_init_s32(dest, (s32) a->data.u16 / b->data.s32);
+ case TAG_S64:
+ return tag_init_s32(dest, (s32) ((s64) a->data.u16 /
+ b->data.s64));
+ case TAG_U8:
+ return tag_init_u16(dest, a->data.u16 / (u16) b->data.u8);
+ case TAG_U16:
+ return tag_init_u16(dest, a->data.u16 / b->data.u16);
+ case TAG_U32:
+ return tag_init_u16(dest, (u16) ((u32) a->data.u16 / b->data.u32));
+ case TAG_U64:
+ return tag_init_u16(dest, (u16) ((u64) a->data.u16 / b->data.u64));
+ default:
+ goto ko;
+ }
+ case TAG_U32:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, a->data.u32 / b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, a->data.u32 / b->data.f64);
+ case TAG_INTEGER:
+ integer_init_u32(&tmp, a->data.u32);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s64(dest, (s64) a->data.u32 / (s64) b->data.s8);
+ case TAG_S16:
+ return tag_init_s64(dest, (s64) a->data.u32 / (s64) b->data.s16);
+ case TAG_S32:
+ return tag_init_s64(dest, (s64) a->data.u32 / (s64) b->data.s32);
+ case TAG_S64:
+ return tag_init_s64(dest, (s64) a->data.u32 / b->data.s64);
+ case TAG_U8:
+ return tag_init_u32(dest, a->data.u32 / b->data.u8);
+ case TAG_U16:
+ return tag_init_u32(dest, a->data.u32 / b->data.u16);
+ case TAG_U32:
+ return tag_init_u32(dest, a->data.u32 / b->data.u32);
+ case TAG_U64:
+ return tag_init_u64(dest, a->data.u32 / b->data.u64);
+ default:
+ goto ko;
+ }
+ case TAG_U64:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, a->data.u64 / b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, a->data.u64 / b->data.f64);
+ case TAG_INTEGER:
+ integer_init_u64(&tmp, a->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ if (a->data.u64 > S64_MAX) {
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s32(&tmp2, (s32) b->data.s8);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ }
+ else
+ return tag_init_s64(dest, (s64) a->data.u64 / (s64) b->data.s8);
+ case TAG_S16:
+ if (a->data.u64 > S64_MAX) {
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s32(&tmp2, (s32) b->data.s16);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ }
+ else
+ return tag_init_s64(dest, (s64) a->data.u64 /
+ (s64) b->data.s16);
+ case TAG_S32:
+ if (a->data.u64 > S64_MAX) {
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s32(&tmp2, b->data.s32);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ }
+ else
+ return tag_init_s64(dest, (s64) a->data.u64 /
+ (s64) b->data.s32);
+ case TAG_S64:
+ if (a->data.u64 > S64_MAX) {
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s64(&tmp2, b->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_div(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ }
+ else
+ return tag_init_s64(dest, (s64) a->data.u64 / b->data.s64);
+ case TAG_U8:
+ return tag_init_u64(dest, a->data.u64 / (u64) b->data.u8);
+ case TAG_U16:
+ return tag_init_u64(dest, a->data.u64 / (u64) b->data.u16);
+ case TAG_U32:
+ return tag_init_u64(dest, a->data.u64 / (u64) b->data.u32);
+ case TAG_U64:
+ return tag_init_u64(dest, a->data.u64 / b->data.u64);
+ default:
+ goto ko;
+ }
+ default:
+ goto ko;
+ }
+ ko:
+ assert(! "tag_div: invalid tag type");
+ warnx("tag_div: invalid tag type: %s / %s",
+ tag_type_to_string(a->type),
+ tag_type_to_string(b->type));
+ return NULL;
+}
+
+bool tag_eq (const s_tag *a, const s_tag *b)
+{
+ return compare_tag(a, b) == 0;
+}
+
+s_tag * tag_equal (const s_tag *a, const s_tag *b, s_tag *dest)
+{
+ assert(a);
+ assert(b);
+ assert(dest);
+ if (! env_eval_equal_tag (&g_c3_env, a, b, dest))
+ return NULL;
+ return dest;
+}
+
+s_tag * tag_f32 (s_tag *tag, f32 x)
+{
+ assert(tag);
+ tag_clean(tag);
+ return tag_init_f32(tag, x);
+}
+
+s_tag * tag_f64 (s_tag *tag, f64 x)
+{
+ assert(tag);
+ tag_clean(tag);
+ return tag_init_f64(tag, x);
+}
+
+bool tag_gt (const s_tag *a, const s_tag *b)
+{
+ return compare_tag(a, b) > 0;
+}
+
+bool tag_gte (const s_tag *a, const s_tag *b)
+{
+ return compare_tag(a, b) >= 0;
+}
+
+u64 tag_hash_u64 (const s_tag *tag)
+{
+ t_hash hash;
+ assert(tag);
+ hash_init(&hash);
+ hash_update_tag(&hash, tag);
+ return hash_to_u64(&hash);
+}
+
+uw tag_hash_uw (const s_tag *tag)
+{
+ t_hash hash;
+ assert(tag);
+ hash_init(&hash);
+ hash_update_tag(&hash, tag);
+ return hash_to_uw(&hash);
+}
+
+s_tag * tag_ident (s_tag *tag, const s_ident *x)
+{
+ assert(tag);
+ tag_clean(tag);
+ return tag_init_ident(tag, x);
+}
+
+s_tag * tag_ident_1 (s_tag *tag, const s8 *p)
+{
+ assert(tag);
+ tag_clean(tag);
+ return tag_init_ident_1(tag, p);
+}
+
+bool tag_ident_is_bound (const s_tag *tag)
+{
+ return env_tag_ident_is_bound(&g_c3_env, tag, &g_c3_env.facts);
+}
+
+s_tag * tag_init (s_tag *tag)
+{
+ bzero(tag, sizeof(s_tag));
+ return tag;
+}
+
+s_tag * tag_init_1 (s_tag *tag, const s8 *p)
+{
+ s_buf buf;
+ assert(tag);
+ tag_init_void(tag);
+ if (! p)
+ return tag;
+ buf_init_1(&buf, p);
+ if (buf_parse_tag(&buf, tag) != (sw) strlen(p)) {
+ assert(! "invalid tag");
+ errx(1, "invalid tag");
+ buf_clean(&buf);
+ return NULL;
+ }
+ buf_clean(&buf);
+ return tag;
+}
+
+s_tag * tag_init_array (s_tag *tag, const s_array *a)
+{
+ assert(tag);
+ assert(a);
+ tag->type = TAG_ARRAY;
+ array_copy(a, &tag->data.array);
+ return tag;
+}
+
+s_tag * tag_init_bool (s_tag *tag, bool b)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_BOOL;
+ tag->data.bool = b;
+ return tag;
+}
+
+s_tag * tag_init_call (s_tag *tag, const s_call *call)
+{
+ assert(tag);
+ assert(call);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_CALL;
+ tag->data.call = *call;
+ return tag;
+}
+
+s_tag * tag_init_character (s_tag *tag, character c)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_CHARACTER;
+ tag->data.character = c;
+ return tag;
+}
+
+s_tag * tag_init_f32 (s_tag *tag, f32 x)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_F32;
+ tag->data.f32 = x;
+ return tag;
+}
+
s_tag * tag_init_f64 (s_tag *tag, f64 x)
{
assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_F64;
- tag->data.f64 = x;
- return tag;
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_F64;
+ tag->data.f64 = x;
+ return tag;
+}
+
+s_tag * tag_init_ident (s_tag *tag, const s_ident *x)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_IDENT;
+ tag->data.ident = *x;
+ return tag;
+}
+
+s_tag * tag_init_ident_1 (s_tag *tag, const s8 *p)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_IDENT;
+ ident_init_1(&tag->data.ident, p);
+ return tag;
+}
+
+s_tag * tag_init_integer (s_tag *tag, const s_integer *i)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_INTEGER;
+ integer_init(&tag->data.integer);
+ integer_copy(i, &tag->data.integer);
+ return tag;
+}
+
+s_tag * tag_init_integer_1 (s_tag *tag, const s8 *p)
+{
+ s_buf buf;
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_INTEGER;
+ buf_init_1(&buf, p);
+ if (buf_parse_integer(&buf, &tag->data.integer) != (sw) strlen(p)) {
+ assert(! "tag_init_integer_1: invalid integer");
+ errx(1, "tag_init_integer_1: invalid integer");
+ buf_clean(&buf);
+ return NULL;
+ }
+ buf_clean(&buf);
+ return tag;
+}
+
+s_tag * tag_init_integer_s64 (s_tag *tag, s64 s)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_INTEGER;
+ integer_init_s64(&tag->data.integer, s);
+ return tag;
+}
+
+s_tag * tag_init_integer_u64 (s_tag *tag, u64 u)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_INTEGER;
+ integer_init_u64(&tag->data.integer, u);
+ return tag;
+}
+
+s_tag * tag_init_integer_zero (s_tag *tag)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_INTEGER;
+ integer_init_zero(&tag->data.integer);
+ return tag;
+}
+
+s_tag * tag_init_list (s_tag *tag, s_list *list)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_LIST;
+ tag->data.list = list;
+ return tag;
+}
+
+s_tag * tag_init_list_1 (s_tag *tag, const s8 *p)
+{
+ s_buf buf;
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_LIST;
+ buf_init_1(&buf, p);
+ if (buf_parse_list(&buf, &tag->data.list) != (sw) strlen(p)) {
+ assert(! "tag_init_list_1: invalid list");
+ errx(1, "tag_init_list_1: invalid list");
+ buf_clean(&buf);
+ return NULL;
+ }
+ buf_clean(&buf);
+ return tag;
+}
+
+s_tag * tag_init_s8 (s_tag *tag, s8 i)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_S8;
+ tag->data.s8 = i;
+ return tag;
+}
+
+s_tag * tag_init_s16 (s_tag *tag, s16 i)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_S16;
+ tag->data.s16 = i;
+ return tag;
+}
+
+s_tag * tag_init_s32 (s_tag *tag, s32 i)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_S32;
+ tag->data.s32 = i;
+ return tag;
+}
+
+s_tag * tag_init_s64 (s_tag *tag, s64 i)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_S64;
+ tag->data.s64 = i;
+ return tag;
+}
+
+s_tag * tag_init_sw (s_tag *tag, sw i)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_SW;
+ tag->data.sw = i;
+ return tag;
+}
+
+s_tag * tag_init_str (s_tag *tag, s8 *free, uw size, const s8 *p)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_STR;
+ str_init(&tag->data.str, free, size, p);
+ return tag;
+}
+
+s_tag * tag_init_str_1 (s_tag *tag, s8 *free, const s8 *p)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_STR;
+ str_init_1(&tag->data.str, free, p);
+ return tag;
+}
+
+s_tag * tag_init_sym (s_tag *tag, const s_sym *p)
+{
+ assert(tag);
+ assert(p);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_SYM;
+ tag->data.sym = p;
+ return tag;
+}
+
+s_tag * tag_init_sym_1 (s_tag *tag, const s8 *p)
+{
+ s_buf buf;
+ assert(tag);
+ assert(p);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_SYM;
+ buf_init_1(&buf, p);
+ if (buf_parse_sym(&buf, &tag->data.sym) != (sw) strlen(p)) {
+ assert(! "tag_init_sym_1: invalid symbol");
+ errx(1, "tag_init_sym_1: invalid symbol");
+ buf_clean(&buf);
+ return NULL;
+ }
+ buf_clean(&buf);
+ return tag;
+}
+
+s_tag * tag_init_time (s_tag *tag)
+{
+ struct timespec time;
+ clock_gettime(CLOCK_REALTIME, &time);
+ return timespec_to_tag(&time, tag);
+}
+
+s_tag * tag_init_tuple (s_tag *tag, uw count)
+{
+ assert(tag);
+ assert(count);
+ tag->type = TAG_TUPLE;
+ tuple_init(&tag->data.tuple, count);
+ return tag;
+}
+
+s_tag * tag_init_u8 (s_tag *tag, u8 i)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_U8;
+ tag->data.u8 = i;
+ return tag;
+}
+
+s_tag * tag_init_u16 (s_tag *tag, u16 i)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_U16;
+ tag->data.u16 = i;
+ return tag;
+}
+
+s_tag * tag_init_u32 (s_tag *tag, u32 i)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_U32;
+ tag->data.u32 = i;
+ return tag;
+}
+
+s_tag * tag_init_u64 (s_tag *tag, u64 i)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_U64;
+ tag->data.u64 = i;
+ return tag;
+}
+
+s_tag * tag_init_uw (s_tag *tag, uw i)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_UW;
+ tag->data.uw = i;
+ return tag;
+}
+
+s_tag * tag_init_var (s_tag *tag)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_VAR;
+ return tag;
+}
+
+s_tag * tag_init_void (s_tag *tag)
+{
+ assert(tag);
+ bzero(tag, sizeof(s_tag));
+ tag->type = TAG_VOID;
+ return tag;
+}
+
+s_str * tag_inspect (const s_tag *tag, s_str *dest)
+{
+ s_buf buf;
+ sw size;
+ if ((size = buf_inspect_tag_size(tag)) < 0) {
+ assert(! "tag_inspect: size error");
+ errx(1, "tag_inspect: size error");
+ return NULL;
+ }
+ buf_init_alloc(&buf, size);
+ if (buf_inspect_tag(&buf, tag) != size) {
+ assert(! "tag_inspect: inspect error");
+ errx(1, "tag_inspect: inspect error");
+ return NULL;
+ }
+ return buf_to_str(&buf, dest);
+}
+
+s_tag * tag_integer (s_tag *tag, const s_integer *x)
+{
+ assert(tag);
+ tag_clean(tag);
+ return tag_init_integer(tag, x);
+}
+
+s_tag * tag_integer_1 (s_tag *tag, const s8 *p)
+{
+ assert(tag);
+ tag_clean(tag);
+ return tag_init_integer_1(tag, p);
+}
+
+s_tag * tag_integer_reduce (s_tag *tag)
+{
+ uw bytes;
+ e_bool negative;
+ assert(tag);
+ switch (tag->type) {
+ case TAG_INTEGER:
+ bytes = integer_bytes(&tag->data.integer);
+ if (bytes > 8)
+ break;
+ negative = integer_is_negative(&tag->data.integer);
+ if (bytes > 4) {
+ if (negative)
+ return tag_cast_integer_to_s64(tag);
+ return tag_cast_integer_to_u64(tag);
+ }
+ if (bytes > 2) {
+ if (negative)
+ return tag_cast_integer_to_s32(tag);
+ return tag_cast_integer_to_u32(tag);
+ }
+ if (bytes > 1) {
+ if (negative)
+ return tag_cast_integer_to_s16(tag);
+ return tag_cast_integer_to_u16(tag);
+ }
+ if (negative)
+ return tag_cast_integer_to_s8(tag);
+ return tag_cast_integer_to_u8(tag);
+ default: ;
+ }
+ return tag;
+}
+
+bool tag_is_bound_var (const s_tag *tag)
+{
+ return (tag &&
+ tag->type != TAG_VAR);
+}
+
+bool tag_is_number (const s_tag *tag)
+{
+ assert(tag);
+ switch (tag->type) {
+ case TAG_INTEGER:
+ case TAG_S8:
+ case TAG_S16:
+ case TAG_S32:
+ case TAG_S64:
+ case TAG_U8:
+ case TAG_U16:
+ case TAG_U32:
+ case TAG_U64:
+ return true;
+ default: ;
+ }
+ return false;
+}
+
+bool tag_is_unbound_var (const s_tag *tag)
+{
+ return (tag &&
+ tag->type == TAG_VAR);
+}
+
+s_tag * tag_list (s_tag *tag, s_list *x)
+{
+ assert(tag);
+ tag_clean(tag);
+ return tag_init_list(tag, x);
}
-s_tag * tag_init_ident (s_tag *tag, const s_ident *x)
+s_tag * tag_list_1 (s_tag *tag, const s8 *p)
{
assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_IDENT;
- tag->data.ident = *x;
- return tag;
+ tag_clean(tag);
+ return tag_init_list_1(tag, p);
}
-s_tag * tag_init_ident_1 (s_tag *tag, const s8 *p)
+bool tag_lt (const s_tag *a, const s_tag *b)
{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_IDENT;
- ident_init_1(&tag->data.ident, p);
- return tag;
+ return compare_tag(a, b) < 0;
}
-s_tag * tag_init_integer (s_tag *tag, const s_integer *i)
+bool tag_lte (const s_tag *a, const s_tag *b)
{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_INTEGER;
- integer_init(&tag->data.integer);
- integer_copy(i, &tag->data.integer);
- return tag;
+ return compare_tag(a, b) <= 0;
+}
+
+s_tag * tag_mod (const s_tag *a, const s_tag *b, s_tag *dest)
+{
+ s_integer tmp;
+ s_integer tmp2;
+ assert(a);
+ assert(b);
+ assert(dest);
+ switch (a->type) {
+ case TAG_F32:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, fmodf(a->data.f32, b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod((f64) a->data.f32, b->data.f64));
+ case TAG_INTEGER:
+ return tag_init_f64(dest, fmod((f64) a->data.f32,
+ integer_to_f64(&b->data.integer)));
+ case TAG_S8:
+ return tag_init_f32(dest, fmodf(a->data.f32, (f32) b->data.s8));
+ case TAG_S16:
+ return tag_init_f32(dest, fmodf(a->data.f32, (f32) b->data.s16));
+ case TAG_S32:
+ return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.s32));
+ case TAG_S64:
+ return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.s64));
+ case TAG_SW:
+ return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.sw));
+ case TAG_U8:
+ return tag_init_f32(dest, fmodf(a->data.f32, (f32) b->data.u8));
+ case TAG_U16:
+ return tag_init_f32(dest, fmodf(a->data.f32, (f32) b->data.u16));
+ case TAG_U32:
+ return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.u32));
+ case TAG_U64:
+ return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.u64));
+ case TAG_UW:
+ return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.uw));
+ default:
+ goto ko;
+ }
+ case TAG_F64:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod(a->data.f64, b->data.f64));
+ case TAG_INTEGER:
+ return tag_init_f64(dest, fmod(a->data.f64,
+ integer_to_f64(&b->data.integer)));
+ case TAG_S8:
+ return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.s8));
+ case TAG_S16:
+ return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.s16));
+ case TAG_S32:
+ return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.s32));
+ case TAG_S64:
+ return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.s64));
+ case TAG_SW:
+ return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.sw));
+ case TAG_U8:
+ return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.u8));
+ case TAG_U16:
+ return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.u16));
+ case TAG_U32:
+ return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.u32));
+ case TAG_U64:
+ return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.u64));
+ case TAG_UW:
+ return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.uw));
+ default:
+ goto ko;
+ }
+ case TAG_INTEGER:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f64(dest, fmod(integer_to_f64(&a->data.integer),
+ (f64) b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod(integer_to_f64(&a->data.integer),
+ b->data.f64));
+ case TAG_INTEGER:
+ dest->type = TAG_INTEGER;
+ integer_mod(&a->data.integer, &b->data.integer,
+ &dest->data.integer);
+ return dest;
+ case TAG_S8:
+ integer_init_s8(&tmp, b->data.s8);
+ integer_mod(&a->data.integer, &tmp, &tmp2);
+ tag_init_u8(dest, integer_to_u8(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_S16:
+ integer_init_s16(&tmp, b->data.s16);
+ integer_mod(&a->data.integer, &tmp, &tmp2);
+ tag_init_u16(dest, integer_to_u16(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_S32:
+ integer_init_s32(&tmp, b->data.s32);
+ integer_mod(&a->data.integer, &tmp, &tmp2);
+ tag_init_u32(dest, integer_to_u32(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_S64:
+ integer_init_s64(&tmp, b->data.s64);
+ integer_mod(&a->data.integer, &tmp, &tmp2);
+ tag_init_u64(dest, integer_to_u64(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_SW:
+ integer_init_sw(&tmp, b->data.sw);
+ integer_mod(&a->data.integer, &tmp, &tmp2);
+ tag_init_uw(dest, integer_to_uw(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U8:
+ integer_init_u8(&tmp, b->data.u8);
+ integer_mod(&a->data.integer, &tmp, &tmp2);
+ tag_init_u8(dest, integer_to_u8(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U16:
+ integer_init_u16(&tmp, b->data.u16);
+ integer_mod(&a->data.integer, &tmp, &tmp2);
+ tag_init_u16(dest, integer_to_u16(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U32:
+ integer_init_u32(&tmp, b->data.u32);
+ integer_mod(&a->data.integer, &tmp, &tmp2);
+ tag_init_u32(dest, integer_to_u32(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U64:
+ integer_init_u64(&tmp, b->data.u64);
+ integer_mod(&a->data.integer, &tmp, &tmp2);
+ tag_init_u64(dest, integer_to_u64(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_UW:
+ integer_init_uw(&tmp, b->data.uw);
+ integer_mod(&a->data.integer, &tmp, &tmp2);
+ tag_init_uw(dest, integer_to_uw(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ default:
+ goto ko;
+ }
+ case TAG_S8:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, fmodf((f32) a->data.s8, b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod((f64) a->data.s8, b->data.f64));
+ case TAG_INTEGER:
+ integer_init_s8(&tmp, a->data.s8);
+ dest->type = TAG_INTEGER;
+ integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_u8(dest, a->data.s8 % b->data.s8);
+ case TAG_S16:
+ return tag_init_u8(dest, a->data.s8 % b->data.s16);
+ case TAG_S32:
+ return tag_init_u8(dest, a->data.s8 % b->data.s32);
+ case TAG_S64:
+ return tag_init_u8(dest, a->data.s8 % b->data.s64);
+ case TAG_SW:
+ return tag_init_u8(dest, a->data.s8 % b->data.sw);
+ case TAG_U8:
+ return tag_init_u8(dest, a->data.s8 % b->data.u8);
+ case TAG_U16:
+ return tag_init_u8(dest, a->data.s8 % b->data.u16);
+ case TAG_U32:
+ return tag_init_u8(dest, a->data.s8 % b->data.u32);
+ case TAG_U64:
+ return tag_init_u8(dest, a->data.s8 % b->data.u64);
+ case TAG_UW:
+ return tag_init_u8(dest, a->data.s8 % b->data.uw);
+ default:
+ goto ko;
+ }
+ case TAG_S16:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, fmodf((f32) a->data.s16, b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod((f64) a->data.s16, b->data.f64));
+ case TAG_INTEGER:
+ integer_init_s16(&tmp, a->data.s16);
+ dest->type = TAG_INTEGER;
+ integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_u8(dest, a->data.s16 % b->data.s8);
+ case TAG_S16:
+ return tag_init_u16(dest, a->data.s16 % b->data.s16);
+ case TAG_S32:
+ return tag_init_u16(dest, a->data.s16 % b->data.s32);
+ case TAG_S64:
+ return tag_init_u16(dest, a->data.s16 % b->data.s64);
+ case TAG_SW:
+ return tag_init_u16(dest, a->data.s16 % b->data.sw);
+ case TAG_U8:
+ return tag_init_u8(dest, a->data.s16 % b->data.u8);
+ case TAG_U16:
+ return tag_init_u16(dest, a->data.s16 % b->data.u16);
+ case TAG_U32:
+ return tag_init_u16(dest, a->data.s16 % b->data.u32);
+ case TAG_U64:
+ return tag_init_u16(dest, a->data.s16 % b->data.u64);
+ case TAG_UW:
+ return tag_init_u16(dest, a->data.s16 % b->data.uw);
+ default:
+ goto ko;
+ }
+ case TAG_S32:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f64(dest, fmod((f64) a->data.s32, b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod((f64) a->data.s32, b->data.f64));
+ case TAG_INTEGER:
+ integer_init_s32(&tmp, a->data.s32);
+ dest->type = TAG_INTEGER;
+ integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_u8(dest, a->data.s32 % b->data.s8);
+ case TAG_S16:
+ return tag_init_u16(dest, a->data.s32 % b->data.s16);
+ case TAG_S32:
+ return tag_init_u32(dest, a->data.s32 % b->data.s32);
+ case TAG_S64:
+ return tag_init_u32(dest, a->data.s32 % b->data.s64);
+ case TAG_SW:
+ return tag_init_u32(dest, a->data.s32 % b->data.sw);
+ case TAG_U8:
+ return tag_init_u8(dest, a->data.s32 % b->data.u8);
+ case TAG_U16:
+ return tag_init_u16(dest, a->data.s32 % b->data.u16);
+ case TAG_U32:
+ return tag_init_u32(dest, a->data.s32 % b->data.u32);
+ case TAG_U64:
+ return tag_init_u32(dest, a->data.s32 % b->data.u64);
+ case TAG_UW:
+ return tag_init_u32(dest, a->data.s32 % b->data.uw);
+ default:
+ goto ko;
+ }
+ case TAG_S64:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f64(dest, fmod((f64) a->data.s64, b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod((f64) a->data.s64, b->data.f64));
+ case TAG_INTEGER:
+ integer_init_s64(&tmp, a->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_u8(dest, a->data.s64 % b->data.s8);
+ case TAG_S16:
+ return tag_init_u16(dest, a->data.s64 % b->data.s16);
+ case TAG_S32:
+ return tag_init_u32(dest, a->data.s64 % b->data.s32);
+ case TAG_S64:
+ return tag_init_u64(dest, a->data.s64 % b->data.s64);
+ case TAG_SW:
+ return tag_init_uw(dest, a->data.s64 % b->data.sw);
+ case TAG_U8:
+ return tag_init_u8(dest, a->data.s64 % b->data.u8);
+ case TAG_U16:
+ return tag_init_u16(dest, a->data.s64 % b->data.u16);
+ case TAG_U32:
+ return tag_init_u32(dest, a->data.s64 % b->data.u32);
+ case TAG_U64:
+ return tag_init_u64(dest, a->data.s64 % b->data.u64);
+ case TAG_UW:
+ return tag_init_uw(dest, a->data.s64 % b->data.uw);
+ default:
+ goto ko;
+ }
+ case TAG_SW:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f64(dest, fmod((f64) a->data.sw, b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod((f64) a->data.sw, b->data.f64));
+ case TAG_INTEGER:
+ integer_init_sw(&tmp, a->data.sw);
+ dest->type = TAG_INTEGER;
+ integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_u8(dest, a->data.sw % b->data.s8);
+ case TAG_S16:
+ return tag_init_u16(dest, a->data.sw % b->data.s16);
+ case TAG_S32:
+ return tag_init_u32(dest, a->data.sw % b->data.s32);
+ case TAG_S64:
+ return tag_init_uw(dest, a->data.sw % b->data.s64);
+ case TAG_SW:
+ return tag_init_uw(dest, a->data.sw % b->data.sw);
+ case TAG_U8:
+ return tag_init_u8(dest, a->data.sw % b->data.u8);
+ case TAG_U16:
+ return tag_init_u16(dest, a->data.sw % b->data.u16);
+ case TAG_U32:
+ return tag_init_u32(dest, a->data.sw % b->data.u32);
+ case TAG_U64:
+ return tag_init_uw(dest, a->data.sw % b->data.u64);
+ case TAG_UW:
+ return tag_init_uw(dest, a->data.sw % b->data.uw);
+ default:
+ goto ko;
+ }
+ case TAG_U8:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, fmodf((f32) a->data.u8, b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod((f64) a->data.u8, b->data.f64));
+ case TAG_INTEGER:
+ integer_init_s8(&tmp, a->data.u8);
+ dest->type = TAG_INTEGER;
+ integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_u8(dest, a->data.u8 % b->data.s8);
+ case TAG_S16:
+ return tag_init_u8(dest, a->data.u8 % b->data.s16);
+ case TAG_S32:
+ return tag_init_u8(dest, a->data.u8 % b->data.s32);
+ case TAG_S64:
+ return tag_init_u8(dest, a->data.u8 % b->data.s64);
+ case TAG_SW:
+ return tag_init_u8(dest, a->data.u8 % b->data.sw);
+ case TAG_U8:
+ return tag_init_u8(dest, a->data.u8 % b->data.u8);
+ case TAG_U16:
+ return tag_init_u8(dest, a->data.u8 % b->data.u16);
+ case TAG_U32:
+ return tag_init_u8(dest, a->data.u8 % b->data.u32);
+ case TAG_U64:
+ return tag_init_u8(dest, a->data.u8 % b->data.u64);
+ case TAG_UW:
+ return tag_init_u8(dest, a->data.u8 % b->data.uw);
+ default:
+ goto ko;
+ }
+ case TAG_U16:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, fmodf((f32) a->data.u16, b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod((f64) a->data.u16, b->data.f64));
+ case TAG_INTEGER:
+ integer_init_s16(&tmp, a->data.u16);
+ dest->type = TAG_INTEGER;
+ integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_u8(dest, a->data.u16 % b->data.s8);
+ case TAG_S16:
+ return tag_init_u16(dest, a->data.u16 % b->data.s16);
+ case TAG_S32:
+ return tag_init_u16(dest, a->data.u16 % b->data.s32);
+ case TAG_S64:
+ return tag_init_u16(dest, a->data.u16 % b->data.s64);
+ case TAG_SW:
+ return tag_init_u16(dest, a->data.u16 % b->data.sw);
+ case TAG_U8:
+ return tag_init_u8(dest, a->data.u16 % b->data.u8);
+ case TAG_U16:
+ return tag_init_u16(dest, a->data.u16 % b->data.u16);
+ case TAG_U32:
+ return tag_init_u16(dest, a->data.u16 % b->data.u32);
+ case TAG_U64:
+ return tag_init_u16(dest, a->data.u16 % b->data.u64);
+ case TAG_UW:
+ return tag_init_u16(dest, a->data.u16 % b->data.uw);
+ default:
+ goto ko;
+ }
+ case TAG_U32:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f64(dest, fmod((f64) a->data.u32, b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod((f64) a->data.u32, b->data.f64));
+ case TAG_INTEGER:
+ integer_init_s32(&tmp, a->data.u32);
+ dest->type = TAG_INTEGER;
+ integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_u8(dest, a->data.u32 % b->data.s8);
+ case TAG_S16:
+ return tag_init_u16(dest, a->data.u32 % b->data.s16);
+ case TAG_S32:
+ return tag_init_u32(dest, a->data.u32 % b->data.s32);
+ case TAG_S64:
+ return tag_init_u32(dest, a->data.u32 % b->data.s64);
+ case TAG_SW:
+ return tag_init_u32(dest, a->data.u32 % b->data.sw);
+ case TAG_U8:
+ return tag_init_u8(dest, a->data.u32 % b->data.u8);
+ case TAG_U16:
+ return tag_init_u16(dest, a->data.u32 % b->data.u16);
+ case TAG_U32:
+ return tag_init_u32(dest, a->data.u32 % b->data.u32);
+ case TAG_U64:
+ return tag_init_u32(dest, a->data.u32 % b->data.u64);
+ case TAG_UW:
+ return tag_init_u32(dest, a->data.u32 % b->data.uw);
+ default:
+ goto ko;
+ }
+ case TAG_U64:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f64(dest, fmod((f64) a->data.u64, b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod((f64) a->data.u64, b->data.f64));
+ case TAG_INTEGER:
+ integer_init_s64(&tmp, a->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_u8(dest, a->data.u64 % b->data.s8);
+ case TAG_S16:
+ return tag_init_u16(dest, a->data.u64 % b->data.s16);
+ case TAG_S32:
+ return tag_init_u32(dest, a->data.u64 % b->data.s32);
+ case TAG_S64:
+ return tag_init_u64(dest, a->data.u64 % b->data.s64);
+ case TAG_SW:
+ return tag_init_uw(dest, a->data.u64 % b->data.sw);
+ case TAG_U8:
+ return tag_init_u8(dest, a->data.u64 % b->data.u8);
+ case TAG_U16:
+ return tag_init_u16(dest, a->data.u64 % b->data.u16);
+ case TAG_U32:
+ return tag_init_u32(dest, a->data.u64 % b->data.u32);
+ case TAG_U64:
+ return tag_init_u64(dest, a->data.u64 % b->data.u64);
+ case TAG_UW:
+ return tag_init_uw(dest, a->data.u64 % b->data.uw);
+ default:
+ goto ko;
+ }
+ case TAG_UW:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f64(dest, fmod((f64) a->data.uw, b->data.f32));
+ case TAG_F64:
+ return tag_init_f64(dest, fmod((f64) a->data.uw, b->data.f64));
+ case TAG_INTEGER:
+ integer_init_sw(&tmp, a->data.uw);
+ dest->type = TAG_INTEGER;
+ integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_u8(dest, a->data.uw % b->data.s8);
+ case TAG_S16:
+ return tag_init_u16(dest, a->data.uw % b->data.s16);
+ case TAG_S32:
+ return tag_init_u32(dest, a->data.uw % b->data.s32);
+ case TAG_S64:
+ return tag_init_uw(dest, a->data.uw % b->data.s64);
+ case TAG_SW:
+ return tag_init_uw(dest, a->data.uw % b->data.sw);
+ case TAG_U8:
+ return tag_init_u8(dest, a->data.uw % b->data.u8);
+ case TAG_U16:
+ return tag_init_u16(dest, a->data.uw % b->data.u16);
+ case TAG_U32:
+ return tag_init_u32(dest, a->data.uw % b->data.u32);
+ case TAG_U64:
+ return tag_init_uw(dest, a->data.uw % b->data.u64);
+ case TAG_UW:
+ return tag_init_uw(dest, a->data.uw % b->data.uw);
+ default:
+ goto ko;
+ }
+ default:
+ goto ko;
+ }
+ ko:
+ errx(1, "cannot divide %s by %s",
+ tag_type_to_string(a->type),
+ tag_type_to_string(b->type));
}
-s_tag * tag_init_integer_1 (s_tag *tag, const s8 *p)
+s_tag * tag_mul (const s_tag *a, const s_tag *b, s_tag *dest)
{
- s_buf buf;
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_INTEGER;
- buf_init_1(&buf, p);
- if (buf_parse_integer(&buf, &tag->data.integer) != (sw) strlen(p)) {
- assert(! "tag_init_integer_1: invalid integer");
- errx(1, "tag_init_integer_1: invalid integer");
- buf_clean(&buf);
- return NULL;
+ s_integer tmp;
+ s_integer tmp2;
+ assert(a);
+ assert(b);
+ assert(dest);
+ switch (a->type) {
+ case TAG_F32:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, a->data.f32 * b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.f32 * b->data.f64);
+ case TAG_INTEGER:
+ return tag_init_f32(dest, a->data.f32 *
+ integer_to_f32(&b->data.integer));
+ case TAG_S8:
+ return tag_init_f32(dest, a->data.f32 * (f32) b->data.s8);
+ case TAG_S16:
+ return tag_init_f32(dest, a->data.f32 * (f32) b->data.s16);
+ case TAG_S32:
+ return tag_init_f32(dest, a->data.f32 * (f32) b->data.s32);
+ case TAG_S64:
+ return tag_init_f32(dest, a->data.f32 * (f32) b->data.s64);
+ case TAG_U8:
+ return tag_init_f32(dest, a->data.f32 * (f32) b->data.u8);
+ case TAG_U16:
+ return tag_init_f32(dest, a->data.f32 * (f32) b->data.u16);
+ case TAG_U32:
+ return tag_init_f32(dest, a->data.f32 * (f32) b->data.u32);
+ case TAG_U64:
+ return tag_init_f32(dest, a->data.f32 * (f32) b->data.u64);
+ default:
+ goto ko;
+ }
+ case TAG_F64:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f64(dest, a->data.f64 * (f64) b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, a->data.f64 * b->data.f64);
+ case TAG_INTEGER:
+ return tag_init_f64(dest, a->data.f64 *
+ integer_to_f64(&b->data.integer));
+ case TAG_S8:
+ return tag_init_f64(dest, a->data.f64 * (f64) b->data.s8);
+ case TAG_S16:
+ return tag_init_f64(dest, a->data.f64 * (f64) b->data.s16);
+ case TAG_S32:
+ return tag_init_f64(dest, a->data.f64 * (f64) b->data.s32);
+ case TAG_S64:
+ return tag_init_f64(dest, a->data.f64 * (f64) b->data.s64);
+ case TAG_U8:
+ return tag_init_f64(dest, a->data.f64 * (f64) b->data.u8);
+ case TAG_U16:
+ return tag_init_f64(dest, a->data.f64 * (f64) b->data.u16);
+ case TAG_U32:
+ return tag_init_f64(dest, a->data.f64 * (f64) b->data.u32);
+ case TAG_U64:
+ return tag_init_f64(dest, a->data.f64 * (f64) b->data.u64);
+ default:
+ goto ko;
+ }
+ case TAG_INTEGER:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, integer_to_f32(&a->data.integer) *
+ b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, integer_to_f64(&a->data.integer) *
+ b->data.f64);
+ case TAG_INTEGER:
+ dest->type = TAG_INTEGER;
+ integer_mul(&a->data.integer, &b->data.integer,
+ &dest->data.integer);
+ return dest;
+ case TAG_S8:
+ integer_init_s8(&tmp, b->data.s8);
+ dest->type = TAG_INTEGER;
+ integer_mul(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S16:
+ integer_init_s16(&tmp, b->data.s16);
+ dest->type = TAG_INTEGER;
+ integer_mul(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S32:
+ integer_init_s32(&tmp, b->data.s32);
+ dest->type = TAG_INTEGER;
+ integer_mul(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S64:
+ integer_init_s64(&tmp, b->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_U8:
+ integer_init_u8(&tmp, b->data.u8);
+ dest->type = TAG_INTEGER;
+ integer_mul(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_U16:
+ integer_init_u16(&tmp, b->data.u16);
+ dest->type = TAG_INTEGER;
+ integer_mul(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_U32:
+ integer_init_u32(&tmp, b->data.u32);
+ dest->type = TAG_INTEGER;
+ integer_mul(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_U64:
+ integer_init_u64(&tmp, b->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&a->data.integer, &tmp, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ default:
+ goto ko;
+ }
+ case TAG_S8:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.s8 * b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.s8 * b->data.f64);
+ case TAG_INTEGER:
+ integer_init_s8(&tmp, a->data.s8);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s16(dest, (s16) a->data.s8 * (s16) b->data.s8);
+ case TAG_S16:
+ return tag_init_s32(dest, (s32) a->data.s8 * (s32) b->data.s16);
+ case TAG_S32:
+ return tag_init_s64(dest, (s64) a->data.s8 * (s64) b->data.s32);
+ case TAG_S64:
+ integer_init_s8(&tmp, a->data.s8);
+ integer_init_s64(&tmp2, b->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U8:
+ return tag_init_s16(dest, (s16) a->data.s8 * (s16) b->data.u8);
+ case TAG_U16:
+ return tag_init_s32(dest, (s32) a->data.s8 * (s32) b->data.u16);
+ case TAG_U32:
+ return tag_init_s64(dest, (s64) a->data.s8 * (s64) b->data.u32);
+ case TAG_U64:
+ integer_init_s8(&tmp, a->data.s8);
+ integer_init_u64(&tmp2, b->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ default:
+ goto ko;
+ }
+ case TAG_S16:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.s16 * b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.s16 * b->data.f64);
+ case TAG_INTEGER:
+ integer_init_s16(&tmp, a->data.s16);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s32(dest, (s32) a->data.s16 * (s32) b->data.s8);
+ case TAG_S16:
+ return tag_init_s32(dest, (s32) a->data.s16 * (s32) b->data.s16);
+ case TAG_S32:
+ return tag_init_s64(dest, (s64) a->data.s16 * (s64) b->data.s32);
+ case TAG_S64:
+ integer_init_s16(&tmp, a->data.s16);
+ integer_init_s64(&tmp2, b->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U8:
+ return tag_init_s32(dest, (s32) a->data.s16 * (s32) b->data.u8);
+ case TAG_U16:
+ return tag_init_s32(dest, (s32) a->data.s16 * (s32) b->data.u16);
+ case TAG_U32:
+ return tag_init_s64(dest, (s64) a->data.s16 * (s64) b->data.u32);
+ case TAG_U64:
+ integer_init_s16(&tmp, a->data.s16);
+ integer_init_u64(&tmp2, b->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ default:
+ goto ko;
+ }
+ case TAG_S32:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.s32 * b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.s32 * b->data.f64);
+ case TAG_INTEGER:
+ integer_init_s32(&tmp, a->data.s32);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.s8);
+ case TAG_S16:
+ return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.s16);
+ case TAG_S32:
+ return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.s32);
+ case TAG_S64:
+ integer_init_s32(&tmp, a->data.s32);
+ integer_init_s64(&tmp2, b->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U8:
+ return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.u8);
+ case TAG_U16:
+ return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.u16);
+ case TAG_U32:
+ return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.u32);
+ case TAG_U64:
+ integer_init_s32(&tmp, a->data.s32);
+ integer_init_u64(&tmp2, b->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ default:
+ goto ko;
+ }
+ case TAG_S64:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.s64 * b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.s64 * b->data.f64);
+ case TAG_INTEGER:
+ integer_init_s64(&tmp, a->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ integer_init_s64(&tmp, a->data.s64);
+ integer_init_s8(&tmp2, b->data.s8);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_S16:
+ integer_init_s64(&tmp, a->data.s64);
+ integer_init_s16(&tmp2, b->data.s16);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_S32:
+ integer_init_s64(&tmp, a->data.s64);
+ integer_init_s32(&tmp2, b->data.s32);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_S64:
+ integer_init_s64(&tmp, a->data.s64);
+ integer_init_s64(&tmp2, b->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U8:
+ integer_init_s64(&tmp, a->data.s64);
+ integer_init_u8(&tmp2, b->data.u8);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U16:
+ integer_init_s64(&tmp, a->data.s64);
+ integer_init_u16(&tmp2, b->data.u16);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U32:
+ integer_init_s64(&tmp, a->data.s64);
+ integer_init_u32(&tmp2, b->data.u32);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U64:
+ integer_init_s64(&tmp, a->data.s64);
+ integer_init_u64(&tmp2, b->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ default:
+ goto ko;
+ }
+ case TAG_U8:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.u8 * b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.u8 * b->data.f64);
+ case TAG_INTEGER:
+ integer_init_u8(&tmp, a->data.u8);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s16(dest, (s16) a->data.u8 * (s16) b->data.s8);
+ case TAG_S16:
+ return tag_init_s32(dest, (s32) a->data.u8 * (s32) b->data.s16);
+ case TAG_S32:
+ return tag_init_s64(dest, (s32) a->data.u8 * (s64) b->data.s32);
+ case TAG_S64:
+ integer_init_u8(&tmp, a->data.u8);
+ integer_init_s64(&tmp2, b->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U8:
+ return tag_init_u16(dest, (u16) a->data.u8 * (u16) b->data.u8);
+ case TAG_U16:
+ return tag_init_u32(dest, (u32) a->data.u8 * (u32) b->data.u16);
+ case TAG_U32:
+ return tag_init_u64(dest, (u64) a->data.u8 * (u64) b->data.u32);
+ case TAG_U64:
+ integer_init_u8(&tmp, a->data.u8);
+ integer_init_u64(&tmp2, b->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ default:
+ goto ko;
+ }
+ case TAG_U16:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.u16 * b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.u16 * b->data.f64);
+ case TAG_INTEGER:
+ integer_init_u16(&tmp, a->data.u16);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s32(dest, (s32) a->data.u16 * (s32) b->data.s8);
+ case TAG_S16:
+ return tag_init_s32(dest, (s32) a->data.u16 * (s32) b->data.s16);
+ case TAG_S32:
+ return tag_init_s64(dest, (s64) a->data.u16 * (s64) b->data.s32);
+ case TAG_S64:
+ integer_init_u16(&tmp, a->data.u16);
+ integer_init_s64(&tmp2, b->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U8:
+ return tag_init_u32(dest, (u32) a->data.u16 * (u32) b->data.u8);
+ case TAG_U16:
+ return tag_init_u32(dest, (u32) a->data.u16 * (u32) b->data.u16);
+ case TAG_U32:
+ return tag_init_u64(dest, (u64) a->data.u16 * (u64) b->data.u32);
+ case TAG_U64:
+ integer_init_u16(&tmp, a->data.u16);
+ integer_init_u64(&tmp2, b->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ default:
+ goto ko;
+ }
+ case TAG_U32:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.u32 * b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.u32 * b->data.f64);
+ case TAG_INTEGER:
+ integer_init_u32(&tmp, a->data.u32);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ return tag_init_s64(dest, (s64) a->data.u32 * (s64) b->data.s8);
+ case TAG_S16:
+ return tag_init_s64(dest, (s64) a->data.u32 * (s64) b->data.s16);
+ case TAG_S32:
+ return tag_init_s64(dest, (s64) a->data.u32 * b->data.s32);
+ case TAG_S64:
+ integer_init_u32(&tmp, a->data.u32);
+ integer_init_s64(&tmp2, b->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U8:
+ return tag_init_u64(dest, (u64) a->data.u32 * (u64) b->data.u8);
+ case TAG_U16:
+ return tag_init_u64(dest, (u64) a->data.u32 * (u64) b->data.u16);
+ case TAG_U32:
+ return tag_init_u64(dest, (u64) a->data.u32 * (u64) b->data.u32);
+ case TAG_U64:
+ integer_init_u32(&tmp, a->data.u32);
+ integer_init_u64(&tmp2, b->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ default:
+ goto ko;
}
- buf_clean(&buf);
- return tag;
-}
-
-s_tag * tag_init_integer_s64 (s_tag *tag, s64 s)
-{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_INTEGER;
- integer_init_s64(&tag->data.integer, s);
- return tag;
-}
-
-s_tag * tag_init_integer_u64 (s_tag *tag, u64 u)
-{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_INTEGER;
- integer_init_u64(&tag->data.integer, u);
- return tag;
-}
-
-s_tag * tag_init_integer_zero (s_tag *tag)
-{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_INTEGER;
- integer_init_zero(&tag->data.integer);
- return tag;
-}
-
-s_tag * tag_init_list (s_tag *tag, s_list *list)
-{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_LIST;
- tag->data.list = list;
- return tag;
-}
-
-s_tag * tag_init_list_1 (s_tag *tag, const s8 *p)
-{
- s_buf buf;
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_LIST;
- buf_init_1(&buf, p);
- if (buf_parse_list(&buf, &tag->data.list) != (sw) strlen(p)) {
- assert(! "tag_init_list_1: invalid list");
- errx(1, "tag_init_list_1: invalid list");
- buf_clean(&buf);
- return NULL;
+ case TAG_U64:
+ switch (b->type) {
+ case TAG_F32:
+ return tag_init_f32(dest, (f32) a->data.u64 * b->data.f32);
+ case TAG_F64:
+ return tag_init_f64(dest, (f64) a->data.u64 * b->data.f64);
+ case TAG_INTEGER:
+ integer_init_u64(&tmp, a->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &b->data.integer, &dest->data.integer);
+ integer_clean(&tmp);
+ return dest;
+ case TAG_S8:
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s8(&tmp2, b->data.s8);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_S16:
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s16(&tmp2, b->data.s16);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_S32:
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s32(&tmp2, b->data.s32);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_S64:
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_s64(&tmp2, b->data.s64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U8:
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_u8(&tmp2, b->data.u8);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U16:
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_u16(&tmp2, b->data.u16);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U32:
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_u32(&tmp2, b->data.u32);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ case TAG_U64:
+ integer_init_u64(&tmp, a->data.u64);
+ integer_init_u64(&tmp2, b->data.u64);
+ dest->type = TAG_INTEGER;
+ integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return dest;
+ default:
+ goto ko;
+ }
+ default:
+ goto ko;
}
- buf_clean(&buf);
- return tag;
-}
-
-s_tag * tag_init_s8 (s_tag *tag, s8 i)
-{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_S8;
- tag->data.s8 = i;
- return tag;
-}
-
-s_tag * tag_init_s16 (s_tag *tag, s16 i)
-{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_S16;
- tag->data.s16 = i;
- return tag;
-}
-
-s_tag * tag_init_s32 (s_tag *tag, s32 i)
-{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_S32;
- tag->data.s32 = i;
- return tag;
-}
-
-s_tag * tag_init_s64 (s_tag *tag, s64 i)
-{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_S64;
- tag->data.s64 = i;
- return tag;
-}
-
-s_tag * tag_init_sw (s_tag *tag, sw i)
-{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_SW;
- tag->data.sw = i;
- return tag;
-}
-
-s_tag * tag_init_str (s_tag *tag, s8 *free, uw size, const s8 *p)
-{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_STR;
- str_init(&tag->data.str, free, size, p);
- return tag;
-}
-
-s_tag * tag_init_str_1 (s_tag *tag, s8 *free, const s8 *p)
-{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_STR;
- str_init_1(&tag->data.str, free, p);
- return tag;
-}
-
-s_tag * tag_init_sym (s_tag *tag, const s_sym *p)
-{
- assert(tag);
- assert(p);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_SYM;
- tag->data.sym = p;
- return tag;
+ ko:
+ errx(1, "cannot multiply %s by %s",
+ tag_type_to_string(a->type),
+ tag_type_to_string(b->type));
}
-s_tag * tag_init_sym_1 (s_tag *tag, const s8 *p)
+s_tag * tag_neg (const s_tag *tag, s_tag *result)
{
- s_buf buf;
- assert(tag);
- assert(p);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_SYM;
- buf_init_1(&buf, p);
- if (buf_parse_sym(&buf, &tag->data.sym) != (sw) strlen(p)) {
- assert(! "tag_init_sym_1: invalid symbol");
- errx(1, "tag_init_sym_1: invalid symbol");
- buf_clean(&buf);
- return NULL;
+ s_integer tmp;
+ switch (tag->type) {
+ case TAG_BOOL:
+ return tag_init_s8(result, -(tag->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s64(result, -tag->data.character);
+ case TAG_INTEGER:
+ tag_init_integer_zero(result);
+ integer_neg(&tag->data.integer, &result->data.integer);
+ return result;
+ case TAG_SW:
+ if (tag->data.sw == SW_MIN) {
+ integer_init_sw(&tmp, tag->data.sw);
+ result->type = TAG_INTEGER;
+ integer_neg(&tmp, &result->data.integer);
+ integer_clean(&tmp);
+ return result;
+ }
+ return tag_init_sw(result, -tag->data.sw);
+ case TAG_S64:
+ if (tag->data.s64 == S64_MIN) {
+ integer_init_s64(&tmp, tag->data.s64);
+ result->type = TAG_INTEGER;
+ integer_neg(&tmp, &result->data.integer);
+ integer_clean(&tmp);
+ return result;
+ }
+ return tag_init_s64(result, -tag->data.s64);
+ case TAG_S32:
+ return tag_init_s64(result, -tag->data.s32);
+ case TAG_S16:
+ return tag_init_s32(result, -tag->data.s16);
+ case TAG_S8:
+ return tag_init_s16(result, -tag->data.s8);
+ case TAG_U8:
+ return tag_init_s16(result, -tag->data.u8);
+ case TAG_U16:
+ return tag_init_s32(result, -tag->data.u16);
+ case TAG_U32:
+ return tag_init_s64(result, -tag->data.u32);
+ case TAG_U64:
+ integer_init_u64(&tmp, tag->data.u64);
+ result->type = TAG_INTEGER;
+ integer_neg(&tmp, &result->data.integer);
+ return result;
+ case TAG_UW:
+ integer_init_uw(&tmp, tag->data.uw);
+ result->type = TAG_INTEGER;
+ integer_neg(&tmp, &result->data.integer);
+ return result;
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ warnx("tag_neg: invalid tag type: %s",
+ tag_type_to_string(tag->type));
}
- buf_clean(&buf);
- return tag;
-}
-
-s_tag * tag_init_time (s_tag *tag)
-{
- struct timespec time;
- clock_gettime(CLOCK_REALTIME, &time);
- return timespec_to_tag(&time, tag);
+ return NULL;
}
-s_tag * tag_init_tuple (s_tag *tag, uw count)
+s_tag * tag_new ()
{
- assert(tag);
- assert(count);
- tag->type = TAG_TUPLE;
- tuple_init(&tag->data.tuple, count);
+ s_tag *tag;
+ tag = calloc(1, sizeof(s_tag));
return tag;
}
-s_tag * tag_init_u8 (s_tag *tag, u8 i)
+s_tag * tag_new_1 (const s8 *p)
{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_U8;
- tag->data.u8 = i;
- return tag;
+ s_tag *tag;
+ tag = calloc(1, sizeof(s_tag));
+ return tag_init_1(tag, p);
}
-s_tag * tag_init_u16 (s_tag *tag, u16 i)
+s_tag * tag_new_array (const s_array *a)
{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_U16;
- tag->data.u16 = i;
- return tag;
+ s_tag *dest;
+ assert(a);
+ if (! (dest = malloc(sizeof(s_tag))))
+ errx(1, "tag_new_array: out of memory");
+ return tag_init_array(dest, a);
}
-s_tag * tag_init_u32 (s_tag *tag, u32 i)
+s_tag * tag_new_copy (const s_tag *src)
{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_U32;
- tag->data.u32 = i;
- return tag;
+ s_tag *dest;
+ if (! (dest = malloc(sizeof(s_tag))))
+ errx(1, "tag_new_copy: out of memory");
+ return tag_copy(src, dest);
}
-s_tag * tag_init_u64 (s_tag *tag, u64 i)
+bool tag_not (const s_tag *a)
{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_U64;
- tag->data.u64 = i;
- return tag;
+ s_tag f;
+ tag_init_bool(&f, false);
+ return compare_tag(a, &f) == 0;
}
-s_tag * tag_init_uw (s_tag *tag, uw i)
+bool tag_not_eq (const s_tag *a, const s_tag *b)
{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_UW;
- tag->data.uw = i;
- return tag;
+ return compare_tag(a, b) != 0;
}
-s_tag * tag_init_var (s_tag *tag)
+bool tag_or (const s_tag *a, const s_tag *b)
{
- assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_VAR;
- return tag;
+ s_tag f;
+ tag_init_bool(&f, false);
+ return compare_tag(a, &f) != 0 || compare_tag(b, &f) != 0;
}
-s_tag * tag_init_void (s_tag *tag)
+s_tag * tag_paren (const s_tag *tag, s_tag *dest)
{
assert(tag);
- bzero(tag, sizeof(s_tag));
- tag->type = TAG_VOID;
- return tag;
-}
-
-s_str * tag_inspect (const s_tag *tag, s_str *dest)
-{
- s_buf buf;
- sw size;
- if ((size = buf_inspect_tag_size(tag)) < 0) {
- assert(! "tag_inspect: size error");
- errx(1, "tag_inspect: size error");
- return NULL;
- }
- buf_init_alloc(&buf, size);
- if (buf_inspect_tag(&buf, tag) != size) {
- assert(! "tag_inspect: inspect error");
- errx(1, "tag_inspect: inspect error");
- return NULL;
- }
- return buf_to_str(&buf, dest);
+ assert(dest);
+ return tag_copy(tag, dest);
}
-s_tag * tag_integer (s_tag *tag, const s_integer *x)
+s_tag * tag_s8 (s_tag *tag, s8 x)
{
assert(tag);
tag_clean(tag);
- return tag_init_integer(tag, x);
+ return tag_init_s8(tag, x);
}
-s_tag * tag_integer_1 (s_tag *tag, const s8 *p)
+s_tag * tag_s16 (s_tag *tag, s16 x)
{
assert(tag);
tag_clean(tag);
- return tag_init_integer_1(tag, p);
-}
-
-s_tag * tag_integer_reduce (s_tag *tag)
-{
- uw bytes;
- e_bool negative;
- assert(tag);
- switch (tag->type) {
- case TAG_INTEGER:
- bytes = integer_bytes(&tag->data.integer);
- if (bytes > 8)
- break;
- negative = integer_is_negative(&tag->data.integer);
- if (bytes > 4) {
- if (negative)
- return tag_cast_integer_to_s64(tag);
- return tag_cast_integer_to_u64(tag);
- }
- if (bytes > 2) {
- if (negative)
- return tag_cast_integer_to_s32(tag);
- return tag_cast_integer_to_u32(tag);
- }
- if (bytes > 1) {
- if (negative)
- return tag_cast_integer_to_s16(tag);
- return tag_cast_integer_to_u16(tag);
- }
- if (negative)
- return tag_cast_integer_to_s8(tag);
- return tag_cast_integer_to_u8(tag);
- default: ;
- }
- return tag;
-}
-
-bool tag_is_bound_var (const s_tag *tag)
-{
- return (tag &&
- tag->type != TAG_VAR);
-}
-
-bool tag_is_number (const s_tag *tag)
-{
- assert(tag);
- switch (tag->type) {
- case TAG_INTEGER:
- case TAG_S8:
- case TAG_S16:
- case TAG_S32:
- case TAG_S64:
- case TAG_U8:
- case TAG_U16:
- case TAG_U32:
- case TAG_U64:
- return true;
- default: ;
- }
- return false;
-}
-
-bool tag_is_unbound_var (const s_tag *tag)
-{
- return (tag &&
- tag->type == TAG_VAR);
+ return tag_init_s16(tag, x);
}
-s_tag * tag_list (s_tag *tag, s_list *x)
+s_tag * tag_s32 (s_tag *tag, s32 x)
{
assert(tag);
tag_clean(tag);
- return tag_init_list(tag, x);
+ return tag_init_s32(tag, x);
}
-s_tag * tag_list_1 (s_tag *tag, const s8 *p)
+s_tag * tag_s64 (s_tag *tag, s64 x)
{
assert(tag);
tag_clean(tag);
- return tag_init_list_1(tag, p);
-}
-
-bool tag_lt (const s_tag *a, const s_tag *b)
-{
- return compare_tag(a, b) < 0;
-}
-
-bool tag_lte (const s_tag *a, const s_tag *b)
-{
- return compare_tag(a, b) <= 0;
+ return tag_init_s64(tag, x);
}
-s_tag * tag_mod (const s_tag *a, const s_tag *b, s_tag *dest)
+s_tag * tag_shift_left (const s_tag *a, const s_tag *b, s_tag *result)
{
s_integer tmp;
s_integer tmp2;
- assert(a);
- assert(b);
- assert(dest);
+ s_tag tmp_a;
switch (a->type) {
- case TAG_F32:
+ case TAG_BOOL:
+ tmp_a.data.bool = a->data.bool ? 1 : 0;
switch (b->type) {
- case TAG_F32:
- return tag_init_f32(dest, fmodf(a->data.f32, b->data.f32));
- case TAG_F64:
- return tag_init_f64(dest, fmod((f64) a->data.f32, b->data.f64));
- case TAG_INTEGER:
- return tag_init_f64(dest, fmod((f64) a->data.f32,
- integer_to_f64(&b->data.integer)));
- case TAG_S8:
- return tag_init_f32(dest, fmodf(a->data.f32, (f32) b->data.s8));
- case TAG_S16:
- return tag_init_f32(dest, fmodf(a->data.f32, (f32) b->data.s16));
- case TAG_S32:
- return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.s32));
- case TAG_S64:
- return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.s64));
+ case TAG_BOOL:
+ return tag_init_bool(result, tmp_a.data.bool <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_bool(result, tmp_a.data.bool << b->data.character);
+ case TAG_INTEGER:
+ integer_init_u8(&tmp, tmp_a.data.bool);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_bool(result, integer_to_u8(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.sw));
+ return tag_init_bool(result, tmp_a.data.bool << b->data.sw);
+ case TAG_S64:
+ return tag_init_bool(result, tmp_a.data.bool << b->data.s64);
+ case TAG_S32:
+ return tag_init_bool(result, tmp_a.data.bool << b->data.s32);
+ case TAG_S16:
+ return tag_init_bool(result, tmp_a.data.bool << b->data.s16);
+ case TAG_S8:
+ return tag_init_bool(result, tmp_a.data.bool << b->data.s8);
case TAG_U8:
- return tag_init_f32(dest, fmodf(a->data.f32, (f32) b->data.u8));
+ return tag_init_bool(result, tmp_a.data.bool << b->data.u8);
case TAG_U16:
- return tag_init_f32(dest, fmodf(a->data.f32, (f32) b->data.u16));
+ return tag_init_bool(result, tmp_a.data.bool << b->data.u16);
case TAG_U32:
- return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.u32));
+ return tag_init_bool(result, tmp_a.data.bool << b->data.u32);
case TAG_U64:
- return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.u64));
+ return tag_init_bool(result, tmp_a.data.bool << b->data.u64);
case TAG_UW:
- return tag_init_f64(dest, fmod((f64) a->data.f32, (f64) b->data.uw));
- default:
- goto ko;
- }
- case TAG_F64:
- switch (b->type) {
+ return tag_init_bool(result, tmp_a.data.bool << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.f32));
case TAG_F64:
- return tag_init_f64(dest, fmod(a->data.f64, b->data.f64));
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_CHARACTER:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_character(result, a->data.character <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_character(result, a->data.character << b->data.character);
case TAG_INTEGER:
- return tag_init_f64(dest, fmod(a->data.f64,
- integer_to_f64(&b->data.integer)));
- case TAG_S8:
- return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.s8));
- case TAG_S16:
- return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.s16));
- case TAG_S32:
- return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.s32));
- case TAG_S64:
- return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.s64));
+ integer_init_u32(&tmp, a->data.character);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_character(result, integer_to_u32(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.sw));
+ return tag_init_character(result, a->data.character << b->data.sw);
+ case TAG_S64:
+ return tag_init_character(result, a->data.character << b->data.s64);
+ case TAG_S32:
+ return tag_init_character(result, a->data.character << b->data.s32);
+ case TAG_S16:
+ return tag_init_character(result, a->data.character << b->data.s16);
+ case TAG_S8:
+ return tag_init_character(result, a->data.character << b->data.s8);
case TAG_U8:
- return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.u8));
+ return tag_init_character(result, a->data.character << b->data.u8);
case TAG_U16:
- return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.u16));
+ return tag_init_character(result, a->data.character << b->data.u16);
case TAG_U32:
- return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.u32));
+ return tag_init_character(result, a->data.character << b->data.u32);
case TAG_U64:
- return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.u64));
+ return tag_init_character(result, a->data.character << b->data.u64);
case TAG_UW:
- return tag_init_f64(dest, fmod(a->data.f64, (f64) b->data.uw));
- default:
- goto ko;
+ return tag_init_character(result, a->data.character << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
}
case TAG_INTEGER:
switch (b->type) {
- case TAG_F32:
- return tag_init_f64(dest, fmod(integer_to_f64(&a->data.integer),
- (f64) b->data.f32));
- case TAG_F64:
- return tag_init_f64(dest, fmod(integer_to_f64(&a->data.integer),
- b->data.f64));
+ case TAG_BOOL:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.bool ? 1 : 0,
+ &result->data.integer);
+ return result;
+ case TAG_CHARACTER:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.character,
+ &result->data.integer);
+ return result;
case TAG_INTEGER:
- dest->type = TAG_INTEGER;
- integer_mod(&a->data.integer, &b->data.integer,
- &dest->data.integer);
- return dest;
- case TAG_S8:
- integer_init_s8(&tmp, b->data.s8);
- integer_mod(&a->data.integer, &tmp, &tmp2);
- tag_init_u8(dest, integer_to_u8(&tmp2));
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- case TAG_S16:
- integer_init_s16(&tmp, b->data.s16);
- integer_mod(&a->data.integer, &tmp, &tmp2);
- tag_init_u16(dest, integer_to_u16(&tmp2));
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- case TAG_S32:
- integer_init_s32(&tmp, b->data.s32);
- integer_mod(&a->data.integer, &tmp, &tmp2);
- tag_init_u32(dest, integer_to_u32(&tmp2));
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- case TAG_S64:
- integer_init_s64(&tmp, b->data.s64);
- integer_mod(&a->data.integer, &tmp, &tmp2);
- tag_init_u64(dest, integer_to_u64(&tmp2));
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, integer_to_sw(&b->data.integer),
+ &result->data.integer);
+ return result;
case TAG_SW:
- integer_init_sw(&tmp, b->data.sw);
- integer_mod(&a->data.integer, &tmp, &tmp2);
- tag_init_uw(dest, integer_to_uw(&tmp2));
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- case TAG_U8:
- integer_init_u8(&tmp, b->data.u8);
- integer_mod(&a->data.integer, &tmp, &tmp2);
- tag_init_u8(dest, integer_to_u8(&tmp2));
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.sw,
+ &result->data.integer);
+ return result;
+ case TAG_S64:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.s64, &result->data.integer);
+ return result;
+ case TAG_S32:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.s32, &result->data.integer);
+ return result;
+ case TAG_S16:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.s16, &result->data.integer);
+ return result;
+ case TAG_S8:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.s8, &result->data.integer);
+ return result;
+ case TAG_U8:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.u8, &result->data.integer);
+ return result;
case TAG_U16:
- integer_init_u16(&tmp, b->data.u16);
- integer_mod(&a->data.integer, &tmp, &tmp2);
- tag_init_u16(dest, integer_to_u16(&tmp2));
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.u16, &result->data.integer);
+ return result;
case TAG_U32:
- integer_init_u32(&tmp, b->data.u32);
- integer_mod(&a->data.integer, &tmp, &tmp2);
- tag_init_u32(dest, integer_to_u32(&tmp2));
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.u32, &result->data.integer);
+ return result;
case TAG_U64:
- integer_init_u64(&tmp, b->data.u64);
- integer_mod(&a->data.integer, &tmp, &tmp2);
- tag_init_u64(dest, integer_to_u64(&tmp2));
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.u64, &result->data.integer);
+ return result;
case TAG_UW:
- integer_init_uw(&tmp, b->data.uw);
- integer_mod(&a->data.integer, &tmp, &tmp2);
- tag_init_uw(dest, integer_to_uw(&tmp2));
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- default:
- goto ko;
- }
- case TAG_S8:
- switch (b->type) {
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.uw, &result->data.integer);
+ return result;
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, fmodf((f32) a->data.s8, b->data.f32));
case TAG_F64:
- return tag_init_f64(dest, fmod((f64) a->data.s8, b->data.f64));
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_SW:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_sw(result, a->data.sw <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_sw(result, a->data.sw << b->data.character);
case TAG_INTEGER:
- integer_init_s8(&tmp, a->data.s8);
- dest->type = TAG_INTEGER;
- integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_sw(&tmp, a->data.sw);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_sw(result, integer_to_sw(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_u8(dest, a->data.s8 % b->data.s8);
- case TAG_S16:
- return tag_init_u8(dest, a->data.s8 % b->data.s16);
- case TAG_S32:
- return tag_init_u8(dest, a->data.s8 % b->data.s32);
- case TAG_S64:
- return tag_init_u8(dest, a->data.s8 % b->data.s64);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_u8(dest, a->data.s8 % b->data.sw);
+ return tag_init_sw(result, a->data.sw << b->data.sw);
+ case TAG_S64:
+ return tag_init_sw(result, a->data.sw << b->data.s64);
+ case TAG_S32:
+ return tag_init_sw(result, a->data.sw << b->data.s32);
+ case TAG_S16:
+ return tag_init_sw(result, a->data.sw << b->data.s16);
+ case TAG_S8:
+ return tag_init_sw(result, a->data.sw << b->data.s8);
case TAG_U8:
- return tag_init_u8(dest, a->data.s8 % b->data.u8);
+ return tag_init_sw(result, a->data.sw << b->data.u8);
case TAG_U16:
- return tag_init_u8(dest, a->data.s8 % b->data.u16);
+ return tag_init_sw(result, a->data.sw << b->data.u16);
case TAG_U32:
- return tag_init_u8(dest, a->data.s8 % b->data.u32);
+ return tag_init_sw(result, a->data.sw << b->data.u32);
case TAG_U64:
- return tag_init_u8(dest, a->data.s8 % b->data.u64);
+ return tag_init_sw(result, a->data.sw << b->data.u64);
case TAG_UW:
- return tag_init_u8(dest, a->data.s8 % b->data.uw);
- default:
- goto ko;
- }
- case TAG_S16:
- switch (b->type) {
+ return tag_init_sw(result, a->data.sw << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, fmodf((f32) a->data.s16, b->data.f32));
case TAG_F64:
- return tag_init_f64(dest, fmod((f64) a->data.s16, b->data.f64));
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_S64:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_s64(result, a->data.s64 <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s64(result, a->data.s64 << b->data.character);
case TAG_INTEGER:
- integer_init_s16(&tmp, a->data.s16);
- dest->type = TAG_INTEGER;
- integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_s64(&tmp, a->data.s64);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_s64(result, integer_to_s64(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_u8(dest, a->data.s16 % b->data.s8);
- case TAG_S16:
- return tag_init_u16(dest, a->data.s16 % b->data.s16);
- case TAG_S32:
- return tag_init_u16(dest, a->data.s16 % b->data.s32);
- case TAG_S64:
- return tag_init_u16(dest, a->data.s16 % b->data.s64);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_u16(dest, a->data.s16 % b->data.sw);
+ return tag_init_s64(result, a->data.s64 << b->data.sw);
+ case TAG_S64:
+ return tag_init_s64(result, a->data.s64 << b->data.s64);
+ case TAG_S32:
+ return tag_init_s64(result, a->data.s64 << b->data.s32);
+ case TAG_S16:
+ return tag_init_s64(result, a->data.s64 << b->data.s16);
+ case TAG_S8:
+ return tag_init_s64(result, a->data.s64 << b->data.s8);
case TAG_U8:
- return tag_init_u8(dest, a->data.s16 % b->data.u8);
+ return tag_init_s64(result, a->data.s64 << b->data.u8);
case TAG_U16:
- return tag_init_u16(dest, a->data.s16 % b->data.u16);
+ return tag_init_s64(result, a->data.s64 << b->data.u16);
case TAG_U32:
- return tag_init_u16(dest, a->data.s16 % b->data.u32);
+ return tag_init_s64(result, a->data.s64 << b->data.u32);
case TAG_U64:
- return tag_init_u16(dest, a->data.s16 % b->data.u64);
+ return tag_init_s64(result, a->data.s64 << b->data.u64);
case TAG_UW:
- return tag_init_u16(dest, a->data.s16 % b->data.uw);
- default:
- goto ko;
+ return tag_init_s64(result, a->data.s64 << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
}
case TAG_S32:
switch (b->type) {
- case TAG_F32:
- return tag_init_f64(dest, fmod((f64) a->data.s32, b->data.f32));
- case TAG_F64:
- return tag_init_f64(dest, fmod((f64) a->data.s32, b->data.f64));
+ case TAG_BOOL:
+ return tag_init_s32(result, a->data.s32 <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s32(result, a->data.s32 << b->data.character);
case TAG_INTEGER:
integer_init_s32(&tmp, a->data.s32);
- dest->type = TAG_INTEGER;
- integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_s32(result, integer_to_s32(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_u8(dest, a->data.s32 % b->data.s8);
- case TAG_S16:
- return tag_init_u16(dest, a->data.s32 % b->data.s16);
- case TAG_S32:
- return tag_init_u32(dest, a->data.s32 % b->data.s32);
- case TAG_S64:
- return tag_init_u32(dest, a->data.s32 % b->data.s64);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_u32(dest, a->data.s32 % b->data.sw);
+ return tag_init_s32(result, a->data.s32 << b->data.sw);
+ case TAG_S64:
+ return tag_init_s32(result, a->data.s32 << b->data.s64);
+ case TAG_S32:
+ return tag_init_s32(result, a->data.s32 << b->data.s32);
+ case TAG_S16:
+ return tag_init_s32(result, a->data.s32 << b->data.s16);
+ case TAG_S8:
+ return tag_init_s32(result, a->data.s32 << b->data.s8);
case TAG_U8:
- return tag_init_u8(dest, a->data.s32 % b->data.u8);
+ return tag_init_s32(result, a->data.s32 << b->data.u8);
case TAG_U16:
- return tag_init_u16(dest, a->data.s32 % b->data.u16);
+ return tag_init_s32(result, a->data.s32 << b->data.u16);
case TAG_U32:
- return tag_init_u32(dest, a->data.s32 % b->data.u32);
+ return tag_init_s32(result, a->data.s32 << b->data.u32);
case TAG_U64:
- return tag_init_u32(dest, a->data.s32 % b->data.u64);
+ return tag_init_s32(result, a->data.s32 << b->data.u64);
case TAG_UW:
- return tag_init_u32(dest, a->data.s32 % b->data.uw);
- default:
- goto ko;
- }
- case TAG_S64:
- switch (b->type) {
+ return tag_init_s32(result, a->data.s32 << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f64(dest, fmod((f64) a->data.s64, b->data.f32));
case TAG_F64:
- return tag_init_f64(dest, fmod((f64) a->data.s64, b->data.f64));
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_S16:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_s16(result, a->data.s16 <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s16(result, a->data.s16 << b->data.character);
case TAG_INTEGER:
- integer_init_s64(&tmp, a->data.s64);
- dest->type = TAG_INTEGER;
- integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_s16(&tmp, a->data.s16);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_s16(result, integer_to_s16(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_u8(dest, a->data.s64 % b->data.s8);
- case TAG_S16:
- return tag_init_u16(dest, a->data.s64 % b->data.s16);
- case TAG_S32:
- return tag_init_u32(dest, a->data.s64 % b->data.s32);
- case TAG_S64:
- return tag_init_u64(dest, a->data.s64 % b->data.s64);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_uw(dest, a->data.s64 % b->data.sw);
+ return tag_init_s16(result, a->data.s16 << b->data.sw);
+ case TAG_S64:
+ return tag_init_s16(result, a->data.s16 << b->data.s64);
+ case TAG_S32:
+ return tag_init_s16(result, a->data.s16 << b->data.s32);
+ case TAG_S16:
+ return tag_init_s16(result, a->data.s16 << b->data.s16);
+ case TAG_S8:
+ return tag_init_s16(result, a->data.s16 << b->data.s8);
case TAG_U8:
- return tag_init_u8(dest, a->data.s64 % b->data.u8);
+ return tag_init_s16(result, a->data.s16 << b->data.u8);
case TAG_U16:
- return tag_init_u16(dest, a->data.s64 % b->data.u16);
+ return tag_init_s16(result, a->data.s16 << b->data.u16);
case TAG_U32:
- return tag_init_u32(dest, a->data.s64 % b->data.u32);
+ return tag_init_s16(result, a->data.s16 << b->data.u32);
case TAG_U64:
- return tag_init_u64(dest, a->data.s64 % b->data.u64);
+ return tag_init_s16(result, a->data.s16 << b->data.u64);
case TAG_UW:
- return tag_init_uw(dest, a->data.s64 % b->data.uw);
- default:
- goto ko;
- }
- case TAG_SW:
- switch (b->type) {
+ return tag_init_s16(result, a->data.s16 << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f64(dest, fmod((f64) a->data.sw, b->data.f32));
case TAG_F64:
- return tag_init_f64(dest, fmod((f64) a->data.sw, b->data.f64));
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_S8:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_s8(result, a->data.s8 <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s8(result, a->data.s8 << b->data.character);
case TAG_INTEGER:
- integer_init_sw(&tmp, a->data.sw);
- dest->type = TAG_INTEGER;
- integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_s8(&tmp, a->data.s8);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_s8(result, integer_to_s8(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_u8(dest, a->data.sw % b->data.s8);
- case TAG_S16:
- return tag_init_u16(dest, a->data.sw % b->data.s16);
- case TAG_S32:
- return tag_init_u32(dest, a->data.sw % b->data.s32);
- case TAG_S64:
- return tag_init_uw(dest, a->data.sw % b->data.s64);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_uw(dest, a->data.sw % b->data.sw);
+ return tag_init_s8(result, a->data.s8 << b->data.sw);
+ case TAG_S64:
+ return tag_init_s8(result, a->data.s8 << b->data.s64);
+ case TAG_S32:
+ return tag_init_s8(result, a->data.s8 << b->data.s32);
+ case TAG_S16:
+ return tag_init_s8(result, a->data.s8 << b->data.s16);
+ case TAG_S8:
+ return tag_init_s8(result, a->data.s8 << b->data.s8);
case TAG_U8:
- return tag_init_u8(dest, a->data.sw % b->data.u8);
+ return tag_init_s8(result, a->data.s8 << b->data.u8);
case TAG_U16:
- return tag_init_u16(dest, a->data.sw % b->data.u16);
+ return tag_init_s8(result, a->data.s8 << b->data.u16);
case TAG_U32:
- return tag_init_u32(dest, a->data.sw % b->data.u32);
+ return tag_init_s8(result, a->data.s8 << b->data.u32);
case TAG_U64:
- return tag_init_uw(dest, a->data.sw % b->data.u64);
+ return tag_init_s8(result, a->data.s8 << b->data.u64);
case TAG_UW:
- return tag_init_uw(dest, a->data.sw % b->data.uw);
- default:
- goto ko;
+ return tag_init_s8(result, a->data.s8 << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
}
case TAG_U8:
switch (b->type) {
- case TAG_F32:
- return tag_init_f32(dest, fmodf((f32) a->data.u8, b->data.f32));
- case TAG_F64:
- return tag_init_f64(dest, fmod((f64) a->data.u8, b->data.f64));
+ case TAG_BOOL:
+ return tag_init_u8(result, a->data.u8 <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u8(result, a->data.u8 << b->data.character);
case TAG_INTEGER:
- integer_init_s8(&tmp, a->data.u8);
- dest->type = TAG_INTEGER;
- integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_u8(&tmp, a->data.u8);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_u8(result, integer_to_u8(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_u8(dest, a->data.u8 % b->data.s8);
- case TAG_S16:
- return tag_init_u8(dest, a->data.u8 % b->data.s16);
- case TAG_S32:
- return tag_init_u8(dest, a->data.u8 % b->data.s32);
- case TAG_S64:
- return tag_init_u8(dest, a->data.u8 % b->data.s64);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_u8(dest, a->data.u8 % b->data.sw);
+ return tag_init_u8(result, a->data.u8 << b->data.sw);
+ case TAG_S64:
+ return tag_init_u8(result, a->data.u8 << b->data.s64);
+ case TAG_S32:
+ return tag_init_u8(result, a->data.u8 << b->data.s32);
+ case TAG_S16:
+ return tag_init_u8(result, a->data.u8 << b->data.s16);
+ case TAG_S8:
+ return tag_init_u8(result, a->data.u8 << b->data.s8);
case TAG_U8:
- return tag_init_u8(dest, a->data.u8 % b->data.u8);
+ return tag_init_u8(result, a->data.u8 << b->data.u8);
case TAG_U16:
- return tag_init_u8(dest, a->data.u8 % b->data.u16);
+ return tag_init_u8(result, a->data.u8 << b->data.u16);
case TAG_U32:
- return tag_init_u8(dest, a->data.u8 % b->data.u32);
+ return tag_init_u8(result, a->data.u8 << b->data.u32);
case TAG_U64:
- return tag_init_u8(dest, a->data.u8 % b->data.u64);
+ return tag_init_u8(result, a->data.u8 << b->data.u64);
case TAG_UW:
- return tag_init_u8(dest, a->data.u8 % b->data.uw);
- default:
- goto ko;
+ return tag_init_u8(result, a->data.u8 << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
}
case TAG_U16:
switch (b->type) {
- case TAG_F32:
- return tag_init_f32(dest, fmodf((f32) a->data.u16, b->data.f32));
- case TAG_F64:
- return tag_init_f64(dest, fmod((f64) a->data.u16, b->data.f64));
+ case TAG_BOOL:
+ return tag_init_u16(result, a->data.u16 <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u16(result, a->data.u16 << b->data.character);
case TAG_INTEGER:
- integer_init_s16(&tmp, a->data.u16);
- dest->type = TAG_INTEGER;
- integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_u16(&tmp, a->data.u16);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_u16(result, integer_to_u16(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_u8(dest, a->data.u16 % b->data.s8);
- case TAG_S16:
- return tag_init_u16(dest, a->data.u16 % b->data.s16);
- case TAG_S32:
- return tag_init_u16(dest, a->data.u16 % b->data.s32);
- case TAG_S64:
- return tag_init_u16(dest, a->data.u16 % b->data.s64);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_u16(dest, a->data.u16 % b->data.sw);
+ return tag_init_u16(result, a->data.u16 << b->data.sw);
+ case TAG_S64:
+ return tag_init_u16(result, a->data.u16 << b->data.s64);
+ case TAG_S32:
+ return tag_init_u16(result, a->data.u16 << b->data.s32);
+ case TAG_S16:
+ return tag_init_u16(result, a->data.u16 << b->data.s16);
+ case TAG_S8:
+ return tag_init_u16(result, a->data.u16 << b->data.s8);
case TAG_U8:
- return tag_init_u8(dest, a->data.u16 % b->data.u8);
+ return tag_init_u16(result, a->data.u16 << b->data.u8);
case TAG_U16:
- return tag_init_u16(dest, a->data.u16 % b->data.u16);
+ return tag_init_u16(result, a->data.u16 << b->data.u16);
case TAG_U32:
- return tag_init_u16(dest, a->data.u16 % b->data.u32);
+ return tag_init_u16(result, a->data.u16 << b->data.u32);
case TAG_U64:
- return tag_init_u16(dest, a->data.u16 % b->data.u64);
+ return tag_init_u16(result, a->data.u16 << b->data.u64);
case TAG_UW:
- return tag_init_u16(dest, a->data.u16 % b->data.uw);
- default:
- goto ko;
- }
- case TAG_U32:
- switch (b->type) {
+ return tag_init_u16(result, a->data.u16 << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f64(dest, fmod((f64) a->data.u32, b->data.f32));
case TAG_F64:
- return tag_init_f64(dest, fmod((f64) a->data.u32, b->data.f64));
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_U32:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_u32(result, a->data.u32 <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u32(result, a->data.u32 << b->data.character);
case TAG_INTEGER:
- integer_init_s32(&tmp, a->data.u32);
- dest->type = TAG_INTEGER;
- integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_u32(&tmp, a->data.u32);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_u32(result, integer_to_u32(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_u8(dest, a->data.u32 % b->data.s8);
- case TAG_S16:
- return tag_init_u16(dest, a->data.u32 % b->data.s16);
- case TAG_S32:
- return tag_init_u32(dest, a->data.u32 % b->data.s32);
- case TAG_S64:
- return tag_init_u32(dest, a->data.u32 % b->data.s64);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_u32(dest, a->data.u32 % b->data.sw);
+ return tag_init_u32(result, a->data.u32 << b->data.sw);
+ case TAG_S64:
+ return tag_init_u32(result, a->data.u32 << b->data.s64);
+ case TAG_S32:
+ return tag_init_u32(result, a->data.u32 << b->data.s32);
+ case TAG_S16:
+ return tag_init_u32(result, a->data.u32 << b->data.s16);
+ case TAG_S8:
+ return tag_init_u32(result, a->data.u32 << b->data.s8);
case TAG_U8:
- return tag_init_u8(dest, a->data.u32 % b->data.u8);
+ return tag_init_u32(result, a->data.u32 << b->data.u8);
case TAG_U16:
- return tag_init_u16(dest, a->data.u32 % b->data.u16);
+ return tag_init_u32(result, a->data.u32 << b->data.u16);
case TAG_U32:
- return tag_init_u32(dest, a->data.u32 % b->data.u32);
+ return tag_init_u32(result, a->data.u32 << b->data.u32);
case TAG_U64:
- return tag_init_u32(dest, a->data.u32 % b->data.u64);
+ return tag_init_u32(result, a->data.u32 << b->data.u64);
case TAG_UW:
- return tag_init_u32(dest, a->data.u32 % b->data.uw);
- default:
- goto ko;
+ return tag_init_u32(result, a->data.u32 << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
}
case TAG_U64:
switch (b->type) {
- case TAG_F32:
- return tag_init_f64(dest, fmod((f64) a->data.u64, b->data.f32));
- case TAG_F64:
- return tag_init_f64(dest, fmod((f64) a->data.u64, b->data.f64));
+ case TAG_BOOL:
+ return tag_init_u64(result, a->data.u64 <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u64(result, a->data.u64 << b->data.character);
case TAG_INTEGER:
- integer_init_s64(&tmp, a->data.u64);
- dest->type = TAG_INTEGER;
- integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_u64(&tmp, a->data.u64);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_u64(result, integer_to_u64(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_u8(dest, a->data.u64 % b->data.s8);
- case TAG_S16:
- return tag_init_u16(dest, a->data.u64 % b->data.s16);
- case TAG_S32:
- return tag_init_u32(dest, a->data.u64 % b->data.s32);
- case TAG_S64:
- return tag_init_u64(dest, a->data.u64 % b->data.s64);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_uw(dest, a->data.u64 % b->data.sw);
+ return tag_init_u64(result, a->data.u64 << b->data.sw);
+ case TAG_S64:
+ return tag_init_u64(result, a->data.u64 << b->data.s64);
+ case TAG_S32:
+ return tag_init_u64(result, a->data.u64 << b->data.s32);
+ case TAG_S16:
+ return tag_init_u64(result, a->data.u64 << b->data.s16);
+ case TAG_S8:
+ return tag_init_u64(result, a->data.u64 << b->data.s8);
case TAG_U8:
- return tag_init_u8(dest, a->data.u64 % b->data.u8);
+ return tag_init_u64(result, a->data.u64 << b->data.u8);
case TAG_U16:
- return tag_init_u16(dest, a->data.u64 % b->data.u16);
+ return tag_init_u64(result, a->data.u64 << b->data.u16);
case TAG_U32:
- return tag_init_u32(dest, a->data.u64 % b->data.u32);
+ return tag_init_u64(result, a->data.u64 << b->data.u32);
case TAG_U64:
- return tag_init_u64(dest, a->data.u64 % b->data.u64);
+ return tag_init_u64(result, a->data.u64 << b->data.u64);
case TAG_UW:
- return tag_init_uw(dest, a->data.u64 % b->data.uw);
- default:
- goto ko;
+ return tag_init_u64(result, a->data.u64 << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
}
case TAG_UW:
switch (b->type) {
- case TAG_F32:
- return tag_init_f64(dest, fmod((f64) a->data.uw, b->data.f32));
- case TAG_F64:
- return tag_init_f64(dest, fmod((f64) a->data.uw, b->data.f64));
+ case TAG_BOOL:
+ return tag_init_uw(result, a->data.uw <<
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_uw(result, a->data.uw << b->data.character);
case TAG_INTEGER:
- integer_init_sw(&tmp, a->data.uw);
- dest->type = TAG_INTEGER;
- integer_mod(&tmp, &b->data.integer, &dest->data.integer);
+ integer_init_uw(&tmp, a->data.uw);
+ integer_lshift(&tmp, integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_uw(result, integer_to_uw(&tmp2));
integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_u8(dest, a->data.uw % b->data.s8);
- case TAG_S16:
- return tag_init_u16(dest, a->data.uw % b->data.s16);
- case TAG_S32:
- return tag_init_u32(dest, a->data.uw % b->data.s32);
- case TAG_S64:
- return tag_init_uw(dest, a->data.uw % b->data.s64);
+ integer_clean(&tmp2);
+ return result;
case TAG_SW:
- return tag_init_uw(dest, a->data.uw % b->data.sw);
+ return tag_init_uw(result, a->data.uw << b->data.sw);
+ case TAG_S64:
+ return tag_init_uw(result, a->data.uw << b->data.s64);
+ case TAG_S32:
+ return tag_init_uw(result, a->data.uw << b->data.s32);
+ case TAG_S16:
+ return tag_init_uw(result, a->data.uw << b->data.s16);
+ case TAG_S8:
+ return tag_init_uw(result, a->data.uw << b->data.s8);
case TAG_U8:
- return tag_init_u8(dest, a->data.uw % b->data.u8);
+ return tag_init_uw(result, a->data.uw << b->data.u8);
case TAG_U16:
- return tag_init_u16(dest, a->data.uw % b->data.u16);
+ return tag_init_uw(result, a->data.uw << b->data.u16);
case TAG_U32:
- return tag_init_u32(dest, a->data.uw % b->data.u32);
+ return tag_init_uw(result, a->data.uw << b->data.u32);
case TAG_U64:
- return tag_init_uw(dest, a->data.uw % b->data.u64);
+ return tag_init_uw(result, a->data.uw << b->data.u64);
case TAG_UW:
- return tag_init_uw(dest, a->data.uw % b->data.uw);
- default:
- goto ko;
+ return tag_init_uw(result, a->data.uw << b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
}
- default:
- goto ko;
- }
- ko:
- errx(1, "cannot divide %s by %s",
- tag_type_to_string(a->type),
- tag_type_to_string(b->type));
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ error:
+ warnx("tag_shift_left: invalid tag type: %s << %s",
+ tag_type_to_string(a->type),
+ tag_type_to_string(b->type));
+ return NULL;
}
-s_tag * tag_mul (const s_tag *a, const s_tag *b, s_tag *dest)
+s_tag * tag_shift_right (const s_tag *a, const s_tag *b, s_tag *result)
{
s_integer tmp;
s_integer tmp2;
- assert(a);
- assert(b);
- assert(dest);
+ s_tag tmp_a;
switch (a->type) {
- case TAG_F32:
+ case TAG_BOOL:
+ tmp_a.data.bool = a->data.bool ? 1 : 0;
switch (b->type) {
- case TAG_F32:
- return tag_init_f32(dest, a->data.f32 * b->data.f32);
- case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.f32 * b->data.f64);
+ case TAG_BOOL:
+ return tag_init_bool(result, tmp_a.data.bool >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_bool(result, tmp_a.data.bool >> b->data.character);
case TAG_INTEGER:
- return tag_init_f32(dest, a->data.f32 *
- integer_to_f32(&b->data.integer));
- case TAG_S8:
- return tag_init_f32(dest, a->data.f32 * (f32) b->data.s8);
- case TAG_S16:
- return tag_init_f32(dest, a->data.f32 * (f32) b->data.s16);
- case TAG_S32:
- return tag_init_f32(dest, a->data.f32 * (f32) b->data.s32);
+ integer_init_u8(&tmp, tmp_a.data.bool);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_bool(result, integer_to_u8(&tmp2));
+ integer_clean(&tmp);
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_bool(result, tmp_a.data.bool >> b->data.sw);
case TAG_S64:
- return tag_init_f32(dest, a->data.f32 * (f32) b->data.s64);
- case TAG_U8:
- return tag_init_f32(dest, a->data.f32 * (f32) b->data.u8);
- case TAG_U16:
- return tag_init_f32(dest, a->data.f32 * (f32) b->data.u16);
- case TAG_U32:
- return tag_init_f32(dest, a->data.f32 * (f32) b->data.u32);
- case TAG_U64:
- return tag_init_f32(dest, a->data.f32 * (f32) b->data.u64);
- default:
- goto ko;
- }
- case TAG_F64:
- switch (b->type) {
- case TAG_F32:
- return tag_init_f64(dest, a->data.f64 * (f64) b->data.f32);
- case TAG_F64:
- return tag_init_f64(dest, a->data.f64 * b->data.f64);
- case TAG_INTEGER:
- return tag_init_f64(dest, a->data.f64 *
- integer_to_f64(&b->data.integer));
- case TAG_S8:
- return tag_init_f64(dest, a->data.f64 * (f64) b->data.s8);
- case TAG_S16:
- return tag_init_f64(dest, a->data.f64 * (f64) b->data.s16);
+ return tag_init_bool(result, tmp_a.data.bool >> b->data.s64);
case TAG_S32:
- return tag_init_f64(dest, a->data.f64 * (f64) b->data.s32);
- case TAG_S64:
- return tag_init_f64(dest, a->data.f64 * (f64) b->data.s64);
+ return tag_init_bool(result, tmp_a.data.bool >> b->data.s32);
+ case TAG_S16:
+ return tag_init_bool(result, tmp_a.data.bool >> b->data.s16);
+ case TAG_S8:
+ return tag_init_bool(result, tmp_a.data.bool >> b->data.s8);
case TAG_U8:
- return tag_init_f64(dest, a->data.f64 * (f64) b->data.u8);
+ return tag_init_bool(result, tmp_a.data.bool >> b->data.u8);
case TAG_U16:
- return tag_init_f64(dest, a->data.f64 * (f64) b->data.u16);
+ return tag_init_bool(result, tmp_a.data.bool >> b->data.u16);
case TAG_U32:
- return tag_init_f64(dest, a->data.f64 * (f64) b->data.u32);
+ return tag_init_bool(result, tmp_a.data.bool >> b->data.u32);
case TAG_U64:
- return tag_init_f64(dest, a->data.f64 * (f64) b->data.u64);
- default:
- goto ko;
- }
- case TAG_INTEGER:
- switch (b->type) {
+ return tag_init_bool(result, tmp_a.data.bool >> b->data.u64);
+ case TAG_UW:
+ return tag_init_bool(result, tmp_a.data.bool >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, integer_to_f32(&a->data.integer) *
- b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, integer_to_f64(&a->data.integer) *
- b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_CHARACTER:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_character(result, a->data.character >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_character(result, a->data.character >> b->data.character);
case TAG_INTEGER:
- dest->type = TAG_INTEGER;
- integer_mul(&a->data.integer, &b->data.integer,
- &dest->data.integer);
- return dest;
- case TAG_S8:
- integer_init_s8(&tmp, b->data.s8);
- dest->type = TAG_INTEGER;
- integer_mul(&a->data.integer, &tmp, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- case TAG_S16:
- integer_init_s16(&tmp, b->data.s16);
- dest->type = TAG_INTEGER;
- integer_mul(&a->data.integer, &tmp, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- case TAG_S32:
- integer_init_s32(&tmp, b->data.s32);
- dest->type = TAG_INTEGER;
- integer_mul(&a->data.integer, &tmp, &dest->data.integer);
+ integer_init_u32(&tmp, a->data.character);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_character(result, integer_to_u32(&tmp2));
integer_clean(&tmp);
- return dest;
+ integer_clean(&tmp2);
+ return result;
+ case TAG_SW:
+ return tag_init_character(result, a->data.character >> b->data.sw);
case TAG_S64:
- integer_init_s64(&tmp, b->data.s64);
- dest->type = TAG_INTEGER;
- integer_mul(&a->data.integer, &tmp, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
+ return tag_init_character(result, a->data.character >> b->data.s64);
+ case TAG_S32:
+ return tag_init_character(result, a->data.character >> b->data.s32);
+ case TAG_S16:
+ return tag_init_character(result, a->data.character >> b->data.s16);
+ case TAG_S8:
+ return tag_init_character(result, a->data.character >> b->data.s8);
case TAG_U8:
- integer_init_u8(&tmp, b->data.u8);
- dest->type = TAG_INTEGER;
- integer_mul(&a->data.integer, &tmp, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
+ return tag_init_character(result, a->data.character >> b->data.u8);
case TAG_U16:
- integer_init_u16(&tmp, b->data.u16);
- dest->type = TAG_INTEGER;
- integer_mul(&a->data.integer, &tmp, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
+ return tag_init_character(result, a->data.character >> b->data.u16);
case TAG_U32:
- integer_init_u32(&tmp, b->data.u32);
- dest->type = TAG_INTEGER;
- integer_mul(&a->data.integer, &tmp, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
+ return tag_init_character(result, a->data.character >> b->data.u32);
case TAG_U64:
- integer_init_u64(&tmp, b->data.u64);
- dest->type = TAG_INTEGER;
- integer_mul(&a->data.integer, &tmp, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- default:
- goto ko;
- }
- case TAG_S8:
- switch (b->type) {
+ return tag_init_character(result, a->data.character >> b->data.u64);
+ case TAG_UW:
+ return tag_init_character(result, a->data.character >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.s8 * b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.s8 * b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_INTEGER:
+ switch (b->type) {
+ case TAG_BOOL:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, b->data.bool ? -1 : 0,
+ &result->data.integer);
+ return result;
+ case TAG_CHARACTER:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -b->data.character,
+ &result->data.integer);
+ return result;
case TAG_INTEGER:
- integer_init_s8(&tmp, a->data.s8);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &b->data.integer, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s16(dest, (s16) a->data.s8 * (s16) b->data.s8);
- case TAG_S16:
- return tag_init_s32(dest, (s32) a->data.s8 * (s32) b->data.s16);
- case TAG_S32:
- return tag_init_s64(dest, (s64) a->data.s8 * (s64) b->data.s32);
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -integer_to_sw(&b->data.integer),
+ &result->data.integer);
+ return result;
+ case TAG_SW:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -b->data.sw,
+ &result->data.integer);
+ return result;
case TAG_S64:
- integer_init_s8(&tmp, a->data.s8);
- integer_init_s64(&tmp2, b->data.s64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -b->data.s64, &result->data.integer);
+ return result;
+ case TAG_S32:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -b->data.s32, &result->data.integer);
+ return result;
+ case TAG_S16:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -b->data.s16, &result->data.integer);
+ return result;
+ case TAG_S8:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -b->data.s8, &result->data.integer);
+ return result;
case TAG_U8:
- return tag_init_s16(dest, (s16) a->data.s8 * (s16) b->data.u8);
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -b->data.u8, &result->data.integer);
+ return result;
case TAG_U16:
- return tag_init_s32(dest, (s32) a->data.s8 * (s32) b->data.u16);
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -b->data.u16, &result->data.integer);
+ return result;
case TAG_U32:
- return tag_init_s64(dest, (s64) a->data.s8 * (s64) b->data.u32);
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -b->data.u32, &result->data.integer);
+ return result;
case TAG_U64:
- integer_init_s8(&tmp, a->data.s8);
- integer_init_u64(&tmp2, b->data.u64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- default:
- goto ko;
- }
- case TAG_S16:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -b->data.u64, &result->data.integer);
+ return result;
+ case TAG_UW:
+ result->type = TAG_INTEGER;
+ integer_lshift(&a->data.integer, -b->data.uw, &result->data.integer);
+ return result;
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_SW:
switch (b->type) {
- case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.s16 * b->data.f32);
- case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.s16 * b->data.f64);
+ case TAG_BOOL:
+ return tag_init_sw(result, a->data.sw >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_sw(result, a->data.sw >> b->data.character);
case TAG_INTEGER:
- integer_init_s16(&tmp, a->data.s16);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &b->data.integer, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s32(dest, (s32) a->data.s16 * (s32) b->data.s8);
- case TAG_S16:
- return tag_init_s32(dest, (s32) a->data.s16 * (s32) b->data.s16);
- case TAG_S32:
- return tag_init_s64(dest, (s64) a->data.s16 * (s64) b->data.s32);
- case TAG_S64:
- integer_init_s16(&tmp, a->data.s16);
- integer_init_s64(&tmp2, b->data.s64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_init_sw(&tmp, a->data.sw);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_sw(result, integer_to_sw(&tmp2));
integer_clean(&tmp);
integer_clean(&tmp2);
- return dest;
+ return result;
+ case TAG_SW:
+ return tag_init_sw(result, a->data.sw >> b->data.sw);
+ case TAG_S64:
+ return tag_init_sw(result, a->data.sw >> b->data.s64);
+ case TAG_S32:
+ return tag_init_sw(result, a->data.sw >> b->data.s32);
+ case TAG_S16:
+ return tag_init_sw(result, a->data.sw >> b->data.s16);
+ case TAG_S8:
+ return tag_init_sw(result, a->data.sw >> b->data.s8);
case TAG_U8:
- return tag_init_s32(dest, (s32) a->data.s16 * (s32) b->data.u8);
+ return tag_init_sw(result, a->data.sw >> b->data.u8);
case TAG_U16:
- return tag_init_s32(dest, (s32) a->data.s16 * (s32) b->data.u16);
+ return tag_init_sw(result, a->data.sw >> b->data.u16);
case TAG_U32:
- return tag_init_s64(dest, (s64) a->data.s16 * (s64) b->data.u32);
+ return tag_init_sw(result, a->data.sw >> b->data.u32);
case TAG_U64:
- integer_init_s16(&tmp, a->data.s16);
- integer_init_u64(&tmp2, b->data.u64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- default:
- goto ko;
- }
- case TAG_S32:
- switch (b->type) {
+ return tag_init_sw(result, a->data.sw >> b->data.u64);
+ case TAG_UW:
+ return tag_init_sw(result, a->data.sw >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.s32 * b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.s32 * b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_S64:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_s64(result, a->data.s64 >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s64(result, a->data.s64 >> b->data.character);
case TAG_INTEGER:
- integer_init_s32(&tmp, a->data.s32);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &b->data.integer, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.s8);
- case TAG_S16:
- return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.s16);
- case TAG_S32:
- return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.s32);
- case TAG_S64:
- integer_init_s32(&tmp, a->data.s32);
- integer_init_s64(&tmp2, b->data.s64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_init_s64(&tmp, a->data.s64);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_s64(result, integer_to_s64(&tmp2));
integer_clean(&tmp);
integer_clean(&tmp2);
- return dest;
+ return result;
+ case TAG_SW:
+ return tag_init_s64(result, a->data.s64 >> b->data.sw);
+ case TAG_S64:
+ return tag_init_s64(result, a->data.s64 >> b->data.s64);
+ case TAG_S32:
+ return tag_init_s64(result, a->data.s64 >> b->data.s32);
+ case TAG_S16:
+ return tag_init_s64(result, a->data.s64 >> b->data.s16);
+ case TAG_S8:
+ return tag_init_s64(result, a->data.s64 >> b->data.s8);
case TAG_U8:
- return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.u8);
+ return tag_init_s64(result, a->data.s64 >> b->data.u8);
case TAG_U16:
- return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.u16);
+ return tag_init_s64(result, a->data.s64 >> b->data.u16);
case TAG_U32:
- return tag_init_s64(dest, (s64) a->data.s32 * (s64) b->data.u32);
+ return tag_init_s64(result, a->data.s64 >> b->data.u32);
case TAG_U64:
- integer_init_s32(&tmp, a->data.s32);
- integer_init_u64(&tmp2, b->data.u64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- default:
- goto ko;
- }
- case TAG_S64:
- switch (b->type) {
+ return tag_init_s64(result, a->data.s64 >> b->data.u64);
+ case TAG_UW:
+ return tag_init_s64(result, a->data.s64 >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.s64 * b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.s64 * b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_S32:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_s32(result, a->data.s32 >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s32(result, a->data.s32 >> b->data.character);
case TAG_INTEGER:
- integer_init_s64(&tmp, a->data.s64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &b->data.integer, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- case TAG_S8:
- integer_init_s64(&tmp, a->data.s64);
- integer_init_s8(&tmp2, b->data.s8);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- case TAG_S16:
- integer_init_s64(&tmp, a->data.s64);
- integer_init_s16(&tmp2, b->data.s16);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- case TAG_S32:
- integer_init_s64(&tmp, a->data.s64);
- integer_init_s32(&tmp2, b->data.s32);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_init_s32(&tmp, a->data.s32);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_s32(result, integer_to_s32(&tmp2));
integer_clean(&tmp);
integer_clean(&tmp2);
- return dest;
+ return result;
+ case TAG_SW:
+ return tag_init_s32(result, a->data.s32 >> b->data.sw);
case TAG_S64:
- integer_init_s64(&tmp, a->data.s64);
- integer_init_s64(&tmp2, b->data.s64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ return tag_init_s32(result, a->data.s32 >> b->data.s64);
+ case TAG_S32:
+ return tag_init_s32(result, a->data.s32 >> b->data.s32);
+ case TAG_S16:
+ return tag_init_s32(result, a->data.s32 >> b->data.s16);
+ case TAG_S8:
+ return tag_init_s32(result, a->data.s32 >> b->data.s8);
case TAG_U8:
- integer_init_s64(&tmp, a->data.s64);
- integer_init_u8(&tmp2, b->data.u8);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ return tag_init_s32(result, a->data.s32 >> b->data.u8);
case TAG_U16:
- integer_init_s64(&tmp, a->data.s64);
- integer_init_u16(&tmp2, b->data.u16);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ return tag_init_s32(result, a->data.s32 >> b->data.u16);
case TAG_U32:
- integer_init_s64(&tmp, a->data.s64);
- integer_init_u32(&tmp2, b->data.u32);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ return tag_init_s32(result, a->data.s32 >> b->data.u32);
case TAG_U64:
- integer_init_s64(&tmp, a->data.s64);
- integer_init_u64(&tmp2, b->data.u64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- default:
- goto ko;
- }
- case TAG_U8:
- switch (b->type) {
+ return tag_init_s32(result, a->data.s32 >> b->data.u64);
+ case TAG_UW:
+ return tag_init_s32(result, a->data.s32 >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.u8 * b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.u8 * b->data.f64);
- case TAG_INTEGER:
- integer_init_u8(&tmp, a->data.u8);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &b->data.integer, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s16(dest, (s16) a->data.u8 * (s16) b->data.s8);
- case TAG_S16:
- return tag_init_s32(dest, (s32) a->data.u8 * (s32) b->data.s16);
- case TAG_S32:
- return tag_init_s64(dest, (s32) a->data.u8 * (s64) b->data.s32);
- case TAG_S64:
- integer_init_u8(&tmp, a->data.u8);
- integer_init_s64(&tmp2, b->data.s64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_S16:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_s16(result, a->data.s16 >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s16(result, a->data.s16 >> b->data.character);
+ case TAG_INTEGER:
+ integer_init_s16(&tmp, a->data.s16);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_s16(result, integer_to_s16(&tmp2));
integer_clean(&tmp);
integer_clean(&tmp2);
- return dest;
+ return result;
+ case TAG_SW:
+ return tag_init_s16(result, a->data.s16 >> b->data.sw);
+ case TAG_S64:
+ return tag_init_s16(result, a->data.s16 >> b->data.s64);
+ case TAG_S32:
+ return tag_init_s16(result, a->data.s16 >> b->data.s32);
+ case TAG_S16:
+ return tag_init_s16(result, a->data.s16 >> b->data.s16);
+ case TAG_S8:
+ return tag_init_s16(result, a->data.s16 >> b->data.s8);
case TAG_U8:
- return tag_init_u16(dest, (u16) a->data.u8 * (u16) b->data.u8);
+ return tag_init_s16(result, a->data.s16 >> b->data.u8);
case TAG_U16:
- return tag_init_u32(dest, (u32) a->data.u8 * (u32) b->data.u16);
+ return tag_init_s16(result, a->data.s16 >> b->data.u16);
case TAG_U32:
- return tag_init_u64(dest, (u64) a->data.u8 * (u64) b->data.u32);
+ return tag_init_s16(result, a->data.s16 >> b->data.u32);
case TAG_U64:
- integer_init_u8(&tmp, a->data.u8);
- integer_init_u64(&tmp2, b->data.u64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- default:
- goto ko;
- }
- case TAG_U16:
- switch (b->type) {
+ return tag_init_s16(result, a->data.s16 >> b->data.u64);
+ case TAG_UW:
+ return tag_init_s16(result, a->data.s16 >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.u16 * b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.u16 * b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_S8:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_s8(result, a->data.s8 >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_s8(result, a->data.s8 >> b->data.character);
case TAG_INTEGER:
- integer_init_u16(&tmp, a->data.u16);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &b->data.integer, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s32(dest, (s32) a->data.u16 * (s32) b->data.s8);
- case TAG_S16:
- return tag_init_s32(dest, (s32) a->data.u16 * (s32) b->data.s16);
- case TAG_S32:
- return tag_init_s64(dest, (s64) a->data.u16 * (s64) b->data.s32);
- case TAG_S64:
- integer_init_u16(&tmp, a->data.u16);
- integer_init_s64(&tmp2, b->data.s64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_init_s8(&tmp, a->data.s8);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_s8(result, integer_to_s8(&tmp2));
integer_clean(&tmp);
integer_clean(&tmp2);
- return dest;
+ return result;
+ case TAG_SW:
+ return tag_init_s8(result, a->data.s8 >> b->data.sw);
+ case TAG_S64:
+ return tag_init_s8(result, a->data.s8 >> b->data.s64);
+ case TAG_S32:
+ return tag_init_s8(result, a->data.s8 >> b->data.s32);
+ case TAG_S16:
+ return tag_init_s8(result, a->data.s8 >> b->data.s16);
+ case TAG_S8:
+ return tag_init_s8(result, a->data.s8 >> b->data.s8);
case TAG_U8:
- return tag_init_u32(dest, (u32) a->data.u16 * (u32) b->data.u8);
+ return tag_init_s8(result, a->data.s8 >> b->data.u8);
case TAG_U16:
- return tag_init_u32(dest, (u32) a->data.u16 * (u32) b->data.u16);
+ return tag_init_s8(result, a->data.s8 >> b->data.u16);
case TAG_U32:
- return tag_init_u64(dest, (u64) a->data.u16 * (u64) b->data.u32);
+ return tag_init_s8(result, a->data.s8 >> b->data.u32);
case TAG_U64:
- integer_init_u16(&tmp, a->data.u16);
- integer_init_u64(&tmp2, b->data.u64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- default:
- goto ko;
- }
- case TAG_U32:
- switch (b->type) {
+ return tag_init_s8(result, a->data.s8 >> b->data.u64);
+ case TAG_UW:
+ return tag_init_s8(result, a->data.s8 >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.u32 * b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.u32 * b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_U8:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_u8(result, a->data.u8 >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u8(result, a->data.u8 >> b->data.character);
case TAG_INTEGER:
- integer_init_u32(&tmp, a->data.u32);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &b->data.integer, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- case TAG_S8:
- return tag_init_s64(dest, (s64) a->data.u32 * (s64) b->data.s8);
- case TAG_S16:
- return tag_init_s64(dest, (s64) a->data.u32 * (s64) b->data.s16);
- case TAG_S32:
- return tag_init_s64(dest, (s64) a->data.u32 * b->data.s32);
- case TAG_S64:
- integer_init_u32(&tmp, a->data.u32);
- integer_init_s64(&tmp2, b->data.s64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_init_u8(&tmp, a->data.u8);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_u8(result, integer_to_u8(&tmp2));
integer_clean(&tmp);
integer_clean(&tmp2);
- return dest;
+ return result;
+ case TAG_SW:
+ return tag_init_u8(result, a->data.u8 >> b->data.sw);
+ case TAG_S64:
+ return tag_init_u8(result, a->data.u8 >> b->data.s64);
+ case TAG_S32:
+ return tag_init_u8(result, a->data.u8 >> b->data.s32);
+ case TAG_S16:
+ return tag_init_u8(result, a->data.u8 >> b->data.s16);
+ case TAG_S8:
+ return tag_init_u8(result, a->data.u8 >> b->data.s8);
case TAG_U8:
- return tag_init_u64(dest, (u64) a->data.u32 * (u64) b->data.u8);
+ return tag_init_u8(result, a->data.u8 >> b->data.u8);
case TAG_U16:
- return tag_init_u64(dest, (u64) a->data.u32 * (u64) b->data.u16);
+ return tag_init_u8(result, a->data.u8 >> b->data.u16);
case TAG_U32:
- return tag_init_u64(dest, (u64) a->data.u32 * (u64) b->data.u32);
+ return tag_init_u8(result, a->data.u8 >> b->data.u32);
case TAG_U64:
- integer_init_u32(&tmp, a->data.u32);
- integer_init_u64(&tmp2, b->data.u64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- default:
- goto ko;
- }
- case TAG_U64:
- switch (b->type) {
+ return tag_init_u8(result, a->data.u8 >> b->data.u64);
+ case TAG_UW:
+ return tag_init_u8(result, a->data.u8 >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
case TAG_F32:
- return tag_init_f32(dest, (f32) a->data.u64 * b->data.f32);
case TAG_F64:
- return tag_init_f64(dest, (f64) a->data.u64 * b->data.f64);
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_U16:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_u16(result, a->data.u16 >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u16(result, a->data.u16 >> b->data.character);
case TAG_INTEGER:
- integer_init_u64(&tmp, a->data.u64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &b->data.integer, &dest->data.integer);
- integer_clean(&tmp);
- return dest;
- case TAG_S8:
- integer_init_u64(&tmp, a->data.u64);
- integer_init_s8(&tmp2, b->data.s8);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- case TAG_S16:
- integer_init_u64(&tmp, a->data.u64);
- integer_init_s16(&tmp2, b->data.s16);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
- case TAG_S32:
- integer_init_u64(&tmp, a->data.u64);
- integer_init_s32(&tmp2, b->data.s32);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_init_u16(&tmp, a->data.u16);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_u16(result, integer_to_u16(&tmp2));
integer_clean(&tmp);
integer_clean(&tmp2);
- return dest;
+ return result;
+ case TAG_SW:
+ return tag_init_u16(result, a->data.u16 >> b->data.sw);
case TAG_S64:
- integer_init_u64(&tmp, a->data.u64);
- integer_init_s64(&tmp2, b->data.s64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ return tag_init_u16(result, a->data.u16 >> b->data.s64);
+ case TAG_S32:
+ return tag_init_u16(result, a->data.u16 >> b->data.s32);
+ case TAG_S16:
+ return tag_init_u16(result, a->data.u16 >> b->data.s16);
+ case TAG_S8:
+ return tag_init_u16(result, a->data.u16 >> b->data.s8);
case TAG_U8:
- integer_init_u64(&tmp, a->data.u64);
- integer_init_u8(&tmp2, b->data.u8);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ return tag_init_u16(result, a->data.u16 >> b->data.u8);
case TAG_U16:
- integer_init_u64(&tmp, a->data.u64);
- integer_init_u16(&tmp2, b->data.u16);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
+ return tag_init_u16(result, a->data.u16 >> b->data.u16);
+ case TAG_U32:
+ return tag_init_u16(result, a->data.u16 >> b->data.u32);
+ case TAG_U64:
+ return tag_init_u16(result, a->data.u16 >> b->data.u64);
+ case TAG_UW:
+ return tag_init_u16(result, a->data.u16 >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_U32:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_u32(result, a->data.u32 >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u32(result, a->data.u32 >> b->data.character);
+ case TAG_INTEGER:
+ integer_init_u32(&tmp, a->data.u32);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_u32(result, integer_to_u32(&tmp2));
integer_clean(&tmp);
integer_clean(&tmp2);
- return dest;
+ return result;
+ case TAG_SW:
+ return tag_init_u32(result, a->data.u32 >> b->data.sw);
+ case TAG_S64:
+ return tag_init_u32(result, a->data.u32 >> b->data.s64);
+ case TAG_S32:
+ return tag_init_u32(result, a->data.u32 >> b->data.s32);
+ case TAG_S16:
+ return tag_init_u32(result, a->data.u32 >> b->data.s16);
+ case TAG_S8:
+ return tag_init_u32(result, a->data.u32 >> b->data.s8);
+ case TAG_U8:
+ return tag_init_u32(result, a->data.u32 >> b->data.u8);
+ case TAG_U16:
+ return tag_init_u32(result, a->data.u32 >> b->data.u16);
case TAG_U32:
- integer_init_u64(&tmp, a->data.u64);
- integer_init_u32(&tmp2, b->data.u32);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
- integer_clean(&tmp);
- integer_clean(&tmp2);
- return dest;
+ return tag_init_u32(result, a->data.u32 >> b->data.u32);
case TAG_U64:
+ return tag_init_u32(result, a->data.u32 >> b->data.u64);
+ case TAG_UW:
+ return tag_init_u32(result, a->data.u32 >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
+ }
+ case TAG_U64:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_u64(result, a->data.u64 >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u64(result, a->data.u64 >> b->data.character);
+ case TAG_INTEGER:
integer_init_u64(&tmp, a->data.u64);
- integer_init_u64(&tmp2, b->data.u64);
- dest->type = TAG_INTEGER;
- integer_mul(&tmp, &tmp2, &dest->data.integer);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_u64(result, integer_to_u64(&tmp2));
integer_clean(&tmp);
integer_clean(&tmp2);
- return dest;
- default:
- goto ko;
- }
- default:
- goto ko;
- }
- ko:
- errx(1, "cannot multiply %s by %s",
- tag_type_to_string(a->type),
- tag_type_to_string(b->type));
-}
-
-s_tag * tag_neg (const s_tag *tag, s_tag *result)
-{
- s_integer tmp;
- switch (tag->type) {
- case TAG_BOOL:
- return tag_init_s8(result, -(tag->data.bool ? 1 : 0));
- case TAG_CHARACTER:
- return tag_init_s64(result, -tag->data.character);
- case TAG_INTEGER:
- tag_init_integer_zero(result);
- integer_neg(&tag->data.integer, &result->data.integer);
- return result;
- case TAG_SW:
- if (tag->data.sw == SW_MIN) {
- integer_init_sw(&tmp, tag->data.sw);
- result->type = TAG_INTEGER;
- integer_neg(&tmp, &result->data.integer);
- integer_clean(&tmp);
return result;
+ case TAG_SW:
+ return tag_init_u64(result, a->data.u64 >> b->data.sw);
+ case TAG_S64:
+ return tag_init_u64(result, a->data.u64 >> b->data.s64);
+ case TAG_S32:
+ return tag_init_u64(result, a->data.u64 >> b->data.s32);
+ case TAG_S16:
+ return tag_init_u64(result, a->data.u64 >> b->data.s16);
+ case TAG_S8:
+ return tag_init_u64(result, a->data.u64 >> b->data.s8);
+ case TAG_U8:
+ return tag_init_u64(result, a->data.u64 >> b->data.u8);
+ case TAG_U16:
+ return tag_init_u64(result, a->data.u64 >> b->data.u16);
+ case TAG_U32:
+ return tag_init_u64(result, a->data.u64 >> b->data.u32);
+ case TAG_U64:
+ return tag_init_u64(result, a->data.u64 >> b->data.u64);
+ case TAG_UW:
+ return tag_init_u64(result, a->data.u64 >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
}
- return tag_init_sw(result, -tag->data.sw);
- case TAG_S64:
- if (tag->data.s64 == S64_MIN) {
- integer_init_s64(&tmp, tag->data.s64);
- result->type = TAG_INTEGER;
- integer_neg(&tmp, &result->data.integer);
+ case TAG_UW:
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_uw(result, a->data.uw >>
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_uw(result, a->data.uw >> b->data.character);
+ case TAG_INTEGER:
+ integer_init_uw(&tmp, a->data.uw);
+ integer_lshift(&tmp, -integer_to_sw(&b->data.integer), &tmp2);
+ tag_init_uw(result, integer_to_uw(&tmp2));
integer_clean(&tmp);
+ integer_clean(&tmp2);
return result;
+ case TAG_SW:
+ return tag_init_uw(result, a->data.uw >> b->data.sw);
+ case TAG_S64:
+ return tag_init_uw(result, a->data.uw >> b->data.s64);
+ case TAG_S32:
+ return tag_init_uw(result, a->data.uw >> b->data.s32);
+ case TAG_S16:
+ return tag_init_uw(result, a->data.uw >> b->data.s16);
+ case TAG_S8:
+ return tag_init_uw(result, a->data.uw >> b->data.s8);
+ case TAG_U8:
+ return tag_init_uw(result, a->data.uw >> b->data.u8);
+ case TAG_U16:
+ return tag_init_uw(result, a->data.uw >> b->data.u16);
+ case TAG_U32:
+ return tag_init_uw(result, a->data.uw >> b->data.u32);
+ case TAG_U64:
+ return tag_init_uw(result, a->data.uw >> b->data.u64);
+ case TAG_UW:
+ return tag_init_uw(result, a->data.uw >> b->data.uw);
+ case TAG_VOID:
+ case TAG_ARRAY:
+ case TAG_CALL:
+ case TAG_CFN:
+ case TAG_F32:
+ case TAG_F64:
+ case TAG_FACT:
+ case TAG_FN:
+ case TAG_IDENT:
+ case TAG_LIST:
+ case TAG_PTAG:
+ case TAG_QUOTE:
+ case TAG_STR:
+ case TAG_SYM:
+ case TAG_TUPLE:
+ case TAG_VAR:
+ goto error;
}
- return tag_init_s64(result, -tag->data.s64);
- case TAG_S32:
- return tag_init_s64(result, -tag->data.s32);
- case TAG_S16:
- return tag_init_s32(result, -tag->data.s16);
- case TAG_S8:
- return tag_init_s16(result, -tag->data.s8);
- case TAG_U8:
- return tag_init_s16(result, -tag->data.u8);
- case TAG_U16:
- return tag_init_s32(result, -tag->data.u16);
- case TAG_U32:
- return tag_init_s64(result, -tag->data.u32);
- case TAG_U64:
- integer_init_u64(&tmp, tag->data.u64);
- result->type = TAG_INTEGER;
- integer_neg(&tmp, &result->data.integer);
- return result;
- case TAG_UW:
- integer_init_uw(&tmp, tag->data.uw);
- result->type = TAG_INTEGER;
- integer_neg(&tmp, &result->data.integer);
- return result;
case TAG_VOID:
case TAG_ARRAY:
case TAG_CALL:
@@ -5156,92 +7457,15 @@ s_tag * tag_neg (const s_tag *tag, s_tag *result)
case TAG_SYM:
case TAG_TUPLE:
case TAG_VAR:
- warnx("tag_neg: invalid tag type %s",
- tag_type_to_string(tag->type));
+ goto error;
}
+ error:
+ warnx("tag_shift_right: invalid tag type: %s >> %s",
+ tag_type_to_string(a->type),
+ tag_type_to_string(b->type));
return NULL;
}
-s_tag * tag_new ()
-{
- s_tag *tag;
- tag = calloc(1, sizeof(s_tag));
- return tag;
-}
-
-s_tag * tag_new_1 (const s8 *p)
-{
- s_tag *tag;
- tag = calloc(1, sizeof(s_tag));
- return tag_init_1(tag, p);
-}
-
-s_tag * tag_new_array (const s_array *a)
-{
- s_tag *dest;
- assert(a);
- if (! (dest = malloc(sizeof(s_tag))))
- errx(1, "tag_new_array: out of memory");
- return tag_init_array(dest, a);
-}
-
-s_tag * tag_new_copy (const s_tag *src)
-{
- s_tag *dest;
- if (! (dest = malloc(sizeof(s_tag))))
- errx(1, "tag_new_copy: out of memory");
- return tag_copy(src, dest);
-}
-
-bool tag_not (const s_tag *a)
-{
- s_tag f;
- tag_init_bool(&f, false);
- return compare_tag(a, &f) == 0;
-}
-
-bool tag_or (const s_tag *a, const s_tag *b)
-{
- s_tag f;
- tag_init_bool(&f, false);
- return compare_tag(a, &f) != 0 || compare_tag(b, &f) != 0;
-}
-
-s_tag * tag_paren (const s_tag *tag, s_tag *dest)
-{
- assert(tag);
- assert(dest);
- return tag_copy(tag, dest);
-}
-
-s_tag * tag_s8 (s_tag *tag, s8 x)
-{
- assert(tag);
- tag_clean(tag);
- return tag_init_s8(tag, x);
-}
-
-s_tag * tag_s16 (s_tag *tag, s16 x)
-{
- assert(tag);
- tag_clean(tag);
- return tag_init_s16(tag, x);
-}
-
-s_tag * tag_s32 (s_tag *tag, s32 x)
-{
- assert(tag);
- tag_clean(tag);
- return tag_init_s32(tag, x);
-}
-
-s_tag * tag_s64 (s_tag *tag, s64 x)
-{
- assert(tag);
- tag_clean(tag);
- return tag_init_s64(tag, x);
-}
-
s_tag * tag_sw (s_tag *tag, sw x)
{
assert(tag);