mantissa-width syntax of inexact numbers is now parsed and ignored.

This commit is contained in:
Abdulaziz Ghuloum 2009-08-02 14:01:35 +03:00
parent 3e71a5aa5e
commit e3ce873118
4 changed files with 59 additions and 36 deletions

View File

@ -201,7 +201,11 @@
[(#\i) [(#\i)
(let ([n1 (do-dec-sn/ex sn ex (let ([n1 (do-dec-sn/ex sn ex
(* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))]) (* 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) (u:exponent+sign (r n0 ex sn ac exp1 exp-sign)
[(digit r) => d [(digit r) => d
@ -233,7 +237,11 @@
[(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L) [(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L)
(if (fx=? r 10) (if (fx=? r 10)
(next u:exponent r n0 ex sn ac exp) (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) (u:digit+ (r n0 ex sn ac)
@ -261,7 +269,22 @@
[(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L) [(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L)
(if (fx=? r 10) (if (fx=? r 10)
(next u:exponent r n0 ex sn ac 0) (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) (u:sign-i (r n0 ex sn)
[(eof) (mkrec0 n0 (do-sn/ex sn ex 1))] [(eof) (mkrec0 n0 (do-sn/ex sn ex 1))]

View File

@ -1 +1 @@
1836 1837

View File

@ -335,7 +335,7 @@
reads as reads as
(foo "foo" 3.0) (foo "foo" 3.0)
"@foo{foo@|3|.}" "@foo{foo@| 3 |.}"
reads as reads as
(foo "foo" 3 ".") (foo "foo" 3 ".")
@ -355,7 +355,7 @@
reads as reads as
(foo "x" "y" "z") (foo "x" "y" "z")
"@foo{x@|1 (+ 2 3) 4|y}" "@foo{x@| 1 (+ 2 3) 4 |y}"
reads as reads as
(foo "x" 1 (+ 2 3) 4 "y") (foo "x" 1 (+ 2 3) 4 "y")

View File

@ -25,7 +25,7 @@
(and (== (real-part x) (real-part y)) (and (== (real-part x) (real-part y))
(== (imag-part x) (imag-part y)))] (== (imag-part x) (imag-part y)))]
[else (equal? x y)])) [else (equal? x y)]))
(printf "testing ~a -> ~s\n" string expected) ;(printf "testing ~a -> ~s\n" string expected)
(let ([result (string->number string)]) (let ([result (string->number string)])
(if expected (if expected
(unless (number? result) (unless (number? result)
@ -264,39 +264,34 @@
(define (gensa ls1 ls2 comp) (define (gensa ls1 ls2 comp)
(gen ls1 ls2 string-append comp)) (gen ls1 ls2 string-append comp))
(define ureal (define suffixed-int
'(["0" . 0] '(["0" . 0]
["1" . 1] ["1" . 1]
["1." . 1.0] ["1." . 1.0]
["1.0" . 1.0] ["1.0" . 1.0]
[".5" . 0.5] [".5" . 0.5]
["0.5" . 0.5] ["0.5" . 0.5]))
;["1e1" . 10.0]
["1e0" . 1.0] (define exponents
;["1e+1" . 10.0] '(["e0" . 1.0]
["1e+0" . 1.0] ["e+0" . 1.0]
["1e-1" . 0.1] ["e-0" . 1.0]
;["1.e1" . 10.0] ["e-1" . 0.1]))
["1.e0" . 1.0]
;["1.e+1" . 10.0] (define decimal10
["1.e+0" . 1.0] (append
["1.e-1" . 0.1] suffixed-int
;["1.0e1" . 10.0] (gensa suffixed-int exponents *)))
["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]
))
(define naninf (define naninf
'(["nan.0" . +nan.0] '(["nan.0" . +nan.0]
["inf.0" . +inf.0])) ["inf.0" . +inf.0]))
(define ureal
(append
decimal10
(gensa decimal10 '(["|53" . #f]) (lambda (x _) (inexact x)))))
(define sign (define sign
'(["+" . +1] '(["+" . +1]
["-" . -1])) ["-" . -1]))
@ -309,6 +304,7 @@
(append (append
(gensa sign ureal *) (gensa sign ureal *)
(gensa sign naninf *))) (gensa sign naninf *)))
(define real (define real
(append ureal sreal)) (append ureal sreal))
@ -320,16 +316,20 @@
;;; | +i ;;; | +i
;;; | -i ;;; | -i
(define creal
(define comps
(append (append
(gensa sreal '(["i" . #f]) (lambda (x f) (make-rectangular 0 x))) (gensa sreal '(["i" . #f]) (lambda (x f) x))
`(["+i" . ,(make-rectangular 0 1)] '(["+i" . 1]
["-i" . ,(make-rectangular 0 -1)]))) ["-i" . -1])))
(define creal
(map (lambda (x) (cons (car x) (make-rectangular 0 (cdr x)))) comps))
(define complex (define complex
(append (append
real creal real creal
(gensa real creal +) (gensa real comps make-rectangular)
(gen real real (lambda (x y) (string-append x "@" y)) make-polar) (gen real real (lambda (x y) (string-append x "@" y)) make-polar)
)) ))