Scheme_Object *scheme_rational_normalize(const Scheme_Object *o)
{
Scheme_Rational *r = (Scheme_Rational *)o;
Scheme_Object *gcd, *tmpn;
int negate = 0;
if (r->num == scheme_exact_zero)
return scheme_make_integer(0);
if (SCHEME_INTP(r->denom)) {
if (SCHEME_INT_VAL(r->denom) < 0) {
tmpn = scheme_make_integer_value(-SCHEME_INT_VAL(r->denom));
r->denom = tmpn;
negate = 1;
}
} else if (!SCHEME_BIGPOS(r->denom)) {
tmpn = scheme_bignum_negate(r->denom);
r->denom = tmpn;
negate = 1;
}
if (negate) {
if (SCHEME_INTP(r->num)) {
tmpn = scheme_make_integer_value(-SCHEME_INT_VAL(r->num));
r->num = tmpn;
} else {
tmpn = scheme_bignum_negate(r->num);
r->num = tmpn;
}
}
if (r->denom == one)
return r->num;
gcd = scheme_bin_gcd(r->num, r->denom);
if (gcd == one)
return (Scheme_Object *)o;
tmpn = scheme_bin_quotient(r->num, gcd);
r->num = tmpn;
tmpn = scheme_bin_quotient(r->denom, gcd);
r->denom = tmpn;
if (r->denom == one)
return r->num;
return (Scheme_Object *)r;
}
Scheme_Object *
scheme_abs(int argc, Scheme_Object *argv[])
{
Scheme_Type t;
Scheme_Object *o;
o = argv[0];
if (SCHEME_INTP(o)) {
intptr_t n = SCHEME_INT_VAL(o);
return scheme_make_integer_value(ABS(n));
}
t = _SCHEME_TYPE(o);
#ifdef MZ_USE_SINGLE_FLOATS
if (t == scheme_float_type)
return scheme_make_float(fabs(SCHEME_FLT_VAL(o)));
#endif
if (t == scheme_double_type)
return scheme_make_double(fabs(SCHEME_DBL_VAL(o)));
if (t == scheme_bignum_type) {
if (SCHEME_BIGPOS(o))
return o;
return scheme_bignum_negate(o);
}
if (t == scheme_rational_type) {
if (scheme_is_rational_positive(o))
return o;
else
return scheme_rational_negate(o);
}
NEED_REAL(abs);
ESCAPED_BEFORE_HERE;
}
static Scheme_Object *negate_simple(Scheme_Object *v)
{
if (SCHEME_INTP(v))
return scheme_make_integer_value(-SCHEME_INT_VAL(v));
else
return scheme_bignum_negate(v);
}
static Scheme_Object *
rem_mod (int argc, Scheme_Object *argv[], char *name, int first_sign)
{
Scheme_Object *n1, *n2, *r;
int negate;
n1 = argv[0];
n2 = argv[1];
if (!scheme_is_integer(n1))
scheme_wrong_contract(name, "integer?", 0, argc, argv);
if (!scheme_is_integer(n2))
scheme_wrong_contract(name, "integer?", 1, argc, argv);
if (SCHEME_INTP(n2) && !SCHEME_INT_VAL(n2))
scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
"%s: undefined for 0", name);
if (
#ifdef MZ_USE_SINGLE_FLOATS
(SCHEME_FLTP(n2) && (SCHEME_FLT_VAL(n2) == 0.0f)) ||
#endif
(SCHEME_DBLP(n2) && (SCHEME_DBL_VAL(n2) == 0.0))) {
int neg;
neg = scheme_minus_zero_p(SCHEME_FLOAT_VAL(n2));
scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
"%s: undefined for %s0.0",
name,
neg ? "-" : "");
}
if (SCHEME_INTP(n1) && !SCHEME_INT_VAL(n1))
return zeroi;
if (SCHEME_INTP(n1) && SCHEME_INTP(n2)) {
intptr_t a, b, na, nb, v;
int neg1, neg2;
a = SCHEME_INT_VAL(n1);
b = SCHEME_INT_VAL(n2);
na = (a < 0) ? -a : a;
nb = (b < 0) ? -b : b;
v = na % nb;
if (v) {
if (first_sign) {
if (a < 0)
v = -v;
} else {
neg1 = (a < 0);
neg2 = (b < 0);
if (neg1 != neg2)
v = nb - v;
if (neg2)
v = -v;
}
}
return scheme_make_integer(v);
}
if (SCHEME_FLOATP(n1) || SCHEME_FLOATP(n2)) {
double a, b, na, nb, v;
#ifdef MZ_USE_SINGLE_FLOATS
int was_single = !(SCHEME_DBLP(n1) || SCHEME_DBLP(n2));
#endif
if (SCHEME_INTP(n1))
a = SCHEME_INT_VAL(n1);
#ifdef MZ_USE_SINGLE_FLOATS
else if (SCHEME_FLTP(n1))
a = SCHEME_FLT_VAL(n1);
#endif
else if (SCHEME_DBLP(n1))
a = SCHEME_DBL_VAL(n1);
else
a = scheme_bignum_to_double(n1);
if (SCHEME_INTP(n2))
b = SCHEME_INT_VAL(n2);
#ifdef MZ_USE_SINGLE_FLOATS
else if (SCHEME_FLTP(n2))
b = SCHEME_FLT_VAL(n2);
#endif
else if (SCHEME_DBLP(n2))
b = SCHEME_DBL_VAL(n2);
else
b = scheme_bignum_to_double(n2);
if (a == 0.0) {
/* Avoid sign problems. */
#ifdef MZ_USE_SINGLE_FLOATS
if (was_single)
return scheme_zerof;
#endif
return scheme_zerod;
}
na = (a < 0) ? -a : a;
nb = (b < 0) ? -b : b;
if (MZ_IS_POS_INFINITY(nb))
v = na;
else if (MZ_IS_POS_INFINITY(na)) {
#ifdef MZ_USE_SINGLE_FLOATS
if (was_single)
return scheme_zerof;
#endif
return scheme_zerod;
} else {
v = fmod(na, nb);
#ifdef FMOD_CAN_RETURN_NEG_ZERO
if (v == 0.0)
v = 0.0;
#endif
}
if (v) {
if (first_sign) {
/* remainder */
if (a < 0)
v = -v;
} else {
/* modulo */
int neg1, neg2;
neg1 = (a < 0);
neg2 = (b < 0);
if (neg1 != neg2)
v = nb - v;
if (neg2)
v = -v;
}
}
#ifdef MZ_USE_SINGLE_FLOATS
if (was_single)
return scheme_make_float((float)v);
#endif
return scheme_make_double(v);
}
n1 = scheme_to_bignum(n1);
n2 = scheme_to_bignum(n2);
scheme_bignum_divide(n1, n2, NULL, &r, 1);
negate = 0;
if (!SCHEME_INTP(r) || SCHEME_INT_VAL(r)) {
/* Easier if we can assume 'r' is positive: */
if (SCHEME_INTP(r)) {
if (SCHEME_INT_VAL(r) < 0)
r = scheme_make_integer(-SCHEME_INT_VAL(r));
} else if (!SCHEME_BIGPOS(r))
r = scheme_bignum_negate(r);
if (first_sign) {
if (!SCHEME_BIGPOS(n1))
negate = 1;
} else {
int neg1, neg2;
neg1 = !SCHEME_BIGPOS(n1);
neg2 = !SCHEME_BIGPOS(n2);
if (neg1 != neg2) {
if (neg2)
r = scheme_bin_plus(n2, r);
else
r = scheme_bin_minus(n2, r);
} else if (neg2)
negate = 1;
}
if (negate) {
if (SCHEME_INTP(r))
r = scheme_make_integer(-SCHEME_INT_VAL(r));
else
r = scheme_bignum_negate(r);
}
}
return r;
}
