diff --git a/lib/c3/0.1/c3.facts b/lib/c3/0.1/c3.facts
index 50b7dbc..41ff274 100644
--- a/lib/c3/0.1/c3.facts
+++ b/lib/c3/0.1/c3.facts
@@ -5,161 +5,161 @@ replace {C3, :operator, C3.operator00}
replace {C3.operator00, :is_a, :operator}
replace {C3.operator00, :symbol, _"()"}
replace {C3.operator00, :arity, 1}
-replace {C3.operator00, :cfn, cfn :tag "tag_paren" (:tag, :&result)}
+replace {C3.operator00, :cfn, cfn Tag "tag_paren" (Tag, Result)}
replace {C3.operator00, :operator_precedence, 1}
replace {C3.operator00, :operator_associativity, :left}
add {C3, :operator, C3.operator01}
replace {C3.operator01, :is_a, :operator}
replace {C3.operator01, :symbol, _"[]"}
replace {C3.operator01, :arity, 2}
-replace {C3.operator01, :cfn, cfn :tag "tag_brackets" (:tag, :tag, :&result)}
+replace {C3.operator01, :cfn, cfn Tag "tag_brackets" (Tag, Tag, Result)}
replace {C3.operator01, :operator_precedence, 1}
replace {C3.operator01, :operator_associativity, :left}
add {C3, :operator, C3.operator02}
replace {C3.operator02, :is_a, :operator}
replace {C3.operator02, :symbol, !}
replace {C3.operator02, :arity, 1}
-replace {C3.operator02, :cfn, cfn :bool "tag_not" (:tag)}
+replace {C3.operator02, :cfn, cfn :bool "tag_not" (Tag)}
replace {C3.operator02, :operator_precedence, 2}
replace {C3.operator02, :operator_associativity, :right}
add {C3, :operator, C3.operator03}
replace {C3.operator03, :is_a, :operator}
replace {C3.operator03, :symbol, ~}
replace {C3.operator03, :arity, 1}
-replace {C3.operator03, :cfn, cfn :tag "tag_bnot" (:tag, :&result)}
+replace {C3.operator03, :cfn, cfn Tag "tag_bnot" (Tag, Result)}
replace {C3.operator03, :operator_precedence, 2}
replace {C3.operator03, :operator_associativity, :right}
add {C3, :operator, C3.operator04}
replace {C3.operator04, :is_a, :operator}
replace {C3.operator04, :symbol, -}
replace {C3.operator04, :arity, 1}
-replace {C3.operator04, :cfn, cfn :tag "tag_minus" (:tag, :&result)}
+replace {C3.operator04, :cfn, cfn Tag "tag_neg" (Tag, Result)}
replace {C3.operator04, :operator_precedence, 2}
replace {C3.operator04, :operator_associativity, :right}
add {C3, :operator, C3.operator05}
replace {C3.operator05, :is_a, :operator}
replace {C3.operator05, :symbol, *}
replace {C3.operator05, :arity, 2}
-replace {C3.operator05, :cfn, cfn :tag "tag_mul" (:tag, :tag, :&result)}
+replace {C3.operator05, :cfn, cfn Tag "tag_mul" (Tag, Tag, Result)}
replace {C3.operator05, :operator_precedence, 3}
replace {C3.operator05, :operator_associativity, :left}
add {C3, :operator, C3.operator06}
replace {C3.operator06, :is_a, :operator}
replace {C3.operator06, :symbol, /}
replace {C3.operator06, :arity, 2}
-replace {C3.operator06, :cfn, cfn :tag "tag_div" (:tag, :tag, :&result)}
+replace {C3.operator06, :cfn, cfn Tag "tag_div" (Tag, Tag, Result)}
replace {C3.operator06, :operator_precedence, 3}
replace {C3.operator06, :operator_associativity, :left}
add {C3, :operator, C3.operator07}
replace {C3.operator07, :is_a, :operator}
replace {C3.operator07, :symbol, mod}
replace {C3.operator07, :arity, 2}
-replace {C3.operator07, :cfn, cfn :tag "tag_mod" (:tag, :tag, :&result)}
+replace {C3.operator07, :cfn, cfn Tag "tag_mod" (Tag, Tag, Result)}
replace {C3.operator07, :operator_precedence, 3}
replace {C3.operator07, :operator_associativity, :left}
add {C3, :operator, C3.operator08}
replace {C3.operator08, :is_a, :operator}
replace {C3.operator08, :symbol, +}
replace {C3.operator08, :arity, 2}
-replace {C3.operator08, :cfn, cfn :tag "tag_add" (:tag, :tag, :&result)}
+replace {C3.operator08, :cfn, cfn Tag "tag_add" (Tag, Tag, Result)}
replace {C3.operator08, :operator_precedence, 4}
replace {C3.operator08, :operator_associativity, :left}
add {C3, :operator, C3.operator09}
replace {C3.operator09, :is_a, :operator}
replace {C3.operator09, :symbol, -}
replace {C3.operator09, :arity, 2}
-replace {C3.operator09, :cfn, cfn :tag "tag_sub" (:tag, :tag, :&result)}
+replace {C3.operator09, :cfn, cfn Tag "tag_sub" (Tag, Tag, Result)}
replace {C3.operator09, :operator_precedence, 4}
replace {C3.operator09, :operator_associativity, :left}
add {C3, :operator, C3.operator10}
replace {C3.operator10, :is_a, :operator}
replace {C3.operator10, :symbol, <<}
replace {C3.operator10, :arity, 2}
-replace {C3.operator10, :cfn, cfn :tag "tag_shift_left" (:tag, :tag, &result)}
+replace {C3.operator10, :cfn, cfn Tag "tag_shift_left" (Tag, Tag, Result)}
replace {C3.operator10, :operator_precedence, 5}
replace {C3.operator10, :operator_associativity, :left}
add {C3, :operator, C3.operator11}
replace {C3.operator11, :is_a, :operator}
replace {C3.operator11, :symbol, >>}
replace {C3.operator11, :arity, 2}
-replace {C3.operator11, :cfn, cfn :tag "tag_shift_left" (:tag, :tag, &result)}
+replace {C3.operator11, :cfn, cfn Tag "tag_shift_right" (Tag, Tag, Result)}
replace {C3.operator11, :operator_precedence, 5}
replace {C3.operator11, :operator_associativity, :left}
add {C3, :operator, C3.operator12}
replace {C3.operator12, :is_a, :operator}
replace {C3.operator12, :symbol, <}
replace {C3.operator12, :arity, 2}
-replace {C3.operator12, :cfn, cfn :bool "tag_lt" (:tag, :tag)}
+replace {C3.operator12, :cfn, cfn :bool "tag_lt" (Tag, Tag)}
replace {C3.operator12, :operator_precedence, 6}
replace {C3.operator12, :operator_associativity, :left}
add {C3, :operator, C3.operator13}
replace {C3.operator13, :symbol, <=}
replace {C3.operator13, :is_a, :operator}
replace {C3.operator13, :arity, 2}
-replace {C3.operator13, :cfn, cfn :bool "tag_lte" (:tag, :tag)}
+replace {C3.operator13, :cfn, cfn :bool "tag_lte" (Tag, Tag)}
replace {C3.operator13, :operator_precedence, 6}
replace {C3.operator13, :operator_associativity, :left}
add {C3, :operator, C3.operator14}
replace {C3.operator14, :symbol, >}
replace {C3.operator14, :is_a, :operator}
replace {C3.operator14, :arity, 2}
-replace {C3.operator14, :cfn, cfn :bool "tag_gt" (:tag, :tag)}
+replace {C3.operator14, :cfn, cfn :bool "tag_gt" (Tag, Tag)}
replace {C3.operator14, :operator_precedence, 6}
replace {C3.operator14, :operator_associativity, :left}
add {C3, :operator, C3.operator15}
replace {C3.operator15, :symbol, >=}
replace {C3.operator15, :is_a, :operator}
replace {C3.operator15, :arity, 2}
-replace {C3.operator15, :cfn, cfn :bool "tag_gte" (:tag, :tag)}
+replace {C3.operator15, :cfn, cfn :bool "tag_gte" (Tag, Tag)}
replace {C3.operator15, :operator_precedence, 6}
replace {C3.operator15, :operator_associativity, :left}
add {C3, :operator, C3.operator16}
replace {C3.operator16, :is_a, :operator}
replace {C3.operator16, :symbol, ==}
replace {C3.operator16, :arity, 2}
-replace {C3.operator16, :cfn, cfn :bool "tag_eq" (:tag, :tag)}
+replace {C3.operator16, :cfn, cfn :bool "tag_eq" (Tag, Tag)}
replace {C3.operator16, :operator_precedence, 7}
replace {C3.operator16, :operator_associativity, :left}
add {C3, :operator, C3.operator17}
replace {C3.operator17, :is_a, :operator}
replace {C3.operator17, :symbol, !=}
replace {C3.operator17, :arity, 2}
-replace {C3.operator17, :cfn, cfn :bool "tag_not_eq" (:tag, :tag)}
+replace {C3.operator17, :cfn, cfn :bool "tag_not_eq" (Tag, Tag)}
replace {C3.operator17, :operator_precedence, 7}
replace {C3.operator17, :operator_associativity, :left}
add {C3, :operator, C3.operator18}
replace {C3.operator18, :is_a, :operator}
replace {C3.operator18, :symbol, &}
replace {C3.operator18, :arity, 2}
-replace {C3.operator18, :cfn, cfn :bool "tag_band" (:tag, :tag)}
+replace {C3.operator18, :cfn, cfn :bool "tag_band" (Tag, Tag)}
replace {C3.operator18, :operator_precedence, 8}
replace {C3.operator18, :operator_associativity, :left}
add {C3, :operator, C3.operator19}
replace {C3.operator19, :is_a, :operator}
replace {C3.operator19, :symbol, ^}
replace {C3.operator19, :arity, 2}
-replace {C3.operator19, :cfn, cfn :bool "tag_bxor" (:tag, :tag)}
+replace {C3.operator19, :cfn, cfn :bool "tag_bxor" (Tag, Tag)}
replace {C3.operator19, :operator_precedence, 9}
replace {C3.operator19, :operator_associativity, :left}
add {C3, :operator, C3.operator20}
replace {C3.operator20, :is_a, :operator}
replace {C3.operator20, :symbol, |}
replace {C3.operator20, :arity, 2}
-replace {C3.operator20, :cfn, cfn :bool "tag_bor" (:tag, :tag)}
+replace {C3.operator20, :cfn, cfn :bool "tag_bor" (Tag, Tag)}
replace {C3.operator20, :operator_precedence, 10}
replace {C3.operator20, :operator_associativity, :left}
add {C3, :operator, C3.operator21}
replace {C3.operator21, :is_a, :operator}
replace {C3.operator21, :symbol, &&}
replace {C3.operator21, :arity, 2}
-replace {C3.operator21, :cfn, cfn :bool "tag_and" (:tag, :tag)}
+replace {C3.operator21, :cfn, cfn :bool "tag_and" (Tag, Tag)}
replace {C3.operator21, :operator_precedence, 11}
replace {C3.operator21, :operator_associativity, :left}
add {C3, :operator, C3.operator22}
replace {C3.operator22, :is_a, :operator}
replace {C3.operator22, :symbol, ||}
replace {C3.operator22, :arity, 2}
-replace {C3.operator22, :cfn, cfn :bool "tag_and" (:tag, :tag)}
+replace {C3.operator22, :cfn, cfn :bool "tag_and" (Tag, Tag)}
replace {C3.operator22, :operator_precedence, 12}
replace {C3.operator22, :operator_associativity, :left}
add {C3, :operator, C3.operator23}
@@ -167,10 +167,10 @@ replace {C3.operator23, :is_a, :operator}
add {C3.operator23, :is_a, :special_operator}
replace {C3.operator23, :symbol, =}
replace {C3.operator23, :arity, 2}
-replace {C3.operator23, :cfn, cfn :tag "tag_equal" (:tag, :tag, :&result)}
+replace {C3.operator23, :cfn, cfn Tag "tag_equal" (Tag, Tag, Result)}
replace {C3.operator23, :operator_precedence, 13}
replace {C3.operator23, :operator_associativity, :right}
-replace {C3.break, :cfn, cfn :void "c3_break" ()}
+replace {C3.break, :cfn, cfn Void "c3_break" ()}
replace {C3.first, :fn, fn {
((a | _b)) { a }
({a, _b}) { a }
diff --git a/libc3/cfn.c b/libc3/cfn.c
index f507ea2..c629fc2 100644
--- a/libc3/cfn.c
+++ b/libc3/cfn.c
@@ -199,7 +199,8 @@ s_cfn * cfn_prep_cif (s_cfn *cfn)
assert(i < cfn->arity);
if (a->tag.type != TAG_SYM) {
assert(! "cfn_prep_cif: invalid type");
- errx(1, "cfn_prep_cif: invalid type");
+ errx(1, "cfn_prep_cif: invalid type: %s",
+ tag_type_to_string(a->tag.type));
}
if (! (arg_ffi_type[i] = sym_to_ffi_type(a->tag.data.sym, result_ffi_type))) {
free(arg_ffi_type);
diff --git a/libc3/sym.c b/libc3/sym.c
index c7ef9f4..f5adfde 100644
--- a/libc3/sym.c
+++ b/libc3/sym.c
@@ -153,39 +153,55 @@ const s_sym * sym_new (const s_str *src)
ffi_type * sym_to_ffi_type (const s_sym *sym, ffi_type *result_type)
{
- if (sym == sym_1("&result")) {
+ if (sym == sym_1("Result") ||
+ sym == sym_1("&result")) {
if (! result_type)
warnx("invalid result type: &result");
return result_type;
}
- if (sym == sym_1("integer"))
+ if (sym == sym_1("Integer") ||
+ sym == sym_1("integer"))
return &ffi_type_pointer;
- if (sym == sym_1("list"))
+ if (sym == sym_1("List") ||
+ sym == sym_1("list"))
return &ffi_type_pointer;
- if (sym == sym_1("s8"))
+ if (sym == sym_1("S8") ||
+ sym == sym_1("s8"))
return &ffi_type_sint8;
- if (sym == sym_1("s16"))
+ if (sym == sym_1("S16") ||
+ sym == sym_1("s16"))
return &ffi_type_sint16;
- if (sym == sym_1("s32"))
+ if (sym == sym_1("S32") ||
+ sym == sym_1("s32"))
return &ffi_type_sint32;
- if (sym == sym_1("s64"))
+ if (sym == sym_1("S64") ||
+ sym == sym_1("s64"))
return &ffi_type_sint64;
- if (sym == sym_1("sw"))
+ if (sym == sym_1("Sw") ||
+ sym == sym_1("sw"))
return &ffi_type_slong;
- if (sym == sym_1("tag"))
+ if (sym == sym_1("Tag") ||
+ sym == sym_1("tag"))
return &ffi_type_pointer;
- if (sym == sym_1("u8") ||
+ if (sym == sym_1("U8") ||
+ sym == sym_1("u8") ||
+ sym == sym_1("Bool") ||
sym == sym_1("bool"))
return &ffi_type_uint8;
- if (sym == sym_1("u16"))
+ if (sym == sym_1("U16") ||
+ sym == sym_1("u16"))
return &ffi_type_uint16;
- if (sym == sym_1("u32"))
+ if (sym == sym_1("U32") ||
+ sym == sym_1("u32"))
return &ffi_type_uint32;
- if (sym == sym_1("u64"))
+ if (sym == sym_1("U64") ||
+ sym == sym_1("u64"))
return &ffi_type_uint64;
- if (sym == sym_1("uw"))
+ if (sym == sym_1("Uw") ||
+ sym == sym_1("uw"))
return &ffi_type_ulong;
- if (sym == sym_1("void"))
+ if (sym == sym_1("Void") ||
+ sym == sym_1("void"))
return &ffi_type_void;
assert(! "sym_to_ffi_type: unknown type");
errx(1, "sym_to_ffi_type: unknown type: %s", sym->str.ptr.ps8);
diff --git a/libc3/tag.c b/libc3/tag.c
index 9a8065a..d4fbfd4 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -12,6 +12,7 @@
*/
#include <assert.h>
#include <err.h>
+#include <math.h>
#include <stdlib.h>
#include <string.h>
#include <strings.h>
@@ -1259,6 +1260,166 @@ s_tag * tag_array (s_tag *tag, const s_array *a)
return tag_init_array(tag, a);
}
+s_tag * tag_band (const s_tag *a, const s_tag *b, s_tag *result)
+{
+ s_integer tmp;
+ s_tag tmp_a;
+ switch (a->type) {
+ case TAG_BOOL:
+ tmp_a.data.bool = a->data.bool ? 1 : 0;
+ switch (b->type) {
+ case TAG_BOOL:
+ return tag_init_u8(result, tmp_a.data.bool &
+ (b->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u32(result, (u32) tmp_a.data.bool & b->data.character);
+ case TAG_INTEGER:
+ integer_init_u8(&tmp, tmp_a.data.bool);
+ result->type = TAG_INTEGER;
+ integer_band(&tmp, &a->data.integer, &result->data.integer);
+ return result;
+ case TAG_SW:
+ return tag_init_sw(result, ~a->data.sw);
+ case TAG_S64:
+ return tag_init_s64(result, ~a->data.s64);
+ case TAG_S32:
+ return tag_init_s32(result, ~a->data.s32);
+ case TAG_S16:
+ return tag_init_s16(result, ~a->data.s16);
+ case TAG_S8:
+ return tag_init_s8(result, ~a->data.s8);
+ case TAG_U8:
+ return tag_init_u8(result, ~a->data.u8);
+ case TAG_U16:
+ return tag_init_u16(result, ~a->data.u16);
+ case TAG_U32:
+ return tag_init_u32(result, ~a->data.u32);
+ case TAG_U64:
+ return tag_init_u64(result, ~a->data.u64);
+ case TAG_UW:
+ return tag_init_uw(result, ~a->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_CHARACTER:
+ return tag_init_u32(result, ~a->data.character);
+ case TAG_INTEGER:
+ result->type = TAG_INTEGER;
+ integer_bnot(&a->data.integer, &result->data.integer);
+ return result;
+ case TAG_SW:
+ return tag_init_sw(result, ~a->data.sw);
+ case TAG_S64:
+ return tag_init_s64(result, ~a->data.s64);
+ case TAG_S32:
+ return tag_init_s32(result, ~a->data.s32);
+ case TAG_S16:
+ return tag_init_s16(result, ~a->data.s16);
+ case TAG_S8:
+ return tag_init_s8(result, ~a->data.s8);
+ case TAG_U8:
+ return tag_init_u8(result, ~a->data.u8);
+ case TAG_U16:
+ return tag_init_u16(result, ~a->data.u16);
+ case TAG_U32:
+ return tag_init_u32(result, ~a->data.u32);
+ case TAG_U64:
+ return tag_init_u64(result, ~a->data.u64);
+ case TAG_UW:
+ return tag_init_uw(result, ~a->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;
+ }
+ error:
+ warnx("tag_band: invalid tag type %s band %s",
+ tag_type_to_string(a->type),
+ tag_type_to_string(b->type));
+ return NULL;
+}
+
+s_tag * tag_bnot (const s_tag *tag, s_tag *result)
+{
+ switch (tag->type) {
+ case TAG_BOOL:
+ return tag_init_u8(result, ~(tag->data.bool ? 1 : 0));
+ case TAG_CHARACTER:
+ return tag_init_u32(result, ~tag->data.character);
+ case TAG_INTEGER:
+ result->type = TAG_INTEGER;
+ integer_bnot(&tag->data.integer, &result->data.integer);
+ return result;
+ case TAG_SW:
+ return tag_init_sw(result, ~tag->data.sw);
+ case TAG_S64:
+ return tag_init_s64(result, ~tag->data.s64);
+ case TAG_S32:
+ return tag_init_s32(result, ~tag->data.s32);
+ case TAG_S16:
+ return tag_init_s16(result, ~tag->data.s16);
+ case TAG_S8:
+ return tag_init_s8(result, ~tag->data.s8);
+ case TAG_U8:
+ return tag_init_u8(result, ~tag->data.u8);
+ case TAG_U16:
+ return tag_init_u16(result, ~tag->data.u16);
+ case TAG_U32:
+ return tag_init_u32(result, ~tag->data.u32);
+ case TAG_U64:
+ return tag_init_u64(result, ~tag->data.u64);
+ case TAG_UW:
+ return tag_init_uw(result, ~tag->data.uw);
+ 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:
+ case TAG_VOID:
+ 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);
@@ -2116,6 +2277,24 @@ s_tag * tag_init_integer_1 (s_tag *tag, const s8 *p)
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);
@@ -2440,6 +2619,523 @@ bool tag_lte (const s_tag *a, const s_tag *b)
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_mul (const s_tag *a, const s_tag *b, s_tag *dest)
{
s_integer tmp;
@@ -2993,6 +3689,80 @@ s_tag * tag_mul (const s_tag *a, const s_tag *b, s_tag *dest)
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;
+ }
+ 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));
+ }
+ return NULL;
+}
+
s_tag * tag_new ()
{
s_tag *tag;