Reject multiple zero real components by parse states.

Rejecting on a zero real part of parsing an imaginary suffix was cute
but leads to wacky quirks in accepted notation.

diff --git a/src/runtime/numpar.scm b/src/runtime/numpar.scm
index 76d5a2c606387333b5ad1b68827d8730b41e01c6..fe0df815c0264f93a1fbf3bdb974b89417a2a4f4 100644 (file)
--- a/src/runtime/numpar.scm
+++ b/src/runtime/numpar.scm
@@ -75,30 +75,33 @@ USA.
                              ((or (char=? #\i char) (char=? #\I char))
                               (do-exactness 'inexact))
                              (else #f))))))
-            (parse-top-level string start end exactness
-                             (or radix default-radix))))))
+            (let ((radix (or radix default-radix))
+                  (imag? #f))
+              (parse-top-level string start end exactness radix imag?))))))
 
-(define (parse-top-level string start end exactness radix)
+(define (parse-top-level string start end exactness radix imag?)
   (and (fix:< start end)
        (let ((char (string-ref string start))
             (start (fix:+ start 1)))
-        (cond ((sign? char)
-               (find-leader string start end
-                            exactness (or radix 10)
-                            char))
-              ((char=? #\. char)
-               (and (or (not radix) (fix:= 10 radix) (fix:= #x10 radix))
-                    (parse-dotted-1 string start end
-                                    (or exactness 'implicit-inexact)
-                                    (or radix 10)
-                                    #f)))
-              ((char->digit char (or radix 10))
-               => (lambda (digit)
-                    (parse-integer string start end digit
-                                   exactness (or radix 10) #f)))
-              (else #f)))))
+        (if (sign? char)
+            (let ((sign char))
+              (find-leader string start end
+                           exactness (or radix 10)
+                           sign imag?))
+            (let ((sign #f))
+              (cond ((char=? #\. char)
+                     (and (or (not radix) (fix:= 10 radix) (fix:= #x10 radix))
+                          (parse-dotted-1 string start end
+                                          (or exactness 'implicit-inexact)
+                                          (or radix 10)
+                                          sign imag?)))
+                    ((char->digit char (or radix 10))
+                     => (lambda (digit)
+                          (parse-integer string start end digit
+                                         exactness (or radix 10) sign imag?)))
+                    (else #f)))))))
 \f
-(define (find-leader string start end exactness radix sign)
+(define (find-leader string start end exactness radix sign imag?)
   ;; State: leading sign has been seen.
   (and (fix:< start end)
        (let ((char (string-ref string start))
@@ -106,12 +109,11 @@ USA.
         (cond ((char->digit char radix)
                => (lambda (digit)
                     (parse-integer string start end digit
-                                   exactness radix sign)))
+                                   exactness radix sign imag?)))
               ((char=? #\. char)
                (parse-dotted-1 string start end
                                (or exactness 'implicit-inexact)
-                               radix
-                               sign))
+                               radix sign imag?))
               ((and (char-ci=? #\i char)
                     (string-prefix-ci? "nf.0" string start end))
                (and (not (eq? exactness 'exact))
@@ -119,22 +121,21 @@ USA.
                                    (if (eq? #\- sign)
                                        (flo:-inf.0)
                                        (flo:+inf.0))
-                                   exactness radix sign)))
+                                   exactness radix sign imag?)))
               ((and (char-ci=? #\n char)
                     (string-prefix-ci? "an." string start end))
                 (parse-nan-payload string (+ start 3) end exactness radix
-                                   #t sign))
+                                   #t sign imag?))
               ((and (char-ci=? #\s char)
                     (string-prefix-ci? "nan." string start end))
                (parse-nan-payload string (+ start 4) end exactness radix
-                                  #f sign))
+                                  #f sign imag?))
               ((i? char)
                (and (fix:= start end)
                     (make-rectangular 0 (if (eq? #\- sign) -1 1))))
               (else #f)))))
 
-
-(define (parse-integer string start end integer exactness radix sign)
+(define (parse-integer string start end integer exactness radix sign imag?)
   ;; State: at least one digit has been seen.
   (parse-digits string start end integer exactness radix
     (lambda (start integer exactness sharp?)
@@ -143,33 +144,33 @@ USA.
                (start+1 (fix:+ start 1)))
            (cond ((char=? #\/ char)
                   (parse-denominator-1 string start+1 end
-                                       integer exactness radix sign))
+                                       integer exactness radix sign imag?))
                  ((char=? #\. char)
                   (if sharp?
                       (parse-dotted-3 string start+1 end
-                                       integer 0 exactness radix sign)
+                                       integer 0 exactness radix sign imag?)
                       (parse-dotted-2 string start+1 end
                                       integer 0
                                       (or exactness 'implicit-inexact)
-                                      radix
-                                      sign)))
+                                      radix sign imag?)))
                  ((exponent-marker? char)
                   ;; XXX Necessary to limit this to radix 10?
                   (and (fix:= radix 10)
                        (parse-exponent-1 string start+1 end
                                          integer 0
                                          (or exactness 'implicit-inexact)
-                                         radix sign 10)))
+                                         radix sign 10 imag?)))
                  ((or (char=? #\p char) (char=? #\P char))
                   (parse-exponent-1 string start+1 end
                                     integer 0
                                     (or exactness 'implicit-inexact)
-                                    radix sign 2))
+                                    radix sign 2 imag?))
                  (else
                   (parse-complex string start end
                                  (finish-integer integer exactness sign)
-                                 exactness radix sign))))
-         (finish-integer integer exactness sign)))))
+                                 exactness radix sign imag?))))
+         (and (not imag?)
+              (finish-integer integer exactness sign))))))
 \f
 (define (parse-digits string start end integer exactness radix k)
   (let loop ((start start) (integer integer))
@@ -189,7 +190,8 @@ USA.
                 (k start integer exactness #f))))
        (k start integer exactness #f))))
 
-(define (parse-denominator-1 string start end numerator exactness radix sign)
+(define (parse-denominator-1 string start end numerator exactness radix sign
+                            imag?)
   ;; State: numerator parsed, / seen.
   (let ((finish
         (lambda (denominator exactness sign)
@@ -200,19 +202,19 @@ USA.
        (and (> start* start) ; >0 denominator digits
             (parse-complex string start* end
                            (finish integer exactness sign)
-                           exactness radix sign))))))
+                           exactness radix sign imag?))))))
 \f
-(define (parse-dotted-1 string start end exactness radix sign)
+(define (parse-dotted-1 string start end exactness radix sign imag?)
   ;; State: leading dot seen.
   (and (fix:< start end)
        (let ((digit (char->digit (string-ref string start) radix))
             (start (fix:+ start 1)))
         (and digit
              (parse-dotted-2 string start end digit -1 exactness radix
-                             sign)))))
+                             sign imag?)))))
 
 (define (parse-dotted-2 string start end integer rexponent exactness radix
-                       sign)
+                       sign imag?)
   ;; State: dot seen.
   (let loop ((start start) (integer integer) (rexponent rexponent))
     (if (fix:< start end)
@@ -225,14 +227,16 @@ USA.
                            (- rexponent 1))))
                ((char=? #\# char)
                 (parse-dotted-3 string start+1 end
-                                integer rexponent exactness radix sign))
+                                integer rexponent exactness radix sign imag?))
                (else
                 (parse-dotted-4 string start end
-                                integer rexponent exactness radix sign))))
-       (finish-real integer rexponent exactness radix sign 10 0))))
+                                integer rexponent
+                                exactness radix sign imag?))))
+       (and (not imag?)
+            (finish-real integer rexponent exactness radix sign 10 0)))))
 
 (define (parse-dotted-3 string start end integer rexponent exactness radix
-                       sign)
+                       sign imag?)
   ;; State: dot and # seen.
   (let loop ((start start))
     (if (fix:< start end)
@@ -241,26 +245,29 @@ USA.
          (if (char=? #\# char)
              (loop start+1)
              (parse-dotted-4 string start end
-                             integer rexponent exactness radix sign)))
-       (finish-real integer rexponent exactness radix sign radix 0))))
+                             integer rexponent exactness radix sign imag?)))
+       (and (not imag?)
+            (finish-real integer rexponent exactness radix sign radix 0)))))
 \f
 (define (parse-dotted-4 string start end integer rexponent exactness radix
-                       sign)
+                       sign imag?)
   (cond ((exponent-marker? (string-ref string start))
         (and (fix:= radix 10)
              (parse-exponent-1 string (fix:+ start 1) end
-                               integer rexponent exactness radix sign 10)))
+                               integer rexponent
+                               exactness radix sign 10 imag?)))
        ((or (char=? #\p (string-ref string start))
             (char=? #\P (string-ref string start)))
         (and (fix:= radix #x10)
              (parse-exponent-1 string (fix:+ start 1) end
-                               integer rexponent exactness radix sign 2)))
+                               integer rexponent
+                               exactness radix sign 2 imag?)))
        (else
         (parse-dotted-5 string start end integer rexponent exactness radix
-                        sign 10 0))))
+                        sign 10 0 imag?))))
 
 (define (parse-exponent-1 string start end integer rexponent exactness radix
-                         sign base)
+                         sign base imag?)
   ;; State: exponent seen.
   (define (get-digits start esign)
     (and (fix:< start end)
@@ -279,9 +286,11 @@ USA.
   (define (continue start eint esign)
     (let ((bexponent (if (eq? #\- esign) (- eint) eint)))
       (if (fix:= start end)
-         (finish-real integer rexponent exactness radix sign base bexponent)
+         (and (not imag?)
+              (finish-real integer rexponent exactness radix sign
+                           base bexponent))
          (parse-dotted-5 string start end integer rexponent exactness radix
-                         sign base bexponent))))
+                         sign base bexponent imag?))))
 
   (and (fix:< start end)
        (let ((esign (string-ref string start)))
@@ -290,36 +299,37 @@ USA.
             (get-digits start #f)))))
 
 (define (parse-dotted-5 string start end integer rexponent exactness radix
-                       sign base bexponent)
+                       sign base bexponent imag?)
   (parse-complex string start end
                 (finish-real integer rexponent exactness radix sign
                              base bexponent)
-                exactness radix sign))
+                exactness radix sign imag?))
 \f
-(define (parse-complex string start end real exactness radix sign)
+(define (parse-complex string start end real exactness radix sign imag?)
   (if (fix:< start end)
       (let ((char (string-ref string start))
            (start+1 (fix:+ start 1))
            (exactness (if (eq? 'implicit-inexact exactness) #f exactness)))
-       (cond ((sign? char)
+       (cond ((i? char)
+              (and sign
+                   (fix:= start+1 end)
+                   (make-rectangular 0 real)))
+             (imag? #f)
+             ((sign? char)
               (let ((imaginary
-                     (parse-top-level string start end exactness radix)))
+                     (parse-top-level string start end exactness radix #t)))
                 (and (complex? imaginary)
                      (= 0 (real-part imaginary))
                      (make-rectangular real (imag-part imaginary)))))
              ((char=? #\@ char)
               (let ((angle
-                     (parse-top-level string start+1 end exactness radix)))
+                     (parse-top-level string start+1 end exactness radix #t)))
                 (and (real? angle)
                      (make-polar real angle))))
-             ((i? char)
-              (and sign
-                   (fix:= start+1 end)
-                   (make-rectangular 0 real)))
              (else #f)))
-      real))
+      (and (not imag?) real)))
 
-(define (parse-nan-payload string start end exactness radix quiet? sign)
+(define (parse-nan-payload string start end exactness radix quiet? sign imag?)
   (let loop ((payload 0) (start start))
     (define (finish-nan)
       (and (or quiet? (not (zero? payload)))
@@ -333,7 +343,7 @@ USA.
                 ((finish-nan)
                 => (lambda (nan)
                      (parse-complex string start end nan
-                                    exactness radix sign)))
+                                    exactness radix sign imag?)))
                (else #f)))
         (finish-nan))))
 

diff --git a/tests/runtime/test-numpar.scm b/tests/runtime/test-numpar.scm
index 6bcacf2dfb9f28aadb51e8a41497ce793a7a91f4..6aa557f27d8739f1d8bac2658ca27bfca98835a4 100644 (file)
--- a/tests/runtime/test-numpar.scm
+++ b/tests/runtime/test-numpar.scm
@@ -203,14 +203,14 @@ USA.
 (define-error-test "#e+inf.0")
 (define-error-test "#e-inf.0")
 
-(define-error-test "+0+0" expect-failure)
-(define-error-test "0+0" expect-failure)
-(define-error-test "+1+0" expect-failure)
-(define-error-test "1+0" expect-failure)
-(define-error-test "1+0" expect-failure)
-(define-error-test "1+0." expect-failure)
-(define-error-test "1+0.0" expect-failure)
-(define-error-test "1+.0" expect-failure)
-(define-error-test "1+0/1" expect-failure)
-(define-error-test "+0+0+i" expect-failure)
-(define-error-test "0+0+i" expect-failure)
+(define-error-test "+0+0")
+(define-error-test "0+0")
+(define-error-test "+1+0")
+(define-error-test "1+0")
+(define-error-test "1+0")
+(define-error-test "1+0.")
+(define-error-test "1+0.0")
+(define-error-test "1+.0")
+(define-error-test "1+0/1")
+(define-error-test "+0+0+i")
+(define-error-test "0+0+i")