initial complex number support

eval.c

@@ -1177,23 +1177,53 @@ define_math_op(sexp_floor, floor)
 define_math_op(sexp_ceiling, ceil)
 
 static sexp sexp_sqrt (sexp ctx sexp_api_params(self, n), sexp z) {
+  int negativep;
   double d, r;
+  sexp_gc_var1(res);
   if (sexp_flonump(z))
     d = sexp_flonum_value(z);
   else if (sexp_fixnump(z))
     d = (double)sexp_unbox_fixnum(z);
   maybe_convert_bignum(z)       /* XXXX add bignum sqrt */
+  maybe_convert_ratio(z)        /* XXXX add ratio sqrt */
   else
     return sexp_type_exception(ctx, self, SEXP_NUMBER, z);
+  sexp_gc_preserve1(ctx, res);
+#if SEXP_USE_COMPLEX
+  if (d < 0) {
+    negativep = 1;
+    d = -d;
+  }
+#endif
   r = sqrt(d);
-  if (sexp_fixnump(z) && (((sexp_uint_t)r*(sexp_uint_t)r)==sexp_unbox_fixnum(z)))
+  if (sexp_fixnump(z)
-    return sexp_make_fixnum(round(r));
+      && (((sexp_uint_t)r*(sexp_uint_t)r)==abs(sexp_unbox_fixnum(z))))
+    res = sexp_make_fixnum(round(r));
   else
-    return sexp_make_flonum(ctx, r);
+    res = sexp_make_flonum(ctx, r);
+#if SEXP_USE_COMPLEX
+  if (negativep)
+    res = sexp_make_complex(ctx, SEXP_ZERO, res);
+#endif
+  sexp_gc_release1(ctx);
+  return res;
 }
 
 #endif
 
+#if SEXP_USE_RATIOS
+sexp sexp_generic_expt (sexp ctx, sexp x, sexp_sint_t e) {
+  sexp_gc_var2(res, tmp);
+  sexp_gc_preserve2(ctx, res, tmp);
+  for (res = SEXP_ONE, tmp = x; e > 0; e >>= 1) {
+    if (e&1) res = sexp_mul(ctx, res, tmp);
+    tmp = sexp_mul(ctx, tmp, tmp);
+  }
+  sexp_gc_release2(ctx);
+  return res;
+}
+#endif
+
 static sexp sexp_expt_op (sexp ctx sexp_api_params(self, n), sexp x, sexp e) {
   long double f, x1, e1;
   sexp res;
@@ -1216,6 +1246,19 @@ static sexp sexp_expt_op (sexp ctx sexp_api_params(self, n), sexp x, sexp e) {
 #if SEXP_USE_FLONUMS
   else if (sexp_flonump(x))
     x1 = sexp_flonum_value(x);
+#endif
+#if SEXP_USE_RATIOS
+  else if (sexp_ratiop(x)) {
+    if (sexp_fixnump(e)) {
+      return sexp_generic_expt(ctx, x, sexp_unbox_fixnum(e));
+    } else {
+      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);
@@ -1224,6 +1267,10 @@ static sexp sexp_expt_op (sexp ctx sexp_api_params(self, n), sexp x, sexp e) {
 #if SEXP_USE_FLONUMS
   else if (sexp_flonump(e))
     e1 = sexp_flonum_value(e);
+#endif
+#if SEXP_USE_RATIOS
+  else if (sexp_ratiop(e))
+    e1 = sexp_ratio_to_double(e);
 #endif
   else
     return sexp_type_exception(ctx, self, SEXP_FIXNUM, e);
@@ -1262,6 +1309,17 @@ static sexp sexp_ratio_denominator_op (sexp ctx sexp_api_params(self, n), sexp r
 }
 #endif
 
+#if SEXP_USE_COMPLEX
+static sexp sexp_complex_real_op (sexp ctx sexp_api_params(self, n), sexp cpx) {
+  sexp_assert_type(ctx, sexp_complexp, SEXP_COMPLEX, cpx);
+  return sexp_complex_real(cpx);
+}
+static sexp sexp_complex_imag_op (sexp ctx sexp_api_params(self, n), sexp cpx) {
+  sexp_assert_type(ctx, sexp_complexp, SEXP_COMPLEX, cpx);
+  return sexp_complex_imag(cpx);
+}
+#endif
+
 static sexp sexp_string_cmp_op (sexp ctx sexp_api_params(self, n), sexp str1, sexp str2, sexp ci) {
   sexp_sint_t len1, len2, len, diff;
   sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, str1);
@@ -1805,6 +1863,9 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
 #if SEXP_USE_AUTO_FORCE
   sexp_push(ctx, tmp, sym=sexp_intern(ctx, "auto-force", -1));
 #endif
+#if SEXP_USE_COMPLEX
+  sexp_push(ctx, tmp, sym=sexp_intern(ctx, "complex", -1));
+#endif
 #if SEXP_USE_RATIOS
   sexp_push(ctx, tmp, sym=sexp_intern(ctx, "ratios", -1));
 #endif

include/chibi/bignum.h

@@ -43,6 +43,10 @@ double sexp_ratio_to_double (sexp rat);
 sexp sexp_make_ratio (sexp ctx, sexp num, sexp den);
 sexp sexp_ratio_normalize (sexp ctx, sexp rat, sexp in);
 #endif
+#if SEXP_USE_COMPLEX
+sexp sexp_make_complex (sexp ctx, sexp real, sexp image);
+sexp sexp_complex_normalize (sexp real);
+#endif
 
 #endif  /* ! SEXP_BIGNUM_H */
 

include/chibi/features.h

@@ -365,17 +365,16 @@
 #define SEXP_USE_RATIOS ! SEXP_USE_NO_FEATURES
 #endif
 
-/* #ifndef SEXP_USE_COMPLEX */
+#ifndef SEXP_USE_COMPLEX
-/* #define SEXP_USE_COMPLEX ! SEXP_USE_NO_FEATURES */
+#define SEXP_USE_COMPLEX ! SEXP_USE_NO_FEATURES
-/* #endif */
+#endif
-#define SEXP_USE_COMPLEX 0
 
 #ifndef SEXP_USE_BIGNUMS
 #define SEXP_USE_BIGNUMS (SEXP_USE_RATIOS || SEXP_USE_COMPLEX)
 #endif
 
 #ifndef SEXP_USE_FLONUMS
-#define SEXP_USE_FLONUMS ! SEXP_USE_NO_FEATURES
+#define SEXP_USE_FLONUMS (SEXP_USE_COMPLEX || ! SEXP_USE_NO_FEATURES)
 #endif
 
 #ifndef SEXP_USE_INFINITIES

lib/init.scm

@@ -961,10 +961,19 @@
         lo
         (lp (if (< (car ls) lo) (car ls) lo) (cdr ls)))))
 
-(define (real-part z) z)
+(cond-expand
-(define (imag-part z) 0.0)
+ (complex
-(define magnitude abs)
+  (define (real-part z) (if (complex? z) (complex-real z) z))
-(define (angle z) (if (< z 0) 3.141592653589793 0))
+  (define (imag-part z) (if (complex? z) (complex-imag z) 0.0))
+  (define (magnitude z)
+    (sqrt (+ (* (real-part z) (real-part z))
+             (* (imag-part z) (imag-part z)))))
+  (define (angle z) (atan (imag-part z) (real-part z))))
+ (else
+  (define (real-part z) z)
+  (define (imag-part z) 0.0)
+  (define magnitude abs)
+  (define (angle z) (if (< z 0) 3.141592653589793 0))))
 
 (define (atan x . o) (if (null? o) (atan1 x) (atan1 (/ x (car o)))))
 

opcodes.c

@@ -87,6 +87,11 @@ _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJ
 _FN1(_I(SEXP_FIXNUM), _I(SEXP_RATIO), "ratio-numerator", 0, sexp_ratio_numerator_op),
 _FN1(_I(SEXP_FIXNUM), _I(SEXP_RATIO), "ratio-denominator", 0, sexp_ratio_denominator_op),
 #endif
+#if SEXP_USE_COMPLEX
+_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "complex?", _I(SEXP_COMPLEX), 0),
+_FN1(_I(SEXP_FLONUM), _I(SEXP_RATIO), "complex-real", 0, sexp_complex_real_op),
+_FN1(_I(SEXP_FLONUM), _I(SEXP_RATIO), "complex-imag", 0, sexp_complex_imag_op),
+#endif
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "closure?", _I(SEXP_PROCEDURE), 0),
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "opcode?", _I(SEXP_OPCODE), 0),
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "input-port?", _I(SEXP_IPORT), 0),

opt/bignum.c

@@ -515,6 +515,62 @@ sexp sexp_ratio_compare (sexp ctx, sexp a, sexp b) {
 
 #endif
 
+/************************ complex numbers ****************************/
+
+#if SEXP_USE_COMPLEX
+
+sexp sexp_complex_add (sexp ctx, sexp a, sexp b) {
+  sexp_gc_var3(res, real, imag);
+  sexp_gc_preserve3(ctx, res, real, imag);
+  real = sexp_add(ctx, sexp_complex_real(a), sexp_complex_real(b));
+  imag = sexp_add(ctx, sexp_complex_imag(a), sexp_complex_imag(b));
+  res = sexp_make_complex(ctx, real, imag);
+  sexp_gc_release3(ctx);
+  return sexp_complex_normalize(res);
+}
+
+sexp sexp_complex_mul (sexp ctx, sexp a, sexp b) {
+  sexp_gc_var3(res, real, imag);
+  sexp_gc_preserve3(ctx, res, real, imag);
+  real = sexp_mul(ctx, sexp_complex_real(a), sexp_complex_real(b));
+  res = sexp_mul(ctx, sexp_complex_imag(a), sexp_complex_imag(b));
+  real = sexp_sub(ctx, real, res);
+  imag = sexp_mul(ctx, sexp_complex_real(a), sexp_complex_imag(b));
+  res = sexp_mul(ctx, sexp_complex_imag(a), sexp_complex_real(b));
+  imag = sexp_add(ctx, imag, res);
+  res = sexp_make_complex(ctx, real, imag);
+  sexp_gc_release3(ctx);
+  return sexp_complex_normalize(res);
+}
+
+/* (a + bi)    (ac + bd)      (bc - ad)    */
+/* -------- = -----------  + ----------- i */
+/* (c + di)   (c^2 + d^2)    (c^2 + d^2)   */
+
+sexp sexp_complex_div (sexp ctx, sexp a, sexp b) {
+  sexp_gc_var4(res, real, imag, denom);
+  sexp_gc_preserve4(ctx, res, real, imag, denom);
+  /* c^2 + d^2 */
+  denom = sexp_mul(ctx, sexp_complex_real(b), sexp_complex_real(b));
+  res = sexp_mul(ctx, sexp_complex_imag(b), sexp_complex_imag(b));
+  denom = sexp_add(ctx, denom, res);
+  /* ac + bd */
+  real = sexp_mul(ctx, sexp_complex_real(a), sexp_complex_real(b));
+  res = sexp_mul(ctx, sexp_complex_imag(a), sexp_complex_imag(b));
+  real = sexp_add(ctx, real, res);
+  real = sexp_div(ctx, real, denom);
+  /* bc - ad */
+  imag = sexp_mul(ctx, sexp_complex_imag(a), sexp_complex_real(b));
+  res = sexp_mul(ctx, sexp_complex_real(a), sexp_complex_imag(b));
+  imag = sexp_sub(ctx, imag, res);
+  imag = sexp_div(ctx, imag, denom);
+  res = sexp_make_complex(ctx, real, imag);
+  sexp_gc_release4(ctx);
+  return sexp_complex_normalize(res);
+}
+
+#endif
+
 /****************** generic arithmetic ************************/
 
 enum sexp_number_types {
@@ -613,6 +669,9 @@ sexp sexp_add (sexp ctx, sexp a, sexp b) {
   case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
 #if SEXP_USE_RATIOS
   case SEXP_NUM_NOT_RAT:
+#endif
+#if SEXP_USE_COMPLEX
+  case SEXP_NUM_NOT_CPX:
 #endif
     r = sexp_type_exception(ctx, NULL, SEXP_NUMBER, a);
     break;
@@ -645,6 +704,19 @@ sexp sexp_add (sexp ctx, sexp a, sexp b) {
   case SEXP_NUM_RAT_RAT:
     r = sexp_ratio_add(ctx, a, b);
     break;
+#endif
+#if SEXP_USE_COMPLEX
+  case SEXP_NUM_RAT_CPX:
+    a = tmp = sexp_make_flonum(ctx, sexp_ratio_to_double(a));
+    /* ... FALLTHROUGH ... */
+  case SEXP_NUM_FLO_CPX:
+  case SEXP_NUM_FIX_CPX:
+  case SEXP_NUM_BIG_CPX:
+    a = tmp = sexp_make_complex(ctx, a, SEXP_ZERO);
+    /* ... FALLTHROUGH ... */
+  case SEXP_NUM_CPX_CPX:
+    r = sexp_complex_add(ctx, a, b);
+    break;
 #endif
   }
   sexp_gc_release1(ctx);
@@ -661,12 +733,18 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
   case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
 #if SEXP_USE_RATIOS
   case SEXP_NUM_NOT_RAT:
+#endif
+#if SEXP_USE_COMPLEX
+  case SEXP_NUM_NOT_CPX:
 #endif
     r = sexp_type_exception(ctx, NULL, SEXP_NUMBER, a);
     break;
   case SEXP_NUM_FIX_NOT: case SEXP_NUM_FLO_NOT: case SEXP_NUM_BIG_NOT:
 #if SEXP_USE_RATIOS
   case SEXP_NUM_RAT_NOT:
+#endif
+#if SEXP_USE_COMPLEX
+  case SEXP_NUM_CPX_NOT:
 #endif
     r = sexp_type_exception(ctx, NULL, SEXP_NUMBER, b);
     break;
@@ -729,6 +807,40 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
       }
     }
     break;
+#endif
+#if SEXP_USE_COMPLEX
+  case SEXP_NUM_RAT_CPX:
+    a = tmp1 = sexp_make_flonum(ctx, sexp_ratio_to_double(a));
+    goto complex_sub;
+  case SEXP_NUM_CPX_RAT:
+    b = tmp1 = sexp_make_flonum(ctx, sexp_ratio_to_double(b));
+    /* ... FALLTHROUGH ... */
+  case SEXP_NUM_CPX_FLO:
+  case SEXP_NUM_CPX_FIX:
+  case SEXP_NUM_CPX_BIG:
+    tmp1 = a; a = b; b = tmp1;
+    negatep = 1;
+    /* ... FALLTHROUGH ... */
+  case SEXP_NUM_FLO_CPX:
+  case SEXP_NUM_FIX_CPX:
+  case SEXP_NUM_BIG_CPX:
+    a = tmp1 = sexp_make_complex(ctx, a, SEXP_ZERO);
+    /* ... FALLTHROUGH ... */
+  case SEXP_NUM_CPX_CPX:
+  complex_sub:
+    tmp2 = sexp_make_complex(ctx, sexp_complex_real(b), sexp_complex_imag(b));
+    sexp_negate(sexp_complex_real(tmp2));
+    sexp_negate(sexp_complex_imag(tmp2));
+    r = sexp_complex_add(ctx, a, tmp2);
+    if (negatep) {
+      if (sexp_complexp(r)) {
+        sexp_negate(sexp_complex_real(r));
+        sexp_negate(sexp_complex_imag(r));
+      } else {
+        sexp_negate(r);
+      }
+    }
+    break;
 #endif
   }
   sexp_gc_release2(ctx);
@@ -779,6 +891,18 @@ sexp sexp_mul (sexp ctx, sexp a, sexp b) {
   case SEXP_NUM_RAT_RAT:
     r = sexp_ratio_mul(ctx, a, b);
     break;
+#endif
+#if SEXP_USE_COMPLEX
+  case SEXP_NUM_RAT_CPX:
+    a = tmp = sexp_make_flonum(ctx, sexp_ratio_to_double(a));
+  case SEXP_NUM_FLO_CPX:
+  case SEXP_NUM_FIX_CPX:
+  case SEXP_NUM_BIG_CPX:
+    a = tmp = sexp_make_complex(ctx, a, SEXP_ZERO);
+    /* ... FALLTHROUGH ... */
+  case SEXP_NUM_CPX_CPX:
+    r = sexp_complex_mul(ctx, a, b);
+    break;
 #endif
   }
   sexp_gc_release1(ctx);
@@ -857,6 +981,26 @@ sexp sexp_div (sexp ctx, sexp a, sexp b) {
   case SEXP_NUM_RAT_RAT:
     r = sexp_ratio_div(ctx, a, b);
     break;
+#endif
+#if SEXP_USE_COMPLEX
+  case SEXP_NUM_CPX_RAT:
+    b = tmp = sexp_make_flonum(ctx, sexp_ratio_to_double(b));
+  case SEXP_NUM_CPX_FLO:
+  case SEXP_NUM_CPX_FIX:
+  case SEXP_NUM_CPX_BIG:
+    b = tmp = sexp_make_complex(ctx, b, SEXP_ZERO);
+  case SEXP_NUM_RAT_CPX:
+    if (sexp_ratiop(a))
+      a = tmp = sexp_make_flonum(ctx, sexp_ratio_to_double(a));
+  case SEXP_NUM_FLO_CPX:
+  case SEXP_NUM_FIX_CPX:
+  case SEXP_NUM_BIG_CPX:
+    if (!sexp_complexp(a))
+      a = tmp = sexp_make_complex(ctx, a, SEXP_ZERO);
+    /* ... FALLTHROUGH ... */
+  case SEXP_NUM_CPX_CPX:
+    r = sexp_complex_div(ctx, a, b);
+    break;
 #endif
   }
   sexp_gc_release2(ctx);
@@ -880,12 +1024,19 @@ sexp sexp_quotient (sexp ctx, sexp a, sexp b) {
 #if SEXP_USE_RATIOS
   case SEXP_NUM_FLO_RAT: case SEXP_NUM_RAT_FIX: case SEXP_NUM_RAT_FLO:
   case SEXP_NUM_RAT_BIG: case SEXP_NUM_RAT_RAT:
+#endif
+#if SEXP_USE_COMPLEX
+  case SEXP_NUM_FLO_CPX: case SEXP_NUM_CPX_FIX: case SEXP_NUM_CPX_FLO:
+  case SEXP_NUM_CPX_BIG: case SEXP_NUM_CPX_RAT: case SEXP_NUM_CPX_CPX:
 #endif
     r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, a);
     break;
   case SEXP_NUM_FIX_FLO: case SEXP_NUM_BIG_FLO:
 #if SEXP_USE_RATIOS
   case SEXP_NUM_FIX_RAT: case SEXP_NUM_BIG_RAT:
+#endif
+#if SEXP_USE_COMPLEX
+  case SEXP_NUM_FIX_CPX: case SEXP_NUM_BIG_CPX:
 #endif
     r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, b);
     break;
@@ -923,12 +1074,19 @@ sexp sexp_remainder (sexp ctx, sexp a, sexp b) {
 #if SEXP_USE_RATIOS
   case SEXP_NUM_FLO_RAT: case SEXP_NUM_RAT_FIX: case SEXP_NUM_RAT_FLO:
   case SEXP_NUM_RAT_BIG: case SEXP_NUM_RAT_RAT:
+#endif
+#if SEXP_USE_COMPLEX
+  case SEXP_NUM_FLO_CPX: case SEXP_NUM_CPX_FIX: case SEXP_NUM_CPX_FLO:
+  case SEXP_NUM_CPX_BIG: case SEXP_NUM_CPX_RAT: case SEXP_NUM_CPX_CPX:
 #endif
     r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, a);
     break;
   case SEXP_NUM_FIX_FLO: case SEXP_NUM_BIG_FLO:
 #if SEXP_USE_RATIOS
   case SEXP_NUM_FIX_RAT: case SEXP_NUM_BIG_RAT:
+#endif
+#if SEXP_USE_COMPLEX
+  case SEXP_NUM_FIX_CPX: case SEXP_NUM_BIG_CPX:
 #endif
     r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, b);
     break;
@@ -962,6 +1120,10 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
     switch ((at * SEXP_NUM_NUMBER_TYPES) + bt) {
     case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
     case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
+#if SEXP_USE_COMPLEX
+    case SEXP_NUM_CPX_CPX: case SEXP_NUM_CPX_FIX: case SEXP_NUM_CPX_RAT:
+    case SEXP_NUM_CPX_FLO: case SEXP_NUM_CPX_BIG:
+#endif
       r = sexp_type_exception(ctx, NULL, SEXP_NUMBER, a);
       break;
     case SEXP_NUM_FIX_FIX:

sexp.c

@@ -1591,35 +1591,103 @@ sexp sexp_read_symbol (sexp ctx, sexp in, int init, int internp) {
   return res;
 }
 
+#if SEXP_USE_COMPLEX
+sexp sexp_make_complex (sexp ctx, sexp real, sexp image) {
+  sexp res = sexp_alloc_type(ctx, complex, SEXP_COMPLEX);
+  sexp_complex_real(res) = real;
+  sexp_complex_imag(res) = image;
+  return res;
+}
+
+sexp sexp_complex_normalize (sexp cpx) {
+  return sexp_complexp(cpx)
+    && (sexp_complex_imag(cpx) == SEXP_ZERO
+        || (sexp_flonump(sexp_complex_imag(cpx))
+            && sexp_flonum_value(sexp_complex_imag(cpx)) == 0.0))
+    ? sexp_complex_real(cpx) : cpx;
+}
+
+sexp sexp_read_complex_tail (sexp ctx, sexp in, double real, int exactp) {
+  int c = sexp_read_char(ctx, in), c2;
+  sexp_gc_var1(res);
+  sexp_gc_preserve1(ctx, res);
+  if (c=='i' || c=='I') {
+  trailing_i:
+    c = sexp_read_char(ctx, in);
+    if ((c!=EOF) && ! is_separator(c))
+      res = sexp_read_error(ctx, "invalid complex numeric syntax", sexp_make_character(c), in);
+    else
+      sexp_push_char(ctx, c, in);
+    if (!sexp_exceptionp(res)) {
+      res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO);
+      sexp_complex_imag(res) = exactp ? sexp_make_fixnum(real) : sexp_make_flonum(ctx, real);
+    }
+  } else {
+    c2 = sexp_read_char(ctx, in);
+    if (c2=='i' || c2=='I') {
+      real = 1.0;
+      exactp = 1;
+      goto trailing_i;
+    } else {
+      sexp_push_char(ctx, c2, in);
+    }
+    if (c=='-') sexp_push_char(ctx, c, in);
+    res = sexp_read_number(ctx, in, 10);
+    if (sexp_complexp(res)) {
+      if (sexp_complex_real(res) == SEXP_ZERO)
+        sexp_complex_real(res) = (exactp ? sexp_make_fixnum(real) : sexp_make_flonum(ctx, real));
+      else
+        res = sexp_read_error(ctx, "multiple real parts of complex", res, in);
+    } else if ((res == SEXP_ZERO)
+               || (sexp_flonump(res) && sexp_flonum_value(res) == 0.0)) {
+      res = sexp_make_complex(ctx, (exactp ? sexp_make_fixnum(real) : sexp_make_flonum(ctx, real)), res);
+    } else {
+      res = sexp_exceptionp(res) ? res
+        : sexp_read_error(ctx, "missing imaginary part of complex", res, in);
+    }
+  }
+  sexp_gc_release1(ctx);
+  return sexp_complex_normalize(res);
+}
+#endif
+
 sexp sexp_read_float_tail (sexp ctx, sexp in, double whole, int negp) {
   sexp exponent=SEXP_VOID;
-  double res=0.0, scale=0.1, e=0.0;
+  double val=0.0, scale=0.1, e=0.0;
   int c;
   for (c=sexp_read_char(ctx, in);
        isdigit(c);
        c=sexp_read_char(ctx, in), scale*=0.1)
-    res += digit_value(c)*scale;
+    val += digit_value(c)*scale;
 #if SEXP_USE_PLACEHOLDER_DIGITS
   for (; c==SEXP_PLACEHOLDER_DIGIT; c=sexp_read_char(ctx, in), scale*=0.1)
-    res += sexp_placeholder_digit_value(10)*scale;
+    val += sexp_placeholder_digit_value(10)*scale;
 #endif
   if (c=='e' || c=='E') {
     exponent = sexp_read_number(ctx, in, 10);
     if (sexp_exceptionp(exponent)) return exponent;
     e = (sexp_fixnump(exponent) ? sexp_unbox_fixnum(exponent)
          : sexp_flonump(exponent) ? sexp_flonum_value(exponent) : 0.0);
-  } else if ((c!=EOF) && ! is_separator(c)) {
+  }
-    return sexp_read_error(ctx, "invalid numeric syntax",
+  val = (whole + val) * pow(10, e);
-                           sexp_make_character(c), in);
+  if (negp) val *= -1;
-  } else {
+  if (!(c=='e' || c=='E')) {
-    sexp_push_char(ctx, c, in);
+#if SEXP_USE_COMPLEX
+    if (c=='i' || c=='i' || c=='+' || c=='-') {
+      sexp_push_char(ctx, c, in);
+      return sexp_read_complex_tail(ctx, in, val, 0);
+    } else
+#endif
+    if ((c!=EOF) && ! is_separator(c))
+      return sexp_read_error(ctx, "invalid numeric syntax",
+                             sexp_make_character(c), in);
+    else
+      sexp_push_char(ctx, c, in);
   }
 #if SEXP_USE_FLONUMS
-  res = (whole + res) * pow(10, e);
+  return sexp_make_flonum(ctx, val);
-  if (negp) res *= -1;
-  return sexp_make_flonum(ctx, res);
 #else
-  return sexp_make_fixnum((sexp_uint_t)whole);
+  return sexp_make_fixnum((sexp_uint_t)val);
 #endif
 }
 
@@ -1676,6 +1744,10 @@ sexp sexp_read_number (sexp ctx, sexp in, int base) {
     c = sexp_read_char(ctx, in);
   }
 
+#if SEXP_USE_COMPLEX
+  if (c == 'i' || c == 'I') whole = 1.0;
+#endif
+
   for ( ; sexp_isxdigit(c); c=sexp_read_char(ctx, in)) {
     digit = digit_value(c);
     if ((digit < 0) || (digit >= base))
@@ -1733,6 +1805,13 @@ sexp sexp_read_number (sexp ctx, sexp in, int base) {
 #endif
     sexp_gc_release2(ctx);
     return res;
+#if SEXP_USE_COMPLEX
+  } else if (c=='i' || c=='I' || c=='+' || c=='-') {
+    if (base != 10)
+      return sexp_read_error(ctx, "found non-base 10 complex", SEXP_NULL, in);
+    sexp_push_char(ctx, c, in);
+    return sexp_read_complex_tail(ctx, in, (negativep ? -val : val), 1);
+#endif
   } else {
     if ((c!=EOF) && ! is_separator(c))
       return sexp_read_error(ctx, "invalid numeric syntax",
@@ -2068,6 +2147,12 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
         res = sexp_make_flonum(ctx, sexp_neg_infinity);
       else if (res == sexp_intern(ctx, "+nan.0", -1))
         res = sexp_make_flonum(ctx, sexp_nan);
+#endif
+#if SEXP_USE_COMPLEX
+      if (res == sexp_intern(ctx, "+i", -1))
+        res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ONE);
+      else if (res == sexp_intern(ctx, "-i", -1))
+        res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_NEG_ONE);
 #endif
     }
     break;