Scheme_Object *scheme_complex_add(const Scheme_Object *a, const Scheme_Object *b)
{
Scheme_Complex *ca = (Scheme_Complex *)a;
Scheme_Complex *cb = (Scheme_Complex *)b;
return scheme_make_complex(scheme_bin_plus(ca->r, cb->r),
scheme_bin_plus(ca->i, cb->i));
}
Scheme_Object *scheme_complex_sqrt(const Scheme_Object *o)
{
Scheme_Complex *c = (Scheme_Complex *)o;
Scheme_Object *r, *i, *ssq, *srssq, *nrsq, *prsq, *nr, *ni;
r = c->r;
i = c->i;
if (scheme_is_zero(i)) {
/* Special case for x+0.0i: */
r = scheme_sqrt(1, &r);
if (!SCHEME_COMPLEXP(r))
return scheme_make_complex(r, i);
else {
c = (Scheme_Complex *)r;
if (SAME_OBJ(c->r, zero)) {
/* need an inexact-zero real part: */
#ifdef MZ_USE_SINGLE_FLOATS
if (SCHEME_FLTP(c->i))
r = scheme_make_float(0.0);
else
#endif
r = scheme_make_double(0.0);
return scheme_make_complex(r, c->i);
} else
return r;
}
}
ssq = scheme_bin_plus(scheme_bin_mult(r, r),
scheme_bin_mult(i, i));
srssq = scheme_sqrt(1, &ssq);
if (SCHEME_FLOATP(srssq)) {
/* We may have lost too much precision, if i << r. The result is
going to be inexact, anyway, so switch to using expt. */
Scheme_Object *a[2];
a[0] = (Scheme_Object *)o;
a[1] = scheme_make_double(0.5);
return scheme_expt(2, a);
}
nrsq = scheme_bin_div(scheme_bin_minus(srssq, r),
scheme_make_integer(2));
nr = scheme_sqrt(1, &nrsq);
if (scheme_is_negative(i))
nr = scheme_bin_minus(zero, nr);
prsq = scheme_bin_div(scheme_bin_plus(srssq, r),
scheme_make_integer(2));
ni = scheme_sqrt(1, &prsq);
return scheme_make_complex(ni, nr);
}
Scheme_Object *scheme_rational_add(const Scheme_Object *a, const Scheme_Object *b)
{
Scheme_Rational *ra = (Scheme_Rational *)a;
Scheme_Rational *rb = (Scheme_Rational *)b;
Scheme_Object *ac, *bd, *sum, *cd;
int no_normalize = 0;
if (SCHEME_INTP(ra->denom) && (SCHEME_INT_VAL(ra->denom) == 1)) {
/* Swap, to take advantage of the next optimization */
Scheme_Rational *rx = ra;
ra = rb;
rb = rx;
}
if (SCHEME_INTP(rb->denom) && (SCHEME_INT_VAL(rb->denom) == 1)) {
/* From Brad Lucier: */
/* (+ p/q n) = (make-rational (+ p (* n q)) q), no normalize */
ac = ra->num;
cd = ra->denom;
no_normalize = 1;
} else {
ac = scheme_bin_mult(ra->num, rb->denom);
cd = scheme_bin_mult(ra->denom, rb->denom);
}
bd = scheme_bin_mult(ra->denom, rb->num);
sum = scheme_bin_plus(ac, bd);
if (no_normalize)
return make_rational(sum, cd, 0);
else
return scheme_make_rational(sum, cd);
}
Scheme_Object *scheme_complex_multiply(const Scheme_Object *a, const Scheme_Object *b)
{
Scheme_Complex *ca = (Scheme_Complex *)a;
Scheme_Complex *cb = (Scheme_Complex *)b;
return scheme_make_complex(scheme_bin_minus(scheme_bin_mult(ca->r, cb->r),
scheme_bin_mult(ca->i, cb->i)),
scheme_bin_plus(scheme_bin_mult(ca->r, cb->i),
scheme_bin_mult(ca->i, cb->r)));
}
Scheme_Object *scheme_complex_divide(const Scheme_Object *_n, const Scheme_Object *_d)
{
Scheme_Complex *cn = (Scheme_Complex *)_n;
Scheme_Complex *cd = (Scheme_Complex *)_d;
Scheme_Object *den, *r, *i, *a, *b, *c, *d, *cm, *dm, *aa[1];
int swap;
if ((cn->r == zero) && (cn->i == zero))
return zero;
a = cn->r;
b = cn->i;
c = cd->r;
d = cd->i;
/* Check for exact-zero simplifications in d: */
if (c == zero) {
i = scheme_bin_minus(zero, scheme_bin_div(a, d));
r = scheme_bin_div(b, d);
return scheme_make_complex(r, i);
} else if (d == zero) {
r = scheme_bin_div(a, c);
i = scheme_bin_div(b, c);
return scheme_make_complex(r, i);
}
if (!SCHEME_FLOATP(c) && !SCHEME_FLOATP(d)) {
/* The simple way: */
cm = scheme_bin_plus(scheme_bin_mult(c, c),
scheme_bin_mult(d, d));
r = scheme_bin_div(scheme_bin_plus(scheme_bin_mult(c, a),
scheme_bin_mult(d, b)),
cm);
i = scheme_bin_div(scheme_bin_minus(scheme_bin_mult(c, b),
scheme_bin_mult(d, a)),
cm);
return scheme_make_complex(r, i);
}
if (scheme_is_zero(d)) {
/* This is like dividing by a real number, except that
the inexact 0 imaginary part can interact with +inf.0 and +nan.0 */
r = scheme_bin_plus(scheme_bin_div(a, c),
/* Either 0.0 or +nan.0: */
scheme_bin_mult(d, b));
i = scheme_bin_minus(scheme_bin_div(b, c),
/* Either 0.0 or +nan.0: */
scheme_bin_mult(d, a));
return scheme_make_complex(r, i);
}
if (scheme_is_zero(c)) {
r = scheme_bin_plus(scheme_bin_div(b, d),
/* Either 0.0 or +nan.0: */
scheme_bin_mult(c, a));
i = scheme_bin_minus(scheme_bin_mult(c, b), /* either 0.0 or +nan.0 */
scheme_bin_div(a, d));
return scheme_make_complex(r, i);
}
aa[0] = c;
cm = scheme_abs(1, aa);
aa[0] = d;
dm = scheme_abs(1, aa);
if (scheme_bin_lt(cm, dm)) {
cm = a;
a = b;
b = cm;
cm = c;
c = d;
d = cm;
swap = 1;
} else
swap = 0;
r = scheme_bin_div(c, d);
den = scheme_bin_plus(d, scheme_bin_mult(c, r));
if (swap)
i = scheme_bin_div(scheme_bin_minus(a, scheme_bin_mult(b, r)), den);
else
i = scheme_bin_div(scheme_bin_minus(scheme_bin_mult(b, r), a), den);
r = scheme_bin_div(scheme_bin_plus(b, scheme_bin_mult(a, r)), den);
return scheme_make_complex(r, i);
}
