From e3ce8731183dca440dfcccf98b7b5a75600f4c1d Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Sun, 2 Aug 2009 14:01:35 +0300
Subject: [PATCH] mantissa-width syntax of inexact numbers is now parsed and
 ignored.

---
 scheme/ikarus.string-to-number.ss | 29 ++++++++++++++--
 scheme/last-revision              |  2 +-
 scheme/tests/scribble.ss          |  6 ++--
 scheme/tests/string-to-number.ss  | 58 +++++++++++++++----------------
 4 files changed, 59 insertions(+), 36 deletions(-)

diff --git a/scheme/ikarus.string-to-number.ss b/scheme/ikarus.string-to-number.ss
index 16a99fe..a54c3d2 100755
--- a/scheme/ikarus.string-to-number.ss
+++ b/scheme/ikarus.string-to-number.ss
@@ -201,7 +201,11 @@
       [(#\i)
        (let ([n1 (do-dec-sn/ex sn ex 
                    (* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))])
-         (next u:done (mkrec0 n0 n1)))])
+         (next u:done (mkrec0 n0 n1)))]
+      [(#\|)
+       (let ([n1 (do-dec-sn/ex sn ex 
+                   (* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))])
+         (next u:mant r n0 n1 ex))])
 
     (u:exponent+sign (r n0 ex sn ac exp1 exp-sign)
       [(digit r) => d
@@ -233,7 +237,11 @@
       [(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L)
        (if (fx=? r 10)
            (next u:exponent r n0 ex sn ac exp)
-           (fail))])
+           (fail))]
+      [(#\|)
+       (let ([n1 (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
+         (next u:mant r n0 n1 ex))]
+      )
 
 
     (u:digit+ (r n0 ex sn ac)
@@ -261,7 +269,22 @@
       [(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L)
        (if (fx=? r 10)
            (next u:exponent r n0 ex sn ac 0)
-           (fail))])
+           (fail))]
+      [(#\|)
+       (next u:mant r n0 (do-sn/ex sn 'i ac) ex)])
+
+    (u:mant (r n0 n1 ex)
+      [(digit r) => d_
+       (next u:mant+ r n0 n1 ex)])
+
+    (u:mant+ (r n0 n1 ex)
+      [(eof) (mkrec1 n0 n1)]
+      [(digit r) => d_
+       (next u:mant+ r n0 n1 ex)]
+      [(sign) => sn2
+       (if n0 (fail) (next u:sign r n1 ex sn2))]
+      [(#\@) (if n0 (fail) (next u:polar r n1 ex))]
+      [(#\i) (if (pair? n0) (fail) (next u:done (mkrec0 n0 n1)))])
 
     (u:sign-i (r n0 ex sn)
       [(eof) (mkrec0 n0 (do-sn/ex sn ex 1))]
diff --git a/scheme/last-revision b/scheme/last-revision
index 2058420..81435ab 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1836
+1837
diff --git a/scheme/tests/scribble.ss b/scheme/tests/scribble.ss
index 43b1050..cecf972 100644
--- a/scheme/tests/scribble.ss
+++ b/scheme/tests/scribble.ss
@@ -335,8 +335,8 @@
         reads as  
       (foo "foo" 3.0)
         
-      "@foo{foo@|3|.}"
-        reads as  
+      "@foo{foo@| 3 |.}"
+        reads as
       (foo "foo" 3 ".")
         
       "@foo{foo@|(f 1)|{bar}}"
@@ -355,7 +355,7 @@
         reads as  
       (foo "x" "y" "z")
         
-      "@foo{x@|1 (+ 2 3) 4|y}"
+      "@foo{x@| 1 (+ 2 3) 4 |y}"
         reads as  
       (foo "x" 1 (+ 2 3) 4 "y")
         
diff --git a/scheme/tests/string-to-number.ss b/scheme/tests/string-to-number.ss
index b862f6e..3fd0836 100644
--- a/scheme/tests/string-to-number.ss
+++ b/scheme/tests/string-to-number.ss
@@ -25,7 +25,7 @@
          (and (== (real-part x) (real-part y))
               (== (imag-part x) (imag-part y)))]
         [else (equal? x y)]))
-    (printf "testing ~a -> ~s\n" string expected)
+    ;(printf "testing ~a -> ~s\n" string expected)
     (let ([result (string->number string)])
       (if expected
           (unless (number? result)
@@ -264,39 +264,34 @@
     (define (gensa ls1 ls2 comp)
       (gen ls1 ls2 string-append comp))
 
-    (define ureal
+    (define suffixed-int
       '(["0" . 0]
         ["1" . 1]
         ["1." . 1.0]
         ["1.0" . 1.0]
         [".5" . 0.5]
-        ["0.5" . 0.5]
-        ;["1e1" . 10.0]
-        ["1e0" . 1.0]
-        ;["1e+1" . 10.0]
-        ["1e+0" . 1.0]
-        ["1e-1" . 0.1]
-        ;["1.e1" . 10.0]
-        ["1.e0" . 1.0]
-        ;["1.e+1" . 10.0]
-        ["1.e+0" . 1.0]
-        ["1.e-1" . 0.1]
-        ;["1.0e1" . 10.0]
-        ["1.0e0" . 1.0]
-        ;["1.0e+1" . 10.0]
-        ["1.0e+0" . 1.0]
-        ["1.0e-1" . 0.1]
-        ;[".5e1" . 5.0]
-        [".5e0" . 0.5]
-        ;[".5e+1" . 5.0]
-        [".5e+0" . 0.5]
-        [".5e-1" . 0.05]
-        ))
+        ["0.5" . 0.5]))
+
+    (define exponents
+      '(["e0" . 1.0]
+        ["e+0" . 1.0]
+        ["e-0" . 1.0]
+        ["e-1" . 0.1]))
+
+    (define decimal10
+      (append
+        suffixed-int
+        (gensa suffixed-int exponents *)))
 
     (define naninf
       '(["nan.0" . +nan.0]
         ["inf.0" . +inf.0]))
 
+    (define ureal
+      (append
+        decimal10
+        (gensa decimal10 '(["|53" . #f]) (lambda (x _) (inexact x)))))
+
     (define sign
       '(["+" . +1]
         ["-" . -1]))
@@ -309,6 +304,7 @@
       (append 
         (gensa sign ureal *)
         (gensa sign naninf *)))
+
     (define real
       (append ureal sreal))
 
@@ -320,16 +316,20 @@
     ;;;         | +i
     ;;;         | -i
 
-    (define creal
+
+    (define comps
       (append
-        (gensa sreal '(["i" . #f]) (lambda (x f) (make-rectangular 0 x)))
-        `(["+i" . ,(make-rectangular 0 1)]
-          ["-i" . ,(make-rectangular 0 -1)])))
+        (gensa sreal '(["i" . #f]) (lambda (x f) x))
+        '(["+i" . 1]
+          ["-i" . -1])))
+
+    (define creal
+      (map (lambda (x) (cons (car x) (make-rectangular 0 (cdr x)))) comps))
 
     (define complex
       (append
         real creal
-        (gensa real creal +)
+        (gensa real comps make-rectangular)
         (gen real real (lambda (x y) (string-append x "@" y)) make-polar)
         ))