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;
}
Scheme_Object *scheme_rational_power(const Scheme_Object *o, const Scheme_Object *p)
{
double b, e, v;
if (((Scheme_Rational *)p)->denom == one) {
Scheme_Object *a[2], *n;
a[0] = ((Scheme_Rational *)o)->num;
a[1] = ((Scheme_Rational *)p)->num;
n = scheme_expt(2, a);
a[0] = ((Scheme_Rational *)o)->denom;
return make_rational(n, scheme_expt(2, a), 0);
}
if (scheme_is_rational_positive(o)) {
b = scheme_rational_to_double(o);
e = scheme_rational_to_double(p);
v = pow(b, e);
#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
return scheme_make_float(v);
#else
return scheme_make_double(v);
#endif
} else {
return scheme_complex_power(scheme_real_to_complex(o),
scheme_real_to_complex(p));
}
}
Scheme_Object *scheme_rational_ceiling(const Scheme_Object *o)
{
if (!scheme_is_rational_positive(o))
return scheme_rational_truncate(o);
else {
Scheme_Object *r;
r = scheme_rational_truncate(o);
return scheme_add1(1, &r);
}
}
Scheme_Object *scheme_rational_floor(const Scheme_Object *o)
{
if (scheme_is_rational_positive(o))
return scheme_rational_truncate(o);
else {
Scheme_Object *r;
r = scheme_rational_truncate(o);
return scheme_sub1(1, &r);
}
}
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;
}
