More complex number additions.

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)             \
+#define maybe_convert_complex(z, t, f)                                  \
-  else if (sexp_complexp(z)) return sexp_complex_normalize(f(ctx, z));
+  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_exp, exp, 1, sexp_complex_exp)
-define_math_op(sexp_log, log, sexp_complex_log)
+define_math_op(sexp_log, log, 1, sexp_complex_log)
-define_math_op(sexp_sin, sin, sexp_complex_sin)
+define_math_op(sexp_sin, sin, 1, sexp_complex_sin)
-define_math_op(sexp_cos, cos, sexp_complex_cos)
+define_math_op(sexp_cos, cos, 1, sexp_complex_cos)
-define_math_op(sexp_tan, tan, sexp_complex_math_error)
+define_math_op(sexp_tan, tan, 1, sexp_complex_tan)
-define_math_op(sexp_asin, asin, sexp_complex_asin)
+define_math_op(sexp_asin, asin, 1, sexp_complex_asin)
-define_math_op(sexp_acos, acos, sexp_complex_acos)
+define_math_op(sexp_acos, acos, 1, sexp_complex_acos)
-define_math_op(sexp_atan, atan, sexp_complex_math_error)
+define_math_op(sexp_atan, atan, 1, sexp_complex_atan)
-define_math_op(sexp_round, round, sexp_complex_math_error)
+define_math_op(sexp_round, round, 0, sexp_complex_dummy)
-define_math_op(sexp_trunc, trunc, sexp_complex_math_error)
+define_math_op(sexp_trunc, trunc, 0, sexp_complex_dummy)
-define_math_op(sexp_floor, floor, sexp_complex_math_error)
+define_math_op(sexp_floor, floor, 0, sexp_complex_dummy)
-define_math_op(sexp_ceiling, ceil, sexp_complex_math_error)
+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);

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 */

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) {
+static sexp sexp_to_complex (sexp ctx, sexp x) {
-  return sexp_type_exception(ctx, NULL, SEXP_NUMBER, z);
+  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