suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

r6rs reader: delay number & symbol regexp construction

Browse Source 
svn: r14392
This commit is contained in:
Matthew Flatt 2009-03-31 21:25:20 +00:00
parent 0db0fefba5
commit 682d76d577
2 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/r6rs/private/readtable.ss
View File

@ -3,6 +3,7 @@
;; Readtable-based R6RS reading ;; Readtable-based R6RS reading
(require syntax/readerr (require syntax/readerr
scheme/promise
(for-syntax scheme/base)) (for-syntax scheme/base))
(provide with-r6rs-reader-parameters (provide with-r6rs-reader-parameters
@ -436,8 +437,8 @@
(num 8) (num 8)
(num 2))) (num 2)))
(values (pregexp (string-append "^" identifier "$")) (values (delay (pregexp (string-append "^" identifier "$")))
(pregexp (string-append "^" number "$"))))) (delay (pregexp (string-append "^" number "$"))))))
(define (do-read-symbol-or-number num? prefix port src line col pos) (define (do-read-symbol-or-number num? prefix port src line col pos)
;; Read a delimited sequence (using an extended notion of delimiter), ;; Read a delimited sequence (using an extended notion of delimiter),
@ -453,7 +454,7 @@
[(regexp-match? #rx"^[a-zA-Z!$%&*/:<=>?^_~][a-zA-Z0-9+!$%&*/:<=>?^_~.@-]*$" thing) [(regexp-match? #rx"^[a-zA-Z!$%&*/:<=>?^_~][a-zA-Z0-9+!$%&*/:<=>?^_~.@-]*$" thing)
;; Simple symbol: ;; Simple symbol:
(string->symbol thing)] (string->symbol thing)]
[(regexp-match? rx:number thing) [(regexp-match? (force rx:number) thing)
(let ([n (string->number (let ([n (string->number
;; MzScheme doesn't handle mantissa widths, yet, so strip them out: ;; MzScheme doesn't handle mantissa widths, yet, so strip them out:
(regexp-replace* #rx"[|][0-9]+" thing ""))]) (regexp-replace* #rx"[|][0-9]+" thing ""))])
@ -461,7 +462,7 @@
(error 'r6rs-parser "number didn't convert: ~e" thing)) (error 'r6rs-parser "number didn't convert: ~e" thing))
n)] n)]
[(and (not num?) [(and (not num?)
(regexp-match? rx:id thing)) (regexp-match? (force rx:id) thing))
(string->symbol (string->symbol
(bytes->string/utf-8 (bytes->string/utf-8
(let loop ([t (string->bytes/utf-8 thing)]) (let loop ([t (string->bytes/utf-8 thing)])

3
collects/rnrs/base-6.ss
View File

@ -3,6 +3,7 @@
(require (for-syntax (rename-in r6rs/private/base-for-syntax (require (for-syntax (rename-in r6rs/private/base-for-syntax
[syntax-rules r6rs:syntax-rules]) [syntax-rules r6rs:syntax-rules])
scheme/base) scheme/base)
scheme/promise
scheme/splicing scheme/splicing
r6rs/private/qq-gen r6rs/private/qq-gen
r6rs/private/exns r6rs/private/exns
@ -346,7 +347,7 @@
[s (if (regexp-match? #rx"#[dDxXoObB]" s) [s (if (regexp-match? #rx"#[dDxXoObB]" s)
s s
(string-append prefix s))]) (string-append prefix s))])
(and (regexp-match? rx:number s) (and (regexp-match? (force rx:number) s)
(string->number (regexp-replace* #rx"[|][0-9]+" s ""))))) (string->number (regexp-replace* #rx"[|][0-9]+" s "")))))
(define r6rs:symbol=? (define r6rs:symbol=?