From affb48cb2204ddf6d42acbdb0372c1fdc29a9118 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Fri, 7 Dec 2018 16:51:48 +0000 Subject: [PATCH] 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. --- src/runtime/numpar.scm | 142 ++++++++++++++++++---------------- tests/runtime/test-numpar.scm | 22 +++--- 2 files changed, 87 insertions(+), 77 deletions(-) diff --git a/src/runtime/numpar.scm b/src/runtime/numpar.scm index 76d5a2c60..fe0df815c 100644 --- 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))))))) -(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)))))) (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?)))))) -(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))))) (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?)) -(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 6bcacf2df..6aa557f27 100644 --- 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") -- 2.25.1