conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
scheme/ikarus.string-to-number.ss
View File

@ -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))]

2
scheme/last-revision
View File

@ -1 +1 @@
1836
1837

4
scheme/tests/scribble.ss
View File

@ -335,7 +335,7 @@
reads as
(foo "foo" 3.0)
"@foo{foo@|3|.}"
"@foo{foo@| 3 |.}"
reads as
(foo "foo" 3 ".")
@ -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")

58
scheme/tests/string-to-number.ss
View File

@ -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)
))