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; }