diff --git a/eval.c b/eval.c index 09abed32..dbce1568 100644 --- a/eval.c +++ b/eval.c @@ -1150,13 +1150,14 @@ sexp sexp_register_optimization (sexp ctx sexp_api_params(self, n), sexp f, sexp #endif #if SEXP_USE_COMPLEX -#define maybe_convert_complex(z, f) \ - else if (sexp_complexp(z)) return sexp_complex_normalize(f(ctx, z)); +#define maybe_convert_complex(z, t, f) \ + else if (t && sexp_complexp(z)) return sexp_complex_normalize(f(ctx, z)); +#define sexp_complex_dummy(ctx, z) 0 #else -#define maybe_convert_complex(z, f) +#define maybe_convert_complex(z, t, f) #endif -#define define_math_op(name, cname, complexf) \ +#define define_math_op(name, cname, t, f) \ static sexp name (sexp ctx sexp_api_params(self, n), sexp z) { \ double d; \ if (sexp_flonump(z)) \ @@ -1165,24 +1166,24 @@ sexp sexp_register_optimization (sexp ctx sexp_api_params(self, n), sexp f, sexp d = (double)sexp_unbox_fixnum(z); \ maybe_convert_ratio(z) \ maybe_convert_bignum(z) \ - maybe_convert_complex(z, complexf) \ + maybe_convert_complex(z, t, f) \ else \ return sexp_type_exception(ctx, self, SEXP_NUMBER, z); \ return sexp_make_flonum(ctx, cname(d)); \ } -define_math_op(sexp_exp, exp, sexp_complex_exp) -define_math_op(sexp_log, log, sexp_complex_log) -define_math_op(sexp_sin, sin, sexp_complex_sin) -define_math_op(sexp_cos, cos, sexp_complex_cos) -define_math_op(sexp_tan, tan, sexp_complex_math_error) -define_math_op(sexp_asin, asin, sexp_complex_asin) -define_math_op(sexp_acos, acos, sexp_complex_acos) -define_math_op(sexp_atan, atan, sexp_complex_math_error) -define_math_op(sexp_round, round, sexp_complex_math_error) -define_math_op(sexp_trunc, trunc, sexp_complex_math_error) -define_math_op(sexp_floor, floor, sexp_complex_math_error) -define_math_op(sexp_ceiling, ceil, sexp_complex_math_error) +define_math_op(sexp_exp, exp, 1, sexp_complex_exp) +define_math_op(sexp_log, log, 1, sexp_complex_log) +define_math_op(sexp_sin, sin, 1, sexp_complex_sin) +define_math_op(sexp_cos, cos, 1, sexp_complex_cos) +define_math_op(sexp_tan, tan, 1, sexp_complex_tan) +define_math_op(sexp_asin, asin, 1, sexp_complex_asin) +define_math_op(sexp_acos, acos, 1, sexp_complex_acos) +define_math_op(sexp_atan, atan, 1, sexp_complex_atan) +define_math_op(sexp_round, round, 0, sexp_complex_dummy) +define_math_op(sexp_trunc, trunc, 0, sexp_complex_dummy) +define_math_op(sexp_floor, floor, 0, sexp_complex_dummy) +define_math_op(sexp_ceiling, ceil, 0, sexp_complex_dummy) static sexp sexp_sqrt (sexp ctx sexp_api_params(self, n), sexp z) { int negativep = 0; @@ -1194,7 +1195,7 @@ static sexp sexp_sqrt (sexp ctx sexp_api_params(self, n), sexp z) { d = (double)sexp_unbox_fixnum(z); maybe_convert_bignum(z) /* XXXX add bignum sqrt */ maybe_convert_ratio(z) /* XXXX add ratio sqrt */ - maybe_convert_complex(z, sexp_complex_sqrt) + maybe_convert_complex(z, 1, sexp_complex_sqrt) else return sexp_type_exception(ctx, self, SEXP_NUMBER, z); sexp_gc_preserve1(ctx, res); @@ -1236,6 +1237,10 @@ sexp sexp_generic_expt (sexp ctx, sexp x, sexp_sint_t e) { static sexp sexp_expt_op (sexp ctx sexp_api_params(self, n), sexp x, sexp e) { long double f, x1, e1; sexp res; +#if SEXP_USE_COMPLEX + if (sexp_complexp(x) || sexp_complexp(e)) + return sexp_complex_expt(ctx, x, e); +#endif #if SEXP_USE_BIGNUMS if (sexp_bignump(e)) { /* bignum exponent needs special handling */ if ((x == SEXP_ZERO) || (x == SEXP_NEG_ONE)) @@ -1264,10 +1269,6 @@ static sexp sexp_expt_op (sexp ctx sexp_api_params(self, n), sexp x, sexp e) { x1 = sexp_ratio_to_double(x); } } -#endif -#if SEXP_USE_COMPLEX - else if (sexp_complexp(x)) - return sexp_generic_expt(ctx, x, sexp_unbox_fixnum(e)); #endif else return sexp_type_exception(ctx, self, SEXP_FIXNUM, x); diff --git a/include/chibi/bignum.h b/include/chibi/bignum.h index 82950294..1e3d3703 100644 --- a/include/chibi/bignum.h +++ b/include/chibi/bignum.h @@ -49,11 +49,14 @@ sexp sexp_complex_normalize (sexp real); sexp sexp_complex_math_error (sexp ctx, sexp z); sexp sexp_complex_sqrt (sexp ctx, sexp z); sexp sexp_complex_exp (sexp ctx, sexp z); +sexp sexp_complex_expt (sexp ctx, sexp a, sexp b); sexp sexp_complex_log (sexp ctx, sexp z); sexp sexp_complex_sin (sexp ctx, sexp z); sexp sexp_complex_cos (sexp ctx, sexp z); +sexp sexp_complex_tan (sexp ctx, sexp z); sexp sexp_complex_asin (sexp ctx, sexp z); sexp sexp_complex_acos (sexp ctx, sexp z); +sexp sexp_complex_atan (sexp ctx, sexp z); #endif #endif /* ! SEXP_BIGNUM_H */ diff --git a/opt/bignum.c b/opt/bignum.c index 5b38389f..4d6522e2 100644 --- a/opt/bignum.c +++ b/opt/bignum.c @@ -597,8 +597,19 @@ static double sexp_to_double (sexp x) { return 0.0; } -sexp sexp_complex_math_error (sexp ctx, sexp z) { - return sexp_type_exception(ctx, NULL, SEXP_NUMBER, z); +static sexp sexp_to_complex (sexp ctx, sexp x) { + sexp_gc_var1(tmp); + if (sexp_flonump(x) || sexp_fixnump(x) || sexp_bignump(x)) { + return sexp_make_complex(ctx, x, SEXP_ZERO); + } else if (sexp_ratiop(x)) { + sexp_gc_preserve1(ctx, tmp); + tmp = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO); + sexp_complex_real(tmp) = sexp_make_flonum(ctx, sexp_to_double(x)); + sexp_gc_release1(ctx); + return tmp; + } else { + return x; + } } sexp sexp_complex_sqrt (sexp ctx, sexp z) { @@ -626,6 +637,17 @@ sexp sexp_complex_exp (sexp ctx, sexp z) { return res; } +sexp sexp_complex_expt (sexp ctx, sexp a, sexp b) { + sexp_gc_var1(res); + sexp_gc_preserve1(ctx, res); + res = sexp_to_complex(ctx, a); + res = sexp_complex_log(ctx, res); + res = sexp_mul(ctx, b, res); + res = sexp_complex_exp(ctx, res); + sexp_gc_release1(ctx); + return res; +} + sexp sexp_complex_log (sexp ctx, sexp z) { double x = sexp_to_double(sexp_complex_real(z)), y = sexp_to_double(sexp_complex_imag(z)); @@ -662,6 +684,17 @@ sexp sexp_complex_cos (sexp ctx, sexp z) { return res; } +sexp sexp_complex_tan (sexp ctx, sexp z) { + sexp res; + sexp_gc_var2(sin, cos); + sexp_gc_preserve2(ctx, sin, cos); + sin = sexp_complex_sin(ctx, z); + cos = sexp_complex_cos(ctx, z); + res = sexp_complex_div(ctx, sin, cos); + sexp_gc_release2(ctx); + return res; +} + sexp sexp_complex_asin (sexp ctx, sexp z) { sexp_gc_var2(res, tmp); sexp_gc_preserve2(ctx, res, tmp); @@ -694,6 +727,25 @@ sexp sexp_complex_acos (sexp ctx, sexp z) { return res; } +sexp sexp_complex_atan (sexp ctx, sexp z) { + sexp_gc_var3(res, tmp1, tmp2); + sexp_gc_preserve3(ctx, res, tmp1, tmp2); + tmp1 = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ONE); + tmp1 = sexp_complex_mul(ctx, z, tmp1); + res = sexp_make_complex(ctx, SEXP_ONE, SEXP_ZERO); + res = sexp_complex_sub(ctx, res, tmp1); + res = sexp_complex_log(ctx, res); + tmp2 = sexp_make_complex(ctx, SEXP_ONE, SEXP_ZERO); + tmp2 = sexp_complex_add(ctx, tmp2, tmp1); + tmp2 = sexp_complex_log(ctx, tmp2); + res = sexp_complex_sub(ctx, res, tmp2); + tmp1 = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ONE); + sexp_complex_imag(tmp1) = sexp_make_flonum(ctx, 0.5); + res = sexp_complex_mul(ctx, res, tmp1); + sexp_gc_release2(ctx); + return res; +} + #endif #endif