int cmp_eq(void *a, numerictype_t atag, void *b, numerictype_t btag,
int equalnans)
{
union { double d; int64_t i64; } u, v;
if (atag==btag && (!equalnans || atag < T_FLOAT))
return cmp_same_eq(a, b, atag);
double da = conv_to_double(a, atag);
double db = conv_to_double(b, btag);
if ((int)atag >= T_FLOAT && (int)btag >= T_FLOAT) {
if (equalnans) {
u.d = da; v.d = db;
return u.i64 == v.i64;
}
return (da == db);
}
if (da != db)
return 0;
if (atag == T_UINT64) {
// this is safe because if a had been bigger than S64_MAX,
// we would already have concluded that it's bigger than b.
if (btag == T_INT64) {
return ((int64_t)*(uint64_t*)a == *(int64_t*)b);
}
else if (btag == T_DOUBLE) {
return (*(uint64_t*)a == (uint64_t)(int64_t)*(double*)b);
}
}
else if (atag == T_INT64) {
if (btag == T_UINT64) {
return (*(int64_t*)a == (int64_t)*(uint64_t*)b);
}
else if (btag == T_DOUBLE) {
return (*(int64_t*)a == (int64_t)*(double*)b);
}
}
else if (btag == T_UINT64) {
if (atag == T_INT64) {
return ((int64_t)*(uint64_t*)b == *(int64_t*)a);
}
else if (atag == T_DOUBLE) {
return (*(uint64_t*)b == (uint64_t)(int64_t)*(double*)a);
}
}
else if (btag == T_INT64) {
if (atag == T_UINT64) {
return (*(int64_t*)b == (int64_t)*(uint64_t*)a);
}
else if (atag == T_DOUBLE) {
return (*(int64_t*)b == (int64_t)*(double*)a);
}
}
return 1;
}
int cmp_lt(void *a, numerictype_t atag, void *b, numerictype_t btag)
{
if (atag==btag)
return cmp_same_lt(a, b, atag);
double da = conv_to_double(a, atag);
double db = conv_to_double(b, btag);
// casting to double will only get the wrong answer for big int64s
// that differ in low bits
if (da < db)
return 1;
if (db < da)
return 0;
if (atag == T_UINT64) {
if (btag == T_INT64) {
if (*(int64_t*)b >= 0) {
return (*(uint64_t*)a < (uint64_t)*(int64_t*)b);
}
return ((int64_t)*(uint64_t*)a < *(int64_t*)b);
}
else if (btag == T_DOUBLE) {
if (db != db) return 0;
return (*(uint64_t*)a < (uint64_t)*(double*)b);
}
}
else if (atag == T_INT64) {
if (btag == T_UINT64) {
if (*(int64_t*)a >= 0) {
return ((uint64_t)*(int64_t*)a < *(uint64_t*)b);
}
return (*(int64_t*)a < (int64_t)*(uint64_t*)b);
}
else if (btag == T_DOUBLE) {
if (db != db) return 0;
return (*(int64_t*)a < (int64_t)*(double*)b);
}
}
if (btag == T_UINT64) {
if (atag == T_DOUBLE) {
if (da != da) return 0;
return (*(uint64_t*)b > (uint64_t)*(double*)a);
}
}
else if (btag == T_INT64) {
if (atag == T_DOUBLE) {
if (da != da) return 0;
return (*(int64_t*)b > (int64_t)*(double*)a);
}
}
return 0;
}
static double todouble(value_t a, char *fname)
{
if (isfixnum(a))
return (double)numval(a);
if (iscprim(a)) {
cprim_t *cp = (cprim_t*)ptr(a);
numerictype_t nt = cp_numtype(cp);
return conv_to_double(cp_data(cp), nt);
}
type_error(fname, "number", a);
}
// *oob: output argument, means we hit the limit specified by 'bound'
static uptrint_t bounded_hash(value_t a, int bound, int *oob)
{
*oob = 0;
union {
double d;
int64_t i64;
} u;
numerictype_t nt;
size_t i, len;
cvalue_t *cv;
cprim_t *cp;
void *data;
uptrint_t h = 0;
int oob2, tg = tag(a);
switch(tg) {
case TAG_NUM :
case TAG_NUM1:
u.d = (double)numval(a);
return doublehash(u.i64);
case TAG_FUNCTION:
if (uintval(a) > N_BUILTINS)
return bounded_hash(((function_t*)ptr(a))->bcode, bound, oob);
return inthash(a);
case TAG_SYM:
return ((symbol_t*)ptr(a))->hash;
case TAG_CPRIM:
cp = (cprim_t*)ptr(a);
data = cp_data(cp);
if (cp_class(cp) == wchartype)
return inthash(*(int32_t*)data);
nt = cp_numtype(cp);
u.d = conv_to_double(data, nt);
return doublehash(u.i64);
case TAG_CVALUE:
cv = (cvalue_t*)ptr(a);
data = cv_data(cv);
return memhash(data, cv_len(cv));
case TAG_VECTOR:
if (bound <= 0) {
*oob = 1;
return 1;
}
len = vector_size(a);
for(i=0; i < len; i++) {
h = MIX(h, bounded_hash(vector_elt(a,i), bound/2, &oob2)^1);
if (oob2)
bound/=2;
*oob = *oob || oob2;
}
return h;
case TAG_CONS:
do {
if (bound <= 0) {
*oob = 1;
return h;
}
h = MIX(h, bounded_hash(car_(a), bound/2, &oob2));
// bounds balancing: try to share the bounds efficiently
// so we can hash better when a list is cdr-deep (a common case)
if (oob2)
bound/=2;
else
bound--;
// recursive OOB propagation. otherwise this case is slow:
// (hash '#2=((#0=(#1=(#1#) . #0#)) . #2#))
*oob = *oob || oob2;
a = cdr_(a);
} while (iscons(a));
h = MIX(h, bounded_hash(a, bound-1, &oob2)^2);
*oob = *oob || oob2;
return h;
}
return 0;
}
