XFORM_NONGCING static int is_eqv(Scheme_Object *obj1, Scheme_Object *obj2)
{
Scheme_Type t1, t2;
if (SAME_OBJ(obj1, obj2))
return 1;
t1 = SCHEME_TYPE(obj1);
t2 = SCHEME_TYPE(obj2);
if (NOT_SAME_TYPE(t1, t2)) {
#ifdef EQUATE_FLOATS_OF_DIFFERENT_PRECISIONS
/* If one is a float and the other is a double, coerce to double */
if ((t1 == scheme_float_type) && (t2 == scheme_double_type))
return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_DBL_VAL(obj2));
else if ((t2 == scheme_float_type) && (t1 == scheme_double_type))
return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_FLT_VAL(obj2));
#endif
return -1;
} else {
switch (t1) {
#ifdef MZ_LONG_DOUBLE
case scheme_long_double_type:
return mz_long_double_eqv(SCHEME_LONG_DBL_VAL(obj1), SCHEME_LONG_DBL_VAL(obj2));
#endif
#ifdef MZ_USE_SINGLE_FLOATS
case scheme_float_type:
return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_FLT_VAL(obj2));
#endif
case scheme_double_type:
return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_DBL_VAL(obj2));
case scheme_bignum_type:
return scheme_bignum_eq(obj1, obj2);
case scheme_rational_type:
return scheme_rational_eq(obj1, obj2);
case scheme_complex_type:
{
Scheme_Complex *c1 = (Scheme_Complex *)obj1;
Scheme_Complex *c2 = (Scheme_Complex *)obj2;
return scheme_eqv(c1->r, c2->r) && scheme_eqv(c1->i, c2->i);
}
case scheme_char_type:
return SCHEME_CHAR_VAL(obj1) == SCHEME_CHAR_VAL(obj2);
case scheme_symbol_type:
case scheme_keyword_type:
case scheme_scope_type:
/* `eqv?` requires `eq?` */
return 0;
default:
return -1;
}
}
}
XFORM_NONGCING static int is_eqv(Scheme_Object *obj1, Scheme_Object *obj2)
{
Scheme_Type t1, t2;
if (SAME_OBJ(obj1, obj2))
return 1;
t1 = SCHEME_TYPE(obj1);
t2 = SCHEME_TYPE(obj2);
if (NOT_SAME_TYPE(t1, t2)) {
#ifdef EQUATE_FLOATS_OF_DIFFERENT_PRECISIONS
/* If one is a float and the other is a double, coerce to double */
if ((t1 == scheme_float_type) && (t2 == scheme_double_type))
return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_DBL_VAL(obj2));
else if ((t2 == scheme_float_type) && (t1 == scheme_double_type))
return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_FLT_VAL(obj2));
#endif
return -1;
#ifdef MZ_LONG_DOUBLE
} else if (t1 == scheme_long_double_type) {
return long_double_eqv(SCHEME_LONG_DBL_VAL(obj1), SCHEME_LONG_DBL_VAL(obj2));
#endif
#ifdef MZ_USE_SINGLE_FLOATS
} else if (t1 == scheme_float_type) {
return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_FLT_VAL(obj2));
#endif
} else if (t1 == scheme_double_type) {
return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_DBL_VAL(obj2));
} else if (t1 == scheme_bignum_type)
return scheme_bignum_eq(obj1, obj2);
else if (t1 == scheme_rational_type)
return scheme_rational_eq(obj1, obj2);
else if (t1 == scheme_complex_type) {
Scheme_Complex *c1 = (Scheme_Complex *)obj1;
Scheme_Complex *c2 = (Scheme_Complex *)obj2;
return scheme_eqv(c1->r, c2->r) && scheme_eqv(c1->i, c2->i);
} else if (t1 == scheme_char_type)
return SCHEME_CHAR_VAL(obj1) == SCHEME_CHAR_VAL(obj2);
else
return -1;
}
static Scheme_Object *
eqv_prim (int argc, Scheme_Object *argv[])
{
return (scheme_eqv(argv[0], argv[1]) ? scheme_true : scheme_false);
}
