nybble
/
rosella
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Read numbers as a subset of symbol syntax.

This commit is contained in:
Jesse D. McDonald 2012-07-13 00:29:18 -05:00
parent b923693c61
commit 8f9ce6122e
1 changed files with 85 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

133
src/lib/reader.rls
View File

@ -26,10 +26,6 @@
[(eq? current-char #\[) [(eq? current-char #\[)
(next-char) (next-char)
(read-list #\])] (read-list #\])]
[(or (eq? current-char #\-)
(eq? current-char #\+)
(decimal-char? current-char))
(read-number)]
[(eq? current-char #\") [(eq? current-char #\")
(read-string)] (read-string)]
[(eq? current-char #\|) [(eq? current-char #\|)
@ -49,7 +45,7 @@
(list 'unquote-splicing (read-one-value))) (list 'unquote-splicing (read-one-value)))
(list 'unquote (read-one-value)))] (list 'unquote (read-one-value)))]
[(symbol-char? current-char) [(symbol-char? current-char)
(read-symbol)] (read-symbol #f string->number-or-symbol)]
[else [else
(syntax-error)])) (syntax-error)]))
(list current-read-eof-handler (lambda () (syntax-error)))))) (list current-read-eof-handler (lambda () (syntax-error))))))
@ -192,45 +188,83 @@
accum))))]) accum))))])
(if neg? (fix- pos-val) pos-val)))) (if neg? (fix- pos-val) pos-val))))
(define (read-number) (define (parse-number str)
(let ([negative (cond [(eq? current-char #\-) (next-char) #t] (define (end? n) (fix>= n (byte-string-size str)))
[(eq? current-char #\+) (next-char) #f] (define (char n) (byte-string-ref str n))
[else #f])]) (define (next n) (fix+ n 1))
(unless (decimal-char? current-char) (syntax-error)) (let/cc return
(let ([radix (if (eq? current-char #\0) (define (fail) (return #f))
(begin (define (start n)
(next-char) (cond
(cond [(memq current-char '(#\X #\x)) (next-char) 16] [(end? n) (fail)]
[(memq current-char '(#\B #\b)) (next-char) 2] [(eq? (char n) #\+) (digits (next n) #f)]
[(decimal-char? current-char) 8] [(eq? (char n) #\-) (digits (next n) #t)]
[else 10])) [#t (digits n #f)]))
10)]) (define (digits n neg)
(let ([num (let iter ([num 0]) (cond
(if (alphanumeric-char? current-char) [(end? n) (fail)]
(let ([digit (digit->integer current-char)]) [(eq? (char n) #\.) (fpnum* (next n) neg)]
(if (fix< digit radix) [(eq? (char n) #\0) (leading-zero (next n) neg)]
(begin [(decimal-char? (char n)) (decimal n neg 0)]))
(next-char) (define (leading-zero n neg)
(iter (fix+ (fix* num radix) digit))) (cond
num)) [(end? n) 0]
num))]) [(eq? (char n) #\.) (fpnum (next n) neg 0.0)]
(if (or (not (eq? radix 10)) [(memq (char n) '(#\E #\e)) (fpnum-exp (next n) neg 0.0)]
(not (memq current-char '(#\. #\E #\e)))) [(memq (char n) '(#\X #\x)) (radix (next n) neg 16 0)]
(if negative (fix- num) num) [(memq (char n) '(#\B #\b)) (radix (next n) neg 2 0)]
(let ([flt (make-float num)]) [(octal-char? (char n)) (radix n neg 8 0)]))
(when (eq? current-char #\.) (define (radix n neg rad accum)
(next-char) (cond
(let iter ([pv (if negative -0.1 0.1)]) [(end? n) (if neg (fix-neg accum) accum)]
(if (decimal-char? current-char) [(hex-char? (char n)) (let ([int (digit->integer (char n))])
(let ([digit (make-float (digit->integer current-char))]) (when (fix>= int rad) (fail))
(set! flt (float+ flt (float* digit pv))) (radix (next n) neg rad (fix+ (fix* accum rad) int)))]))
(next-char) (define (decimal n neg accum)
(iter (float/ pv 10))) (cond
(values)))) [(end? n) (if neg (fix-neg accum) accum)]
(when (memq current-char '(#\E #\e)) [(eq? (char n) #\.) (fpnum (next n) neg (make-float accum))]
(next-char) [(memq (char n) '(#\E #\e)) (fpnum-exp (next n) neg (make-float accum))]
(set! flt (float* flt (pow 10.0 (make-float (read-fixnum 10)))))) [(decimal-char? (char n)) (let ([int (digit->integer (char n))])
(if negative (float- flt) flt))))))) (decimal (next n) neg
(fix+ (fix* accum 10) int)))]))
(define (fpnum* n neg) ; follows ".", "+.", or "-."; needs a digit for float
(cond
[(end? n) (fail)]
[(decimal-char? (char n)) (let ([int (digit->integer (char n))])
(fpnum (next n) neg
(float* (make-float int) 0.1)
(float/ 0.1 10.0)))]))
(define (fpnum n neg accum [pv 0.1])
(cond
[(end? n) (if neg (float-neg accum) accum)]
[(memq (char n) '(#\E #\e)) (fpnum-exp (next n) neg accum)]
[(decimal-char? (char n)) (let ([int (digit->integer (char n))])
(fpnum (next n) neg
(float+ accum (float* (make-float int) pv))
(float/ pv 10.0)))]))
(define (fpnum-exp n neg accum)
(let ([signed-accum (if neg (float-neg accum) accum)])
(cond
[(end? n) (fail)]
[(eq? (char n) #\+) (fpnum-exp-digit+ (next n) signed-accum #f)]
[(eq? (char n) #\-) (fpnum-exp-digit+ (next n) signed-accum #t)]
[#t (fpnum-exp-digit+ n signed-accum #f)])))
(define (fpnum-exp-digit+ n accum neg)
(cond
[(end? n) (fail)]
[(decimal-char? (char n)) (let ([int (digit->integer (char n))])
(fpnum-exp-digit* (next n) accum neg int))]))
(define (fpnum-exp-digit* n accum neg expon)
(cond
[(end? n) ((if neg float/ float*)
accum
(pow 10.0 (make-float expon)))]
[(decimal-char? (char n)) (let ([int (digit->integer (char n))])
(fpnum-exp-digit* (next n) accum neg
(fix+ (fix* expon 10) int)))]))
(start 0)
(fail)))
(define (read-box) (define (read-box)
(make-box (read-one-value))) (make-box (read-one-value)))
@ -388,6 +422,10 @@
[(byte-string= name "RUBOUT") 127] [(byte-string= name "RUBOUT") 127]
[else (syntax-error)])))))) [else (syntax-error)]))))))
(define (string->number-or-symbol str)
(or (parse-number str)
(string->symbol str)))
(define (read-symbol [quoted? #f] [convert-fn string->symbol]) (define (read-symbol [quoted? #f] [convert-fn string->symbol])
(define (read-chars) (define (read-chars)
(cond (cond
@ -410,8 +448,7 @@
(cons ch (read-chars)))] (cons ch (read-chars)))]
[else '()])) [else '()]))
(let* ([chars (read-chars)]) (convert-fn (list->string (read-chars))))
(convert-fn (list->string chars))))
(define (read-keyword) (define (read-keyword)
(if (eq? current-char #\|) (if (eq? current-char #\|)
@ -490,8 +527,8 @@
(define (symbol-char? ch) (define (symbol-char? ch)
(or (alphanumeric-char? ch) (or (alphanumeric-char? ch)
(memq? ch '(#\! #\$ #\% #\& #\* #\+ (memq? ch '(#\! #\$ #\% #\& #\* #\+
#\- #\/ #\: #\< #\= #\> #\- #\. #\/ #\: #\< #\=
#\? #\@ #\^ #\_ #\~)))) #\> #\? #\@ #\^ #\_ #\~))))
(define (digit->integer ch) (define (digit->integer ch)
(cond (cond