Scheme_Object *scheme_complex_normalize(const Scheme_Object *o)
{
Scheme_Complex *c = (Scheme_Complex *)o;
if (c->i == zero)
return c->r;
if (c->r == zero) {
/* No coercions */
return (Scheme_Object *)c;
}
/* Coercions: Exact -> float -> double
If the complex contains a float and an exact, we coerce the exact
to a float, etc. */
#ifdef MZ_USE_SINGLE_FLOATS
if (SCHEME_FLTP(c->i)) {
if (!SCHEME_FLTP(c->r)) {
Scheme_Object *v;
if (SCHEME_DBLP(c->r)) {
v = scheme_make_double(SCHEME_FLT_VAL(c->i));
c->i = v;
} else {
v = scheme_make_float(scheme_get_val_as_float(c->r));
c->r = v;
}
}
} else if (SCHEME_FLTP(c->r)) {
Scheme_Object *v;
/* Imag part can't be a float, or we'd be in the previous case */
if (SCHEME_DBLP(c->i)) {
v = scheme_make_double(SCHEME_FLT_VAL(c->r));
c->r = v;
} else {
v = scheme_make_float(scheme_get_val_as_float(c->i));
c->i = v;
}
} else
#endif
if (SCHEME_DBLP(c->i)) {
if (!SCHEME_DBLP(c->r)) {
Scheme_Object *r;
r = scheme_make_double(scheme_get_val_as_double(c->r));
c->r = r;
}
} else if (SCHEME_DBLP(c->r)) {
Scheme_Object *i;
i = scheme_make_double(scheme_get_val_as_double(c->i));
c->i = i;
}
return (Scheme_Object *)c;
}
Scheme_Object *scheme_complex_power(const Scheme_Object *base, const Scheme_Object *exponent)
{
Scheme_Complex *cb = (Scheme_Complex *)base;
Scheme_Complex *ce = (Scheme_Complex *)exponent;
double a, b, c, d, bm, ba, nm, na, r1, r2;
int d_is_zero;
if ((ce->i == zero) && !SCHEME_FLOATP(ce->r)) {
if (SCHEME_INTP(ce->r) || SCHEME_BIGNUMP(ce->r))
return scheme_generic_integer_power(base, ce->r);
}
a = scheme_get_val_as_double(cb->r);
b = scheme_get_val_as_double(cb->i);
c = scheme_get_val_as_double(ce->r);
d = scheme_get_val_as_double(ce->i);
d_is_zero = (ce->i == zero);
bm = sqrt(a * a + b * b);
ba = atan2(b, a);
/* New mag & angle */
nm = scheme_double_expt(bm, c) * exp(-(ba * d));
if (d_is_zero) /* precision here can avoid NaNs */
na = ba * c;
else
na = log(bm) * d + ba * c;
r1 = nm * cos(na);
r2 = nm * sin(na);
#ifdef MZ_USE_SINGLE_FLOATS
/* Coerce to double or float? */
#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
if (!SCHEME_DBLP(cb->r) && !SCHEME_DBLP(cb->i)
&& !SCHEME_DBLP(ce->r) && !SCHEME_DBLP(ce->i))
#else
if (SCHEME_FLTP(cb->r) && SCHEME_FLTP(cb->i)
&& SCHEME_FLTP(ce->r) && SCHEME_FLTP(ce->i))
#endif
return scheme_make_complex(scheme_make_float((float)r1),
scheme_make_float((float)r2));
#endif
return scheme_make_complex(scheme_make_double(r1),
scheme_make_double(r2));
}