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

create a readtable on top of current-readtable

Browse Source 
svn: r6889
This commit is contained in:
Eli Barzilay 2007-07-11 07:06:57 +00:00
parent ca64ce1415
commit 9a21c13be1
1 changed files with 26 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
collects/scribble/reader.ss
View File

@ -162,7 +162,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
;; main reader function for @ constructs ;; main reader function for @ constructs
(define ((dispatcher start-inside?) (define ((make-dispatcher start-inside?)
char inp source-name line-num col-num position) char inp source-name line-num col-num position)
(define (read-error line col pos msg . xs) (define (read-error line col pos msg . xs)
@ -175,7 +175,7 @@
(define (read-stx) (read-syntax/recursive source-name inp)) (define (read-stx) (read-syntax/recursive source-name inp))
(define (read-stx/rt rt) (read-syntax/recursive source-name inp #f rt)) (define (read-stx/rt rt) (read-syntax/recursive source-name inp #f rt))
;; use this to avoid placeholders so we have source location information ;; use this to avoid placeholders
(define (read-stx*) (define (read-stx*)
;; (read-syntax/recursive source-name inp #f (current-readtable) #f) ;; (read-syntax/recursive source-name inp #f (current-readtable) #f)
(read-syntax source-name inp)) (read-syntax source-name inp))
@ -322,8 +322,7 @@
[(cadr m) [(cadr m)
;; the command is a string escape, use `read-stx*' ;; the command is a string escape, use `read-stx*'
;; to not get a placeholder, so we can merge the ;; to not get a placeholder, so we can merge the
;; string to others, and adjust source location to ;; string to others
;; avoid bogus indentation
(read-stx*)] (read-stx*)]
[(caddr m) [(caddr m)
;; it's an expression escape, get multiple ;; it's an expression escape, get multiple
@ -375,8 +374,7 @@
;; single? means expect just one expression (or none, which is returned ;; single? means expect just one expression (or none, which is returned
;; as a special-comment) ;; as a special-comment)
(let ([get (lambda () (let ([get (lambda ()
(parameterize ([current-readtable command-readtable]) (parameterize ([current-readtable (make-command-readtable)])
;; tweak source information to avoid bad indentation
(read-delimited-list re:expr-escape re:expr-escape (read-delimited-list re:expr-escape re:expr-escape
ch:expr-escape)))]) ch:expr-escape)))])
(if single? (if single?
@ -391,7 +389,7 @@
;; called only when we must see a command in the input ;; called only when we must see a command in the input
(define (get-command) (define (get-command)
(let ([cmd (read-stx/rt command-readtable)]) (let ([cmd (read-stx/rt (make-command-readtable))])
(cond [(special-comment? cmd) (cond [(special-comment? cmd)
(read-error* "expecting a command expression, got a comment")] (read-error* "expecting a command expression, got a comment")]
[(eof-object? cmd) [(eof-object? cmd)
@ -457,24 +455,28 @@
(list source-name line-num col-num position (list source-name line-num col-num position
(span-from position))))])) (span-from position))))]))
(define dispatcher (make-dispatcher #f))
(define inside-dispatcher (make-dispatcher #t))
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
;; readtables ;; readtables
(define at-readtable (define (make-at-readtable)
(make-readtable #f ch:command 'non-terminating-macro (dispatcher #f))) (make-readtable (current-readtable)
ch:command 'non-terminating-macro dispatcher))
(provide use-at-readtable) (provide use-at-readtable)
(define (use-at-readtable) (define (use-at-readtable)
(port-count-lines! (current-input-port)) (port-count-lines! (current-input-port))
(current-readtable at-readtable)) (current-readtable (make-at-readtable)))
;; similar to plain Scheme (scribble, actually), but with `@' and `|' as ;; similar to plain Scheme (scribble, actually), but with `@' and `|' as
;; terminating macro characters (otherwise it behaves the same; the only ;; terminating macro characters (otherwise it behaves the same; the only
;; difference is that `a|b|c' is three symbols and `@foo@bar' are two ;; difference is that `a|b|c' is three symbols and `@foo@bar' are two
;; @-forms) ;; @-forms)
(define command-readtable (define (make-command-readtable)
(make-readtable at-readtable (make-readtable (current-readtable)
ch:command 'terminating-macro (dispatcher #f) ch:command 'terminating-macro dispatcher
#\| 'terminating-macro #\| 'terminating-macro
(lambda (char inp source-name line-num col-num position) (lambda (char inp source-name line-num col-num position)
(let ([m (*regexp-match #rx#"^([^|]*)\\|" inp)]) (let ([m (*regexp-match #rx#"^([^|]*)\\|" inp)])
@ -490,26 +492,29 @@
(define (src-name src port) (define (src-name src port)
(if (eq? src default-src) (object-name port) src)) (if (eq? src default-src) (object-name port) src))
(define-syntax with-at-reader
(syntax-rules ()
[(_ body ...)
(parameterize ([current-readtable (make-at-readtable)]) body ...)]))
(define/kw (*read #:optional [inp (current-input-port)]) (define/kw (*read #:optional [inp (current-input-port)])
(parameterize ([current-readtable at-readtable]) (with-at-reader (read inp)))
(read inp)))
(define/kw (*read-syntax #:optional [src default-src] (define/kw (*read-syntax #:optional [src default-src]
[inp (current-input-port)]) [inp (current-input-port)])
(parameterize ([current-readtable at-readtable]) (with-at-reader (read-syntax (src-name src inp) inp)))
(read-syntax (src-name src inp) inp)))
(define/kw (read-inside #:optional [inp (current-input-port)]) (define/kw (read-inside #:optional [inp (current-input-port)])
(let-values ([(line col pos) (port-next-location inp)]) (let-values ([(line col pos) (port-next-location inp)])
(parameterize ([current-readtable at-readtable]) (with-at-reader
(syntax-object->datum (syntax-object->datum
((dispatcher #t) #f inp (object-name inp) line col pos))))) (inside-dispatcher #f inp (object-name inp) line col pos)))))
(define/kw (read-inside-syntax #:optional [src default-src] (define/kw (read-inside-syntax #:optional [src default-src]
[inp (current-input-port)]) [inp (current-input-port)])
(let-values ([(line col pos) (port-next-location inp)]) (let-values ([(line col pos) (port-next-location inp)])
(parameterize ([current-readtable at-readtable]) (with-at-reader
((dispatcher #t) #f inp (src-name src inp) line col pos)))) (inside-dispatcher #f inp (src-name src inp) line col pos))))
(provide (rename *read read) (rename *read-syntax read-syntax) (provide (rename *read read) (rename *read-syntax read-syntax)
read-inside read-inside-syntax) read-inside read-inside-syntax)