[PATCH] Improved exactness handling for complex number parsing

[Mark H Weaver]

This patch implements the ideas outlined in my response to Mike Gran's
recent post entitled "Effects of updated number fixes on parsing".

In brief, it modifies scm_i_string_to_number to apply exactness
specifiers to each component _before_ calling scm_make_rectangular or
scm_make_polar, as is done in PLT Scheme.  Previously, the exactness
specifiers were applied to the complex number itself.

It also arranges for address@hidden and address@hidden to become 0.0+0.0i
instead of +nan.0+nan.0, by changing scm_c_make_polar.

Previously, all of the examples below were parsed as 0.0.
The table below shows the new behavior:

  address@hidden      : -0.0+0.0i
  address@hidden     : -0.0+0.0i
  address@hidden     : -0.0-0.0i
  address@hidden :  0.0+0.0i
  address@hidden :  0.0+0.0i
  address@hidden :  0.0+0.0i
  address@hidden :  0.0+0.0i

For more details, see the commit log entry.

     Best,
      Mark

>From c82a1303ace371f8a487f6017c1d935395ad6eec Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Thu, 3 Feb 2011 02:08:26 -0500
Subject: [PATCH] Improved exactness handling for complex number parsing

When parsing non-real complex numbers, apply exactness specifiers on
per-component basis, as is done in PLT Scheme.  For complex numbers
written in rectangular form, exactness specifiers are applied to the
real and imaginary parts before calling scm_make_rectangular.  For
complex numbers written in polar form, exactness specifiers are applied
to the magnitude and angle before calling scm_make_polar.

There are two kinds of exactness specifiers: forced and implicit.  A
forced exactness specifier is a "#e" or "#i" prefix at the beginning of
the entire number, and applies to both components of a complex number.
"#e" causes each component to be made exact, and "#i" causes each
component to be made inexact.  If no forced exactness specifier is
present, then the exactness of each component is determined
independently by the presence or absence of a decimal point or hash mark
within that component.  If a decimal point or hash mark is present, the
component is made inexact, otherwise it is made exact.

After the exactness specifiers have been applied to each component, they
are passed to either scm_make_rectangular or scm_make_polar to produce
the final result.  Note that this will result in a real number if the
imaginary part, magnitude, or angle is an exact 0.

Previously, both forced and implicit exactness specifiers applied to
the number as a whole _after_ calling scm_make_rectangular or
scm_make_polar.

For example, (string->number "#i5.0+0i") now does the equivalent of:

  (make-rectangular (exact->inexact 5.0) (exact->inexact 0))

which yields 5.0+0.0i.  Previously it did the equivalent of:

  (exact->inexact (make-rectangular 5.0 0))

which yielded 5.0.

* libguile/numbers.c (mem2ureal): Receive a forced exactness specifier
  (forced_x), create and maintain our own implicit exactness specifier
  flag local to this component (implicit_x), and apply these exactness
  specifiers within this function.  Previously, we received a pointer to
  an implicit exactness specifier flag from above, and the exactness
  specifiers were applied from within scm_i_string_length.

  (mem2complex): Receive a forced exactness specifier parameter and pass
  it down to mem2ureal.  Previously, we passed down a pointer to an
  implicit exactness specifier flag instead.

  (scm_i_string_to_number): No longer create an implicit exactness
  specifier flag here, and do not apply exactness specifiers here.  All
  we do here now regarding exactness is to parse the "#e" or "#i" prefix
  (if any) and pass this information down to mem2ureal via mem2complex
  in the form of an explicit exactness specifier (forced_x).

  (scm_c_make_polar): If the cosine and sine of the angle are both NaNs
  and the magnitude is zero, return 0.0+0.0i instead of +nan.0+nan.0i.
  This case happens when the angle is not finite.

* test-suite/tests/numbers.test (string->number): Move the test cases
  for non-real complex numbers into a separate table in which the
  expected real and imaginary parts are separate entries.  Add several
  new test cases.
---
 NEWS                          |   25 +++++++++
 libguile/numbers.c            |  113 ++++++++++++++++++++---------------------
 test-suite/tests/numbers.test |   44 ++++++++++++----
 3 files changed, 112 insertions(+), 70 deletions(-)

diff --git a/NEWS b/NEWS
index 6781fa0..27b52ae 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,31 @@ Please send Guile bug reports to address@hidden
 Note: During the 1.9 series, we will keep an incremental NEWS for the
 latest prerelease, and a full NEWS corresponding to 1.8 -> 2.0.
 
+Changes since the 1.9.15 prerelease:
+
+** Improved exactness handling for complex number parsing
+
+When parsing non-real complex numbers, exactness specifiers are now
+applied to each component, as is done in PLT Scheme.  For complex
+numbers written in rectangular form, exactness specifiers are applied
+to the real and imaginary parts before calling scm_make_rectangular.
+For complex numbers written in polar form, exactness specifiers are
+applied to the magnitude and angle before calling scm_make_polar.
+
+Previously, exactness specifiers were applied to the number as a whole
+_after_ calling scm_make_rectangular or scm_make_polar.
+
+For example, (string->number "#i5.0+0i") now does the equivalent of:
+
+  (make-rectangular (exact->inexact 5.0) (exact->inexact 0))
+
+which yields 5.0+0.0i.  Previously it did the equivalent of:
+
+  (exact->inexact (make-rectangular 5.0 0))
+
+which yielded 5.0.
+
+
 Changes in 1.9.15 (since the 1.9.14 prerelease):
 
 ** Formally deprecate omission of port to `format'
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 3be4478..85ca0fd 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -4124,7 +4124,7 @@ mem2decimal_from_point (SCM result, SCM mem,
 
 static SCM
 mem2ureal (SCM mem, unsigned int *p_idx,
-          unsigned int radix, enum t_exactness *p_exactness)
+          unsigned int radix, enum t_exactness forced_x)
 {
   unsigned int idx = *p_idx;
   SCM result;
@@ -4132,7 +4132,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
 
   /* Start off believing that the number will be exact.  This changes
      to INEXACT if we see a decimal point or a hash. */
-  enum t_exactness x = EXACT;
+  enum t_exactness implicit_x = EXACT;
 
   if (idx == len)
     return SCM_BOOL_F;
@@ -4148,7 +4148,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
       /* Cobble up the fractional part.  We might want to set the
         NaN's mantissa from it. */
       idx += 4;
-      mem2uinteger (mem, &idx, 10, &x);
+      mem2uinteger (mem, &idx, 10, &implicit_x);
       *p_idx = idx;
       return scm_nan ();
     }
@@ -4163,13 +4163,13 @@ mem2ureal (SCM mem, unsigned int *p_idx,
        return SCM_BOOL_F;
       else
        result = mem2decimal_from_point (SCM_INUM0, mem,
-                                        p_idx, &x);
+                                        p_idx, &implicit_x);
     }
   else
     {
       SCM uinteger;
 
-      uinteger = mem2uinteger (mem, &idx, radix, &x);
+      uinteger = mem2uinteger (mem, &idx, radix, &implicit_x);
       if (scm_is_false (uinteger))
        return SCM_BOOL_F;
 
@@ -4183,7 +4183,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
           if (idx == len)
             return SCM_BOOL_F;
 
-         divisor = mem2uinteger (mem, &idx, radix, &x);
+         divisor = mem2uinteger (mem, &idx, radix, &implicit_x);
          if (scm_is_false (divisor))
            return SCM_BOOL_F;
 
@@ -4192,7 +4192,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
        }
       else if (radix == 10)
        {
-         result = mem2decimal_from_point (uinteger, mem, &idx, &x);
+         result = mem2decimal_from_point (uinteger, mem, &idx, &implicit_x);
          if (scm_is_false (result))
            return SCM_BOOL_F;
        }
@@ -4202,21 +4202,32 @@ mem2ureal (SCM mem, unsigned int *p_idx,
       *p_idx = idx;
     }
 
-  /* Update *p_exactness if the number just read was inexact.  This is
-     important for complex numbers, so that a complex number is
-     treated as inexact overall if either its real or imaginary part
-     is inexact.
-  */
-  if (x == INEXACT)
-    *p_exactness = x;
-
-  /* When returning an inexact zero, make sure it is represented as a
-     floating point value so that we can change its sign. 
-  */
-  if (scm_is_eq (result, SCM_INUM0) && *p_exactness == INEXACT)
-    result = flo0;
+  switch (forced_x)
+    {
+    case EXACT:
+      if (SCM_INEXACTP (result))
+       return scm_inexact_to_exact (result);
+      else
+       return result;
+    case INEXACT:
+      if (SCM_INEXACTP (result))
+       return result;
+      else
+       return scm_exact_to_inexact (result);
+    case NO_EXACTNESS:
+      if (implicit_x == INEXACT)
+       {
+         if (SCM_INEXACTP (result))
+           return result;
+         else
+           return scm_exact_to_inexact (result);
+       }
+      else
+       return result;
+    }
 
-  return result;
+  /* We should never get here */
+  scm_syserror ("mem2ureal");
 }
 
 
@@ -4224,7 +4235,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
 
 static SCM
 mem2complex (SCM mem, unsigned int idx,
-            unsigned int radix, enum t_exactness *p_exactness)
+            unsigned int radix, enum t_exactness forced_x)
 {
   scm_t_wchar c;
   int sign = 0;
@@ -4249,7 +4260,7 @@ mem2complex (SCM mem, unsigned int idx,
   if (idx == len)
     return SCM_BOOL_F;
 
-  ureal = mem2ureal (mem, &idx, radix, p_exactness);
+  ureal = mem2ureal (mem, &idx, radix, forced_x);
   if (scm_is_false (ureal))
     {
       /* input must be either +i or -i */
@@ -4320,7 +4331,7 @@ mem2complex (SCM mem, unsigned int idx,
              else
                sign = 1;
 
-             angle = mem2ureal (mem, &idx, radix, p_exactness);
+             angle = mem2ureal (mem, &idx, radix, forced_x);
              if (scm_is_false (angle))
                return SCM_BOOL_F;
              if (idx != len)
@@ -4342,7 +4353,7 @@ mem2complex (SCM mem, unsigned int idx,
          else
            {
              int sign = (c == '+') ? 1 : -1;
-             SCM imag = mem2ureal (mem, &idx, radix, p_exactness);
+             SCM imag = mem2ureal (mem, &idx, radix, forced_x);
 
              if (scm_is_false (imag))
                imag = SCM_I_MAKINUM (sign);
@@ -4378,8 +4389,6 @@ scm_i_string_to_number (SCM mem, unsigned int 
default_radix)
   unsigned int idx = 0;
   unsigned int radix = NO_RADIX;
   enum t_exactness forced_x = NO_EXACTNESS;
-  enum t_exactness implicit_x = EXACT;
-  SCM result;
   size_t len = scm_i_string_length (mem);
 
   /* R5RS, section 7.1.1, lexical structure of numbers: <prefix R> */
@@ -4425,37 +4434,9 @@ scm_i_string_to_number (SCM mem, unsigned int 
default_radix)
 
   /* R5RS, section 7.1.1, lexical structure of numbers: <complex R> */
   if (radix == NO_RADIX)
-    result = mem2complex (mem, idx, default_radix, &implicit_x);
-  else
-    result = mem2complex (mem, idx, (unsigned int) radix, &implicit_x);
-
-  if (scm_is_false (result))
-    return SCM_BOOL_F;
+    radix = default_radix;
 
-  switch (forced_x)
-    {
-    case EXACT:
-      if (SCM_INEXACTP (result))
-       return scm_inexact_to_exact (result);
-      else
-       return result;
-    case INEXACT:
-      if (SCM_INEXACTP (result))
-       return result;
-      else
-       return scm_exact_to_inexact (result);
-    case NO_EXACTNESS:
-    default:
-      if (implicit_x == INEXACT)
-       {
-         if (SCM_INEXACTP (result))
-           return result;
-         else
-           return scm_exact_to_inexact (result);
-       }
-      else
-       return result;
-    }
+  return mem2complex (mem, idx, radix, forced_x);
 }
 
 SCM
@@ -7160,7 +7141,23 @@ scm_c_make_polar (double mag, double ang)
   s = sin (ang);
   c = cos (ang);
 #endif
-  return scm_c_make_rectangular (mag * c, mag * s);
+
+  /* If s and c are NaNs, this indicates that the angle is a NaN,
+     infinite, or perhaps simply too large to determine its value
+     mod 2*pi.  However, we know something that the floating-point
+     implementation doesn't know:  We know that s and c are finite.
+     Therefore, if the magnitude is zero, return a complex zero.
+
+     The reason we check for the NaNs instead of using this case
+     whenever mag == 0.0 is because when the angle is known, we'd
+     like to return the correct kind of non-real complex zero:
+     +0.0+0.0i, -0.0+0.0i, -0.0-0.0i, or +0.0-0.0i, depending
+     on which quadrant the angle is in.
+  */
+  if (SCM_UNLIKELY (isnan(s)) && isnan(c) && (mag == 0.0))
+    return scm_c_make_rectangular (0.0, 0.0);
+  else
+    return scm_c_make_rectangular (mag * c, mag * s);
 }
 
 SCM_DEFINE (scm_make_polar, "make-polar", 2, 0, 0,
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 96f37df..1c4630e 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -1523,18 +1523,38 @@
                 ("3.1#e0" 3.1)
                 ;; * <digit 10>+ #+ . #* <suffix>
                 ("3#." 30.0) ("3#.e0" 30.0) ("3#.#" 30.0) ("3#.#e0" 30.0)
-                ;; Complex:
-                ("address@hidden" 1) ("address@hidden" 1) ("address@hidden" 1)
-                ("address@hidden" 1.0+0i) ("address@hidden" 1+0.0i) 
("address@hidden" 1.0-0i)
-                ("2+3i" ,(+ 2 (* 3 +i))) ("4-5i" ,(- 4 (* 5 +i)))
-                ("1+i" 1+1i) ("1-i" 1-1i) ("+1i" 0+1i) ("-1i" 0-1i)
-                ("+i" +1i) ("-i" -1i)
-               ("1.0+.1i" 1.0+0.1i)
-               ("1.0-.1i" 1.0-0.1i)
-               (".1+.0i" 0.1+0.0i)
-               ("1.+.0i" 1.0+0.0i)
-               (".1+.1i" 0.1+0.1i)
-               ("1e1+.1i" 10+0.1i)
+               ))
+    #t)
+
+  (pass-if "valid complex number strings"
+    (for-each (lambda (triple)
+                (apply
+                 (lambda (str re im)
+                   (let ((z (string->number str)))
+                     (if (or (eq? z #f)
+                             (not (and (eqv? (real-part z) re)
+                                       (eqv? (imag-part z) im))))
+                        (begin 
+                          (pk str re im)
+                          (throw 'fail)))))
+                 triple))
+              `(("address@hidden" 1 0) ("address@hidden" 1 0) 
("address@hidden" 1 0) ("1/address@hidden" 1/2 0)
+                ("address@hidden" 1.0 0) ("address@hidden" 1.0 0)
+                ("address@hidden" 1 0) ("address@hidden" 1 0) 
("address@hidden" 1 0) ("address@hidden" 1/2 0)
+                ("address@hidden" 1 0) ("address@hidden" 1 0)
+                ("address@hidden" 1.0 0.0) ("address@hidden" 1.0 0.0) 
("address@hidden" 1.0 -0.0) ("#i1/address@hidden" 0.5 0.0)
+                ("address@hidden" 1.0 0.0) ("address@hidden" 1.0 -0.0)
+                ("address@hidden" 1.0 0.0) ("address@hidden" 1.0 -0.0)
+                ("2+3i" 2.0 3.0) ("4-5i" 4.0 -5.0)
+                ("1+i" 1.0 1.0) ("1-i" 1.0 -1.0) ("+1i" 0.0 1.0) ("-1i" 0.0 
-1.0)
+                ("+i" 0.0 1.0) ("-i" 0.0 -1.0)
+               ("1.0+.1i" 1.0 0.1) ("1.0-.1i" 1.0 -0.1)
+               (".1+.0i" 0.1 0.0) ("1.+.0i" 1.0 0.0) (".1+.1i" 0.1 0.1)
+               ("1e1+.1i" 10.0 0.1)
+                ("address@hidden" 0 0) ("address@hidden" 0 0) 
("address@hidden" 0 0)
+                ("address@hidden" 0.0 0.0) ("address@hidden" 0.0 0.0) 
("address@hidden" 0.0 0.0)
+                ("address@hidden" 0.0 0.0) ("address@hidden" 0.0 0.0) 
("address@hidden" 0.0 0.0)
+                ("address@hidden" 0.0 0.0) ("address@hidden" -0.0 0.0) 
("address@hidden" -0.0 -0.0) ("address@hidden" 0.0 -0.0)
                ))
     #t)
 
-- 
1.5.6.5