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)); }