From 5ab99635c51d24d3309af8bcf277ff9cd2ecea0a Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Wed, 11 May 2016 23:19:22 +0900
Subject: [PATCH] Corner cases in complex infinities.  Fixes issue #331.

---
 eval.c          |  8 ++++++--
 lib/srfi/38.scm |  5 ++++-
 sexp.c          | 24 +++++++++++++++++++++---
 3 files changed, 31 insertions(+), 6 deletions(-)

diff --git a/eval.c b/eval.c
index a795e707..dfea2a28 100644
--- a/eval.c
+++ b/eval.c
@@ -1755,7 +1755,7 @@ sexp sexp_inexact_to_exact (sexp ctx, sexp self, sexp_sint_t n, sexp z) {
 #if SEXP_USE_FLONUMS
   else if (sexp_flonump(z)) {
     if (isinf(sexp_flonum_value(z)) || isnan(sexp_flonum_value(z))) {
-      res = sexp_xtype_exception(ctx, self, "exact: not an finite number", z);
+      res = sexp_xtype_exception(ctx, self, "exact: not a finite number", z);
     } else if (sexp_flonum_value(z) != trunc(sexp_flonum_value(z))) {
 #if SEXP_USE_RATIOS
       res = sexp_double_to_ratio(ctx, sexp_flonum_value(z));
@@ -1778,7 +1778,11 @@ sexp sexp_inexact_to_exact (sexp ctx, sexp self, sexp_sint_t n, sexp z) {
     res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO);
     sexp_complex_real(res) = sexp_inexact_to_exact(ctx, self, 1, sexp_complex_real(z));
     sexp_complex_imag(res) = sexp_inexact_to_exact(ctx, self, 1, sexp_complex_imag(z));
-    if (sexp_complex_imag(res) == SEXP_ZERO)
+    if (sexp_exceptionp(sexp_complex_real(res)))
+      res = sexp_complex_real(res);
+    else if (sexp_exceptionp(sexp_complex_imag(res)))
+      res = sexp_complex_imag(res);
+    else if (sexp_complex_imag(res) == SEXP_ZERO)
       res = sexp_complex_real(res);
     sexp_gc_release1(ctx);
   }
diff --git a/lib/srfi/38.scm b/lib/srfi/38.scm
index a7097bf3..91e0bf20 100644
--- a/lib/srfi/38.scm
+++ b/lib/srfi/38.scm
@@ -369,7 +369,10 @@
             ((#\o) (read-char in) (read-number 8))
             ((#\b) (read-char in) (read-number 2))
             ((#\i) (read-char in) (exact->inexact (read-one in)))
-            ((#\e) (string->number (read-name #\# in)))
+            ((#\e)
+             (let ((s (read-name #\# in)))
+               (or (string->number s)
+                   (read-one (open-input-string (substring s 2))))))
             ((#\u #\v)
              (if (eqv? #\v (peek-char in))
                  (read-char in))
diff --git a/sexp.c b/sexp.c
index 3be5029c..8903fa8e 100644
--- a/sexp.c
+++ b/sexp.c
@@ -2365,6 +2365,8 @@ sexp sexp_read_polar_tail (sexp ctx, sexp in, sexp magnitude) {
     sexp_complex_real(res) = sexp_mul(ctx, magnitude, sexp_complex_real(res));
     sexp_complex_imag(res) = sexp_sin(ctx, NULL, 1, theta);
     sexp_complex_imag(res) = sexp_mul(ctx, magnitude, sexp_complex_imag(res));
+    if (sexp_exceptionp(sexp_complex_real(res))) res = sexp_complex_real(res);
+    if (sexp_exceptionp(sexp_complex_imag(res))) res = sexp_complex_imag(res);
   }
   sexp_gc_release2(ctx);
   return sexp_complex_normalize(res);
@@ -2550,9 +2552,21 @@ sexp sexp_read_number (sexp ctx, sexp in, int base, int exactp) {
     sexp_gc_preserve2(ctx, res, den);
     res = sexp_make_fixnum(negativep ? -val : val);
     den = sexp_read_number(ctx, in, base, 0);
-    if (sexp_flonump(den)) den = sexp_make_fixnum(sexp_flonum_value(den));
-    den = sexp_expt(ctx, SEXP_TEN, den);
-    res = sexp_mul(ctx, res, den);
+    if (sexp_exceptionp(den)) {
+      res = den;
+    } else {
+      if (sexp_flonump(den)) den = sexp_make_fixnum(sexp_flonum_value(den));
+      if (sexp_complexp(den)) {
+        if (sexp_flonump(sexp_complex_real(den)))
+          sexp_complex_real(den) = sexp_make_fixnum(sexp_flonum_value(sexp_complex_real(den)));
+        sexp_complex_real(den) = sexp_expt(ctx, SEXP_TEN, sexp_complex_real(den));
+        sexp_complex_real(den) = sexp_mul(ctx, res, sexp_complex_real(den));
+        res = den;
+      } else {
+        den = sexp_expt(ctx, SEXP_TEN, den);
+        res = sexp_mul(ctx, res, den);
+      }
+    }
     sexp_gc_release2(ctx);
     return res;
   } else if (c=='.' || is_precision_indicator(c)) {
@@ -3147,6 +3161,10 @@ sexp sexp_read_raw (sexp ctx, sexp in, sexp *shares) {
             res = tmp;
           } else if ((str[6] == 'i' || str[6] == 'I') && str[7] == 0) {
             res = sexp_make_complex(ctx, SEXP_ZERO, tmp);
+          } else if (str[6] == '@') {
+            res = sexp_substring_cursor(ctx, res, sexp_make_string_cursor(6), SEXP_FALSE);
+            res = sexp_open_input_string(ctx, res);
+            res = sexp_read_polar_tail(ctx, res, tmp);
           } else if (str[6] == '+' || str[6] == '-') {
             res = sexp_substring_cursor(ctx, res, sexp_make_string_cursor(6), SEXP_FALSE);
             res = sexp_string_to_number(ctx, res, SEXP_TEN);