diff --git a/src/ikarus.boot b/src/ikarus.boot index 59e3283..eedc1ca 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.reader.ss b/src/ikarus.reader.ss index 1b7cb05..7ed7bae 100644 --- a/src/ikarus.reader.ss +++ b/src/ikarus.reader.ss @@ -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) diff --git a/src/rationalize.ss b/src/rationalize.ss index 8930aa8..bfa7bf8 100755 --- a/src/rationalize.ss +++ b/src/rationalize.ss @@ -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))) +