* Added reader syntax for +nan.0 -nan.0 +inf.0 and -inf.0

This commit is contained in:
Abdulaziz Ghuloum 2007-09-11 03:06:35 -04:00
parent bf28274d44
commit 277710d6d1
3 changed files with 45 additions and 2 deletions

Binary file not shown.

View File

@ -631,6 +631,44 @@
[(#\1) 1]
[else #f])]
[else (error 'radix-digit "invalid radix ~s" radix)]))
(define (read-char* p ls str who)
(let f ([i 0] [ls ls])
(let ([c (read-char p)])
(cond
[(fx= i (string-length str))
(cond
[(eof-object? c) (void)]
[(delimiter? c) (unread-char c p)]
[else
(unread-char c p)
(error 'tokenize "invalid ~a: ~s" who
(list->string (reverse (cons c ls))))])]
[else
(cond
[(eof-object? c)
(error 'tokenize "invalid eof inside ~a" who)]
[(char=? c (string-ref str i))
(f (add1 i) (cons c ls))]
[else
(unread-char c p)
(error 'tokenize "invalid ~a: ~s" who
(list->string (reverse (cons c ls))))])]))))
(define (tokenize-integer/nan/inf-no-digits p ls)
(let ([c (read-char p)])
(cond
[(eof-object? c) (num-error "invalid eof" ls)]
[(radix-digit c 10) =>
(lambda (d)
(tokenize-integer p (cons c ls) #f 10 d))]
[(char=? c #\.)
(tokenize-decimal-no-digits p (cons c ls) #f)]
[(char=? c #\i)
(read-char* p (cons #\i ls) "nf.0" "number sequence")
(/ 1.0 0.0)]
[(char=? c #\n)
(read-char* p (cons #\i ls) "an.0" "number sequence")
(/ (/ 1.0 0.0) (/ 1.0 0.0))]
[else (num-error "invalid sequence" (cons c ls))])))
(define (tokenize-integer-no-digits p ls exact? radix?)
(let ([c (read-char p)])
(cond
@ -748,7 +786,7 @@
[(delimiter? c) '(datum . +)]
[else
(cons 'datum
(tokenize-integer-no-digits p '(#\+) #f 10))]))]
(tokenize-integer/nan/inf-no-digits p '(#\+)))]))]
[(memq c '(#\-))
(let ([c (peek-char p)])
(cond
@ -761,7 +799,7 @@
(cons 'datum (string->symbol str))))]
[else
(cons 'datum
(- (tokenize-integer-no-digits p '(#\-) #f 10)))]))]
(- (tokenize-integer/nan/inf-no-digits p '(#\-))))]))]
[($char= #\. c)
(tokenize-dot p)]
[($char= #\| c)

View File

@ -2,6 +2,7 @@
(import (ikarus))
(define (rationalize x eps)
(simplest (- x eps) (+ x eps)))
@ -41,4 +42,8 @@
(test 314/100 1/100 22/7)
(test (exact 0.3) 1/10 1/3)
(test 0.3 1/10 #i1/3)
(test (/ 1.0 0.0) 3 (/ 1.0 0.0))
;;; dead
(test (/ 1.0 0.0) (/ 1.0 0.0) (/ (/ 0.0 0.0) (/ 1.0 0.0)))