int scheme_rational_eq(const Scheme_Object *a, const Scheme_Object *b)
{
Scheme_Rational *ra = (Scheme_Rational *)a;
Scheme_Rational *rb = (Scheme_Rational *)b;
if (SCHEME_INTP(ra->num) && SCHEME_INTP(rb->num)) {
if (ra->num != rb->num)
return 0;
} else if (SCHEME_BIGNUMP(ra->num) && SCHEME_BIGNUMP(rb->num)) {
if (!scheme_bignum_eq(ra->num, rb->num))
return 0;
} else
return 0;
if (SCHEME_INTP(ra->denom) && SCHEME_INTP(rb->denom)) {
if (ra->denom != rb->denom)
return 0;
} else if (SCHEME_BIGNUMP(ra->denom) && SCHEME_BIGNUMP(rb->denom)) {
if (!scheme_bignum_eq(ra->denom, rb->denom))
return 0;
} else
return 0;
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;
} 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;
}
Scheme_Object *scheme_rational_round(const Scheme_Object *o)
{
Scheme_Rational *r = (Scheme_Rational *)o;
Scheme_Object *q, *qd, *delta, *half;
int more = 0, can_eq_half, negative;
negative = !scheme_is_rational_positive(o);
q = scheme_bin_quotient(r->num, r->denom);
/* Get remainder absolute value: */
qd = scheme_bin_mult(q, r->denom);
if (negative)
delta = scheme_bin_minus(qd, r->num);
else
delta = scheme_bin_minus(r->num, qd);
half = scheme_bin_quotient(r->denom, scheme_make_integer(2));
can_eq_half = SCHEME_FALSEP(scheme_odd_p(1, &r->denom));
if (SCHEME_INTP(half) && SCHEME_INTP(delta)) {
if (can_eq_half && (SCHEME_INT_VAL(delta) == SCHEME_INT_VAL(half)))
more = SCHEME_TRUEP(scheme_odd_p(1, &q));
else
more = (SCHEME_INT_VAL(delta) > SCHEME_INT_VAL(half));
} else if (SCHEME_BIGNUMP(delta) && SCHEME_BIGNUMP(half)) {
if (can_eq_half && (scheme_bignum_eq(delta, half)))
more = SCHEME_TRUEP(scheme_odd_p(1, &q));
else
more = !scheme_bignum_lt(delta, half);
} else
more = SCHEME_BIGNUMP(delta);
if (more) {
if (negative)
q = scheme_sub1(1, &q);
else
q = scheme_add1(1, &q);
}
return q;
}
