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

some refactoring of string-to-number parsers

This commit is contained in:
Abdulaziz Ghuloum 2009-08-02 10:47:39 +03:00
parent 4df1dcb25a
commit b2bca8a00a
4 changed files with 260 additions and 214 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
scheme/ikarus.reader.ss
View File

@ -260,7 +260,7 @@
(string-append ".." (string c)))]))] (string-append ".." (string c)))]))]
[else [else
(cons 'datum (cons 'datum
(dot p '(#\.) 10 #f +1))])))) (u:dot p '(#\.) 10 #f #f +1))]))))
(define tokenize-char* (define tokenize-char*
(lambda (i str p d) (lambda (i str p d)
(cond (cond
@ -633,7 +633,7 @@
char-case)))])) char-case)))]))
(define-string->number-parser port-config (define-string->number-parser port-config
(parse-string digit+ sign dot)) (parse-string u:digit+ u:sign u:dot))
(define (read-char* p ls str who ci? delimited?) (define (read-char* p ls str who ci? delimited?)
(let f ([i 0] [ls ls]) (let f ([i 0] [ls ls])
@ -742,7 +742,7 @@
[(char<=? #\0 c #\9) [(char<=? #\0 c #\9)
(let ([d (fx- (char->integer c) (char->integer #\0))]) (let ([d (fx- (char->integer c) (char->integer #\0))])
(cons 'datum (cons 'datum
(digit+ p (list c) 10 #f +1 d)))] (u:digit+ p (list c) 10 #f #f +1 d)))]
[(initial? c) [(initial? c)
(let ([ls (reverse (tokenize-identifier (cons c '()) p))]) (let ([ls (reverse (tokenize-identifier (cons c '()) p))])
(cons 'datum (string->symbol (list->string ls))))] (cons 'datum (string->symbol (list->string ls))))]
@ -756,7 +756,7 @@
[(delimiter? c) '(datum . +)] [(delimiter? c) '(datum . +)]
[else [else
(cons 'datum (cons 'datum
(sign p '(#\+) 10 #f +1))]))] (u:sign p '(#\+) 10 #f #f +1))]))]
[(memq c '(#\-)) [(memq c '(#\-))
(let ([c (peek-char p)]) (let ([c (peek-char p)])
(cond (cond
@ -769,7 +769,7 @@
(cons 'datum (string->symbol str))))] (cons 'datum (string->symbol str))))]
[else [else
(cons 'datum (cons 'datum
(sign p '(#\-) 10 #f -1))]))] (u:sign p '(#\-) 10 #f #f -1))]))]
[($char= #\. c) [($char= #\. c)
(tokenize-dot p)] (tokenize-dot p)]
[($char= #\| c) [($char= #\| c)

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

@ -120,86 +120,79 @@
orig* orig*
[name* (arg** ...) clause** ...] ...)])))])))) [name* (arg** ...) clause** ...] ...)])))]))))
(define (mkrec n0 n1)
(if n0 (make-rectangular n0 n1) (make-rectangular 0 n1)))
(define-parser define-string->number-parser next fail (define-parser define-string->number-parser next fail
(ratio+ (r ex sn num ac) (u:ratio+ (r n0 ex sn num ac)
[(eof) [(eof)
(if (= ac 0) (if (or n0 (= ac 0))
(fail) (fail)
(do-sn/ex sn ex (/ num ac)))] (do-sn/ex sn ex (/ num ac)))]
[(digit r) => d [(digit r) => d
(next ratio+ r ex sn num (+ (* ac r) d))] (next u:ratio+ r n0 ex sn num (+ (* ac r) d))]
[(#\+) [(#\+)
(if (= ac 0) (if (or n0 (= ac 0))
(fail) (fail)
(let ([real (do-sn/ex sn ex (/ num ac))]) (let ([real (do-sn/ex sn ex (/ num ac))])
(next im:sign r real ex +1)))] (next u:sign r real ex +1)))]
[(#\-) [(#\-)
(if (= ac 0) (if (or n0 (= ac 0))
(fail) (fail)
(let ([real (do-sn/ex sn ex (/ num ac))]) (let ([real (do-sn/ex sn ex (/ num ac))])
(next im:sign r real ex -1)))] (next u:sign r real ex -1)))]
[(#\@) [(#\@)
(if (= ac 0) (if (or n0 (= ac 0))
(fail) (fail)
(let ([mag (do-sn/ex sn ex (/ num ac))]) (let ([mag (do-sn/ex sn ex (/ num ac))])
(next polar r mag ex)))] (next polar r mag ex)))]
[(#\i)
(if (= ac 0)
(fail)
(next im:done
(make-rectangular 0 (do-sn/ex sn ex (/ num ac)))))])
(im:ratio+ (r real ex sn num ac)
[(digit r) => d
(next im:ratio+ r real ex sn num (+ (* ac r) d))]
[(#\i) [(#\i)
(if (= ac 0) (if (= ac 0)
(fail) (fail)
(next im:done (next u:done (mkrec n0 (do-sn/ex sn ex (/ num ac)))))])
(make-rectangular real (do-sn/ex sn ex (/ num ac)))))])
(im:done (n) (u:ratio (r n0 ex sn num)
[(digit r) => d
(next u:ratio+ r n0 ex sn num d)])
(u:done (n)
[(eof) n]) [(eof) n])
(ratio (r ex sn num)
[(digit r) => d
(next ratio+ r ex sn num d)])
(im:ratio (r real ex sn num)
[(digit r) => d
(next im:ratio+ r real ex sn num d)])
(exponent+digit (r ex sn ac exp1 exp2 exp-sign)
[(eof)
(do-dec-sn/ex sn ex (* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))]
[(#\+)
(let ([real (do-dec-sn/ex sn ex (* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))])
(next im:sign r real ex +1))]
[(#\-)
(let ([real (do-dec-sn/ex sn ex (* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))])
(next im:sign r real ex -1))]
[(#\@)
(let ([mag (do-dec-sn/ex sn ex (* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))])
(next polar r mag ex))]
[(digit r) => d
(next exponent+digit r ex sn ac exp1 (+ (* exp2 r) d) exp-sign)]
[(#\i)
(let ([n (do-dec-sn/ex sn ex
(* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))])
(next im:done (make-rectangular 0 n)))])
(polar (r mag ex) (polar (r mag ex)
[(digit r) => d [(digit r) => d
(next polar+digit r mag ex d 1)] (next polar+digit r mag ex d 1)]
[(#\.) [(#\.)
(if (= r 10) (if (= r 10)
(next polar+dot r mag ex +1) (next polar+dot r mag ex +1)
(fail))]) (fail))]
[(#\+)
(next polar+sign r mag ex +1)]
[(#\-)
(next polar+sign r mag ex -1)])
(polar+sign (r mag ex sn)
[(digit r) => d
(next polar+digit r mag ex d sn)]
[(#\.)
(if (= r 10)
(next polar+dot r mag ex sn)
(fail))]
[(#\n)
(next pol:sign-n (make-polar mag +nan.0))]
[(#\i)
(next pol:sign-i (make-polar mag (* +inf.0 sn)))])
(pol:sign-n (n) [(#\a) (next pol:sign-na n)])
(pol:sign-na (n) [(#\n) (next pol:sign-nan n)])
(pol:sign-nan (n) [(#\.) (next pol:sign-nan. n)])
(pol:sign-nan. (n) [(#\0) (next u:done n)])
(pol:sign-i (n) [(#\n) (next pol:sign-in n)])
(pol:sign-in (n) [(#\f) (next pol:sign-inf n)])
(pol:sign-inf (n) [(#\.) (next pol:sign-inf. n)])
(pol:sign-inf. (n) [(#\0) (next u:done n)])
(polar+dot (r mag ex sn) (polar+dot (r mag ex sn)
[(digit r) => d [(digit r) => d
(next polar+digit+dot r mag ex d sn -1)]) (next polar+digit+dot r mag ex d sn -1)])
@ -220,189 +213,157 @@
[(digit r) => d [(digit r) => d
(next polar+digit+dot r mag ex (+ (* r ang) d) sn (- exp 1))]) (next polar+digit+dot r mag ex (+ (* r ang) d) sn (- exp 1))])
(im:exponent+digit (r real ex sn ac exp1 exp2 exp-sign)
(u:exponent+digit (r n0 ex sn ac exp1 exp2 exp-sign)
[(eof)
(if n0
(fail)
(do-dec-sn/ex sn ex (* ac (expt 10 (+ exp1 (* exp2 exp-sign))))))]
[(digit r) => d [(digit r) => d
(next im:exponent+digit r real ex sn ac exp1 (+ (* exp2 r) d) exp-sign)] (next u:exponent+digit r n0 ex sn ac exp1 (+ (* exp2 r) d) exp-sign)]
[(#\+)
(if n0
(fail)
(let ([real (do-dec-sn/ex sn ex (* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))])
(next u:sign r real ex +1)))]
[(#\-)
(if n0
(fail)
(let ([real (do-dec-sn/ex sn ex (* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))])
(next u:sign r real ex -1)))]
[(#\@)
(if n0
(fail)
(let ([mag (do-dec-sn/ex sn ex (* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))])
(next polar r mag ex)))]
[(#\i) [(#\i)
(let ([imag (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 im:done (make-rectangular real imag)))]) (next u:done (mkrec n0 n1)))])
(exponent+sign (r ex sn ac exp1 exp-sign) (u:exponent+sign (r n0 ex sn ac exp1 exp-sign)
[(digit r) => d [(digit r) => d
(next exponent+digit r ex sn ac exp1 d exp-sign)]) (next u:exponent+digit r n0 ex sn ac exp1 d exp-sign)])
(im:exponent+sign (r real ex sn ac exp1 exp-sign) (u:exponent (r n0 ex sn ac exp1)
[(digit r) => d [(digit r) => d
(next im:exponent+digit r real ex sn ac exp1 d exp-sign)]) (next u:exponent+digit r n0 ex sn ac exp1 d +1)]
[(#\+) (next u:exponent+sign r n0 ex sn ac exp1 +1)]
[(#\-) (next u:exponent+sign r n0 ex sn ac exp1 -1)])
(exponent (r ex sn ac exp1) (u:digit+dot (r n0 ex sn ac exp)
[(digit r) => d
(next exponent+digit r ex sn ac exp1 d +1)]
[(#\+) (next exponent+sign r ex sn ac exp1 +1)]
[(#\-) (next exponent+sign r ex sn ac exp1 -1)])
(im:exponent (r real ex sn ac exp1)
[(digit r) => d
(next im:exponent+digit r real ex sn ac exp1 d +1)]
[(#\+) (next im:exponent+sign r real ex sn ac exp1 +1)]
[(#\-) (next im:exponent+sign r real ex sn ac exp1 -1)])
(digit+dot (r ex sn ac exp)
[(eof) [(eof)
(do-dec-sn/ex sn ex (* ac (expt 10 exp)))] (do-dec-sn/ex sn ex (* ac (expt 10 exp)))]
[(digit r) => d [(digit r) => d
(next digit+dot r ex sn (+ (* ac r) d) (- exp 1))] (next u:digit+dot r n0 ex sn (+ (* ac r) d) (- exp 1))]
[(#\i)
(let ([n1 (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
(next u:done (mkrec n0 n1)))]
[(#\+) [(#\+)
(let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))]) (if n0
(next im:sign r real ex +1))] (fail)
(let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
(next u:sign r real ex +1)))]
[(#\-) [(#\-)
(let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))]) (if n0
(next im:sign r real ex -1))] (fail)
(let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
(next u:sign r real ex -1)))]
[(#\@) [(#\@)
(let ([mag (do-dec-sn/ex sn ex (* ac (expt 10 exp)))]) (if n0
(next polar r mag ex))] (fail)
[(#\i) (let ([mag (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
(let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))]) (next polar r mag ex)))]
(next im:done (make-rectangular 0.0 real)))]
[(#\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 exponent r ex sn ac exp) (next u:exponent r n0 ex sn ac exp)
(fail))]) (fail))])
(im:digit+dot (r real ex sn ac exp)
[(eof)
(do-dec-sn/ex sn ex (* ac (expt 10 exp)))]
[(digit r) => d
(next im:digit+dot r real ex sn (+ (* ac r) d) (- exp 1))]
[(#\i)
(let ([imag (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
(next im:done (make-rectangular real imag)))]
[(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L)
(next im:exponent r real ex sn ac exp)])
(digit+ (r ex sn ac) (u:digit+ (r n0 ex sn ac)
[(eof) (do-sn/ex sn ex ac)] [(eof)
(let ([n1 (do-sn/ex sn ex ac)])
(if n0
(make-rectangular n0 n1)
n1))]
[(digit r) => d [(digit r) => d
(next digit+ r ex sn (+ (* ac r) d))] (next u:digit+ r n0 ex sn (+ (* ac r) d))]
[(#\/) (next ratio r ex sn ac)]
[(#\.) [(#\.)
(if (fx=? r 10) (if (fx=? r 10)
(next digit+dot r ex sn ac 0) (next u:digit+dot r n0 ex sn ac 0)
(fail))] (fail))]
[(#\/) (next u:ratio r n0 ex sn ac)]
[(#\+) [(#\+)
(let ([real (do-sn/ex sn ex ac)]) (if n0
(next im:sign r real ex +1))] (fail)
(let ([real (do-sn/ex sn ex ac)])
(next u:sign r real ex +1)))]
[(#\-) [(#\-)
(let ([real (do-sn/ex sn ex ac)]) (if n0
(next im:sign r real ex -1))] (fail)
(let ([real (do-sn/ex sn ex ac)])
(next u:sign r real ex -1)))]
[(#\i)
(next u:done (mkrec n0 (do-sn/ex sn ex ac)))]
[(#\@) [(#\@)
(let ([mag (do-sn/ex sn ex ac)]) (if n0
(next polar r mag ex))] (fail)
[(#\i) (let ([mag (do-sn/ex sn ex ac)])
(next im:done (make-rectangular 0 (do-sn/ex sn ex ac)))] (next polar r mag ex)))]
[(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L)
(if (fx=? r 10)
(next exponent r ex sn ac 0)
(fail))])
(im:digit+ (r real ex sn ac)
[(digit r) => d
(next im:digit+ r real ex sn (+ (* ac r) d))]
[(#\.)
(if (fx=? r 10)
(next im:digit+dot r real ex sn ac 0)
(fail))]
[(#\/)
(next im:ratio r real ex sn ac)]
[(#\i)
(next im:done (make-rectangular real (do-sn/ex sn ex ac)))]
[(#\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 im:exponent r real ex sn ac 0) (next u:exponent r n0 ex sn ac 0)
(fail))]) (fail))])
(sign-i (r ex sn)
[(eof) (u:sign-i (r n0 ex sn)
(make-rectangular [(eof) (mkrec n0 (do-sn/ex sn ex 1))]
(if (eq? ex 'i) 0.0 0) [(#\n)
sn)] (if n0
[(#\n) (next sign-in r ex sn)]) (next u:sign-in r n0 (* sn +inf.0) ex)
(sign-in (r ex sn) (next u:sign-in r (* sn +inf.0) #f ex))])
[(#\f) (next sign-inf r ex sn)]) (u:sign-in (r n0 n1 ex)
(sign-inf (r ex sn) [(#\f) (next u:sign-inf r n0 n1 ex)])
[(#\.) (next sign-inf. r ex sn)]) (u:sign-inf (r n0 n1 ex)
(sign-inf. (r ex sn) [(#\.) (next u:sign-inf. r n0 n1 ex)])
[(#\0) (next sign-inf.0 r ex sn)]) (u:sign-inf. (r n0 n1 ex)
(sign-inf.0 (r ex sn) [(#\0) (next u:sign-inf.0 r n0 n1 ex)])
[(eof) (if (= sn 1) +inf.0 -inf.0)] ;(* sn +inf.0) (u:sign-inf.0 (r n0 n1 ex)
[(#\+) (next im:sign r (* sn +inf.0) ex +1)] [(eof) (if n1 (make-rectangular n0 n1) n0)]
[(#\-) (next im:sign r (* sn +inf.0) ex -1)] [(#\+) (if n1 (fail) (next u:sign r n0 ex +1))]
[(#\@) (next polar r (* sn +inf.0) ex)] [(#\-) (if n1 (fail) (next u:sign r n0 ex -1))]
[(#\@) (if n1 (fail) (next polar r n0 ex))]
[(#\i) [(#\i)
(next im:done (make-rectangular 0.0 (* sn +inf.0)))]) (next u:done
(if n1
(make-rectangular n0 n1)
(make-rectangular 0.0 n0)))])
(im:sign-i (real ex sn) (u:dot (r n0 ex sn)
[(eof) (make-rectangular real (do-sn/ex sn ex 1))]
[(#\n) (next im:sign-in (make-rectangular real (* sn +inf.0)))])
(im:sign-in (n)
[(#\f) (next im:sign-inf n)])
(im:sign-inf (n)
[(#\.) (next im:sign-inf. n)])
(im:sign-inf. (n)
[(#\0) (next im:sign-inf.0 n)])
(im:sign-inf.0 (n)
[(#\i) (next im:done n)])
(im:sign-n (n) [(#\a) (next im:sign-na n)])
(im:sign-na (n) [(#\n) (next im:sign-nan n)])
(im:sign-nan (n) [(#\.) (next im:sign-nan. n)])
(im:sign-nan. (n) [(#\0) (next im:sign-nan.0 n)])
(im:sign-nan.0 (n) [(#\i) (next im:done n)])
(dot (r ex sn)
[(digit r) => d [(digit r) => d
(next digit+dot r ex sn d -1)]) (next u:digit+dot r n0 ex sn d -1)])
(im:dot (r real ex sn)
[(digit r) => d
(next im:digit+dot r real ex sn d -1)])
(im:sign (r real ex sn) (u:sign (r n0 ex sn)
[(digit r) => d [(digit r) => d
(next im:digit+ r real ex sn d)] (next u:digit+ r n0 ex sn d)]
[(#\i) [(#\i) (next u:sign-i r n0 ex sn)]
(next im:sign-i real ex sn)] [(#\n) (next u:sign-n r n0 ex)]
[(#\n) [(#\.)
(next im:sign-n (make-rectangular real +nan.0))] (if (= r 10)
[(#\.) (next u:dot r n0 ex sn)
(if (fx=? r 10)
(next im:dot r real ex sn)
(fail))]) (fail))])
(sign (r ex sn) (u:sign-n (r n0 ex) [(#\a) (next u:sign-na r n0 ex)])
[(digit r) => d (u:sign-na (r n0 ex) [(#\n) (next u:sign-nan r n0 ex)])
(next digit+ r ex sn d)] (u:sign-nan (r n0 ex) [(#\.) (next u:sign-nan. r n0 ex)])
[(#\i) (u:sign-nan. (r n0 ex) [(#\0) (next u:sign-nan.0 r n0 ex)])
(next sign-i r ex sn)] (u:sign-nan.0 (r n0 ex)
[(#\.) [(eof) (if n0 (make-rectangular n0 +nan.0) +nan.0)]
(if (fx=? r 10) [(#\+) (if n0 (fail) (next u:sign r +nan.0 ex +1))]
(next dot r ex sn) [(#\-) (if n0 (fail) (next u:sign r +nan.0 ex -1))]
(fail))] [(#\@) (if n0 (fail) (next polar r +nan.0 ex))]
[(#\n) [(#\i) (next u:done (mkrec n0 +nan.0))])
(next sign-n r ex)])
(sign-n (r ex) [(#\a) (next sign-na r ex)])
(sign-na (r ex) [(#\n) (next sign-nan r ex)])
(sign-nan (r ex) [(#\.) (next sign-nan. r ex)])
(sign-nan. (r ex) [(#\0) (next sign-nan.0 r ex)])
(sign-nan.0 (r ex)
[(eof) +nan.0]
[(#\+) (next im:sign r +nan.0 ex +1)]
[(#\-) (next im:sign r +nan.0 ex -1)]
[(#\@) (next polar r +nan.0 ex)]
[(#\i) (next sign-nan.0i r ex)])
(sign-nan.0i (r ex)
[(eof) (make-rectangular 0.0 +nan.0)])
(parse-string-h (dr r ex) (parse-string-h (dr r ex)
[(#\x #\X) [(#\x #\X)
@ -420,14 +381,14 @@
(parse-string (dr r ex) (parse-string (dr r ex)
[(#\#) (next parse-string-h dr r ex)] [(#\#) (next parse-string-h dr r ex)]
[(#\+) (next sign dr ex +1)] [(#\+) (next u:sign dr #f ex +1)]
[(#\-) (next sign dr ex -1)] [(#\-) (next u:sign dr #f ex -1)]
[(#\.) [(#\.)
(if (fx=? dr 10) (if (fx=? dr 10)
(next dot dr ex +1) (next u:dot dr #f ex +1)
(fail))] (fail))]
[(digit dr) => d [(digit dr) => d
(next digit+ dr ex +1 d)]) (next u:digit+ dr #f ex +1 d)])
) )
(define-syntax string-config (define-syntax string-config
@ -479,7 +440,7 @@
;;; | <real R> "+" <naninf> "i" ;;; | <real R> "+" <naninf> "i"
;;; | <real R> "-" <naninf> "i" ;;; | <real R> "-" <naninf> "i"
;;; | <real R> "+" "i" ;;; | <real R> "+" "i"
;;; | <real R> "-" "i" ;;; | <real R> "-" "i"
;;; | "+" <ureal R> "i" ;;; | "+" <ureal R> "i"
;;; | "-" <ureal R> "i" ;;; | "-" <ureal R> "i"
;;; | "+" <naninf> "i" ;;; | "+" <naninf> "i"

2
scheme/last-revision
View File

@ -1 +1 @@
1834 1835

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

@ -7,7 +7,8 @@
(import (ikarus) (tests framework)) (import (ikarus) (tests framework))
(define (run-tests) (define (run-tests)
(test-string-to-number)) (test-string-to-number)
(generated-tests))
(define (test string expected) (define (test string expected)
(define (equal-results? x y) (define (equal-results? x y)
@ -249,6 +250,90 @@
(test "+.234i" (make-rectangular 0 0.234)) (test "+.234i" (make-rectangular 0 0.234))
) )
(define (generated-tests)
(define (gen ls1 ls2 comp1 comp2)
(apply append
(map (lambda (x1)
(map (lambda (x2)
(cons (comp1 (car x1) (car x2))
(comp2 (cdr x1) (cdr x2))))
ls2))
ls1)))
(define (gensa ls1 ls2 comp)
(gen ls1 ls2 string-append comp))
(define ureal
'(["0" . 0]
["1" . 1]
["1." . 1.0]
["1.0" . 1.0]
[".5" . 0.5]
["0.5" . 0.5]
["1e1" . 10.0]
["1e+1" . 10.0]
["1e-1" . 0.1]
["1.e1" . 10.0]
["1.e+1" . 10.0]
["1.e-1" . 0.1]
["1.0e1" . 10.0]
["1.0e+1" . 10.0]
["1.0e-1" . 0.1]
[".5e1" . 5.0]
[".5e+1" . 5.0]
[".5e-1" . 0.05]
))
(define naninf
'(["nan.0" . +nan.0]
["inf.0" . +inf.0]))
(define sign
'(["+" . +1]
["-" . -1]))
;;; <real> = <sign> <ureal>
;;; | + <naninf>
;;; | - <naninf>
(define sreal
(append
(gensa sign ureal *)
(gensa sign naninf *)))
(define real
(append ureal sreal))
;;;<complex> = <real>
;;; | <real> @ <real>
;;; | <real> <creal>
;;; | <creal>
;;; <creal> = <seal> i
;;; | +i
;;; | -i
(define creal
(append
(gensa sreal '(["i" . #f]) (lambda (x f) (make-rectangular 0 x)))
`(["+i" . ,(make-rectangular 0 1)]
["-i" . ,(make-rectangular 0 -1)])))
(define complex
(append
real creal
(gensa real creal +)
;(gen real real (lambda (x y) (string-append x "@" y)) make-polar)
))
(printf "TESTING ~s tests\n" (length complex))
(for-each
(lambda (x)
(test (car x) (cdr x)))
complex)
)
) )