From a087aea3e58560427980b28d9ccb64815edbff01 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 14 Jul 2014 10:20:10 +0100 Subject: [PATCH] at-exp and scribble: adjust reader to compose better with readtable extensions The `at-exp` reader now delays picking up the current readtable until `read`/`read-syntax` is called. Also, it uses the new 'dynamic configuration of readers for the command and datum parts of an @-form, which delays a decision of readtable on each part until reading the part. Thanks to Alexander Knauth for sorting out pieces of the puzzle. --- .../at-exp-lib/at-exp/lang/reader.rkt | 5 +- pkgs/racket-pkgs/at-exp-lib/info.rkt | 2 + .../at-exp-lib/scribble/reader.rkt | 60 +++++++++----- .../scribble/reader-internals.scrbl | 78 ++++++++++++++----- .../scribble-test/tests/scribble/reader.rkt | 33 +++++++- 5 files changed, 135 insertions(+), 43 deletions(-) diff --git a/pkgs/racket-pkgs/at-exp-lib/at-exp/lang/reader.rkt b/pkgs/racket-pkgs/at-exp-lib/at-exp/lang/reader.rkt index 8a0b721ce1..8e102e5b6e 100644 --- a/pkgs/racket-pkgs/at-exp-lib/at-exp/lang/reader.rkt +++ b/pkgs/racket-pkgs/at-exp-lib/at-exp/lang/reader.rkt @@ -6,11 +6,10 @@ [at-read-syntax read-syntax] [at-get-info get-info])) - (define at-readtable (make-at-readtable)) - (define (wrap-reader p) (lambda args - (parameterize ([current-readtable at-readtable]) + (parameterize ([current-readtable (make-at-readtable #:datum-readtable 'dynamic + #:command-readtable 'dynamic)]) (apply p args)))) (define-values (at-read at-read-syntax at-get-info) diff --git a/pkgs/racket-pkgs/at-exp-lib/info.rkt b/pkgs/racket-pkgs/at-exp-lib/info.rkt index b1e758f350..6d1143ceb1 100644 --- a/pkgs/racket-pkgs/at-exp-lib/info.rkt +++ b/pkgs/racket-pkgs/at-exp-lib/info.rkt @@ -6,3 +6,5 @@ (define pkg-desc "Libraries for @-expressions") (define pkg-authors '(eli mflatt)) + +(define version "1.1") diff --git a/pkgs/racket-pkgs/at-exp-lib/scribble/reader.rkt b/pkgs/racket-pkgs/at-exp-lib/scribble/reader.rkt index 57fcb0997b..e6d7597399 100644 --- a/pkgs/racket-pkgs/at-exp-lib/scribble/reader.rkt +++ b/pkgs/racket-pkgs/at-exp-lib/scribble/reader.rkt @@ -535,13 +535,21 @@ (provide make-at-readtable make-at-reader) (define ((make-at-readtable-or-inside-reader inside-reader?) - readtable command-char datum-readtable syntax-post-processor) + readtable command-char command-readtable datum-readtable syntax-post-processor) + (define (get-cmd-rt) + (if (readtable? cmd-rt) + cmd-rt + (cmd-rt))) + (define (get-datum-rt) + (if (eq? datum-rt 'dynamic) + (current-readtable) + datum-rt)) (define dispatcher - (make-dispatcher #f command-char (lambda () cmd-rt) (lambda () datum-rt) + (make-dispatcher #f command-char get-cmd-rt get-datum-rt syntax-post-processor)) (define (make-inside-reader) (define dispatcher - (make-dispatcher #t command-char (lambda () cmd-rt) (lambda () datum-rt) + (make-dispatcher #t command-char get-cmd-rt get-datum-rt syntax-post-processor)) ;; use a name consistent with `make-at-reader' (named-lambda (at-read-syntax/inside [src default-src] @@ -551,28 +559,34 @@ (dispatcher #f inp (src-name src inp) line col pos)))) (define at-rt (make-readtable readtable command-char 'non-terminating-macro dispatcher)) - (define cmd-rt + (define command-bar + (lambda (char inp source-name line-num col-num position) + (let ([m (*regexp-match #rx#"^([^|]*)\\|" inp)]) + (unless m + (raise-read-error "unbalanced `|'" source-name + line-num col-num position #f)) + (datum->syntax + #f (string->symbol (bytes->string/utf-8 (cadr m))) + (vector source-name line-num col-num position + (add1 (bytes-length (car m)))) + orig-stx)))) + (define (make-cmd-rt command-readtable) ;; similar to plain Racket (scribble, actually), but with `@' as usual and ;; and `|' as a terminating macro characters (otherwise it behaves the ;; same; the only difference is that `a|b|c' is three symbols) - (make-readtable readtable + (make-readtable command-readtable command-char 'non-terminating-macro dispatcher - #\| 'terminating-macro - (lambda (char inp source-name line-num col-num position) - (let ([m (*regexp-match #rx#"^([^|]*)\\|" inp)]) - (unless m - (raise-read-error "unbalanced `|'" source-name - line-num col-num position #f)) - (datum->syntax - #f (string->symbol (bytes->string/utf-8 (cadr m))) - (vector source-name line-num col-num position - (add1 (bytes-length (car m)))) - orig-stx))))) + #\| 'terminating-macro command-bar)) + (define cmd-rt + (if (eq? command-readtable 'dynamic) + (readtable-cached make-cmd-rt) + (make-cmd-rt command-readtable))) (define datum-rt (cond [(or (not datum-readtable) (readtable? datum-readtable)) datum-readtable] [(eq? #t datum-readtable) at-rt] [(procedure? datum-readtable) (datum-readtable at-rt)] + [(eq? datum-readtable 'dynamic) 'dynamic] [else (error 'make-at-readtable "bad datum-readtable: ~e" datum-readtable)])) (if inside-reader? (make-inside-reader) at-rt)) @@ -580,20 +594,22 @@ (define (make-at-readtable #:readtable [readtable (current-readtable)] #:command-char [command-char ch:command] + #:command-readtable [command-readtable readtable] #:datum-readtable [datum-readtable #t] #:syntax-post-processor [syntax-post-processor values]) ((make-at-readtable-or-inside-reader #f) - readtable command-char datum-readtable syntax-post-processor)) + readtable command-char command-readtable datum-readtable syntax-post-processor)) (define (make-at-reader #:readtable [readtable (current-readtable)] #:command-char [command-char ch:command] #:datum-readtable [datum-readtable #t] + #:command-readtable [command-readtable readtable] #:syntax-post-processor [syntax-post-processor values] #:syntax? [syntax-reader? #t] #:inside? [inside-reader? #f]) (let ([r ((make-at-readtable-or-inside-reader inside-reader?) - readtable command-char datum-readtable syntax-post-processor)]) + readtable command-char command-readtable datum-readtable syntax-post-processor)]) ;; the result can be a readtable or a syntax reader, depending on inside?, ;; convert it now to the appropriate reader (if inside-reader? @@ -626,10 +642,14 @@ ;; utilities for below (define make-default-at-readtable - (readtable-cached (lambda (rt) (make-at-readtable #:readtable rt)))) + (readtable-cached (lambda (rt) (make-at-readtable #:readtable rt + #:command-readtable 'dynamic + #:datum-readtable 'dynamic)))) (define make-default-at-reader/inside (readtable-cached - (lambda (rt) (make-at-reader #:inside? #t #:readtable rt)))) + (lambda (rt) (make-at-reader #:inside? #t #:readtable rt + #:command-readtable 'dynamic + #:datum-readtable 'dynamic)))) ;; ---------------------------------------------------------------------------- ;; readers diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/reader-internals.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/reader-internals.scrbl index c7aa6d0b41..c0a1c23bfa 100644 --- a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/reader-internals.scrbl +++ b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/reader-internals.scrbl @@ -177,33 +177,48 @@ provides direct Scribble reader functionality for advanced needs.} (require (for-label scribble/reader)) @; *** Start reader-import section *** +@deftogether[( @defproc[(read [in input-port? (current-input-port)]) any]{} @defproc[(read-syntax [source-name any/c (object-name in)] [in input-port? (current-input-port)]) - (or/c syntax? eof-object?)]{ -These procedures implement the Scribble reader. They do so by -constructing a reader table based on the current one, and using that -for reading. -} + (or/c syntax? eof-object?)] +)]{ +Implements the Scribble reader using the readtable produced by + +@racketblock[(make-at-readtable #:command-readtable 'dynamic + #:datum-readtable 'dynamic)] + +@history[#:changed "1.1" @elem{Changed to use @racket['dynamic] for the command and datum readtables.}]} + + +@deftogether[( @defproc[(read-inside [in input-port? (current-input-port)]) any]{} @defproc[(read-syntax-inside [source-name any/c (object-name in)] [in input-port? (current-input-port)] [#:command-char command-char char? #\@]) - (or/c syntax? eof-object?)]{ -These @racketid[-inside] variants parse as if starting inside a -@litchar["@{"]...@litchar["}"], and they return a (syntactic) list. -The @racket[command-char] is used to customize the readtable. -Useful for implementing languages that are textual by default (see -@filepath{docreader.rkt} for example). + (or/c syntax? eof-object?)] +)]{ + +Like @racket[read] and @racket[read-syntax], but starting as if +inside a @litchar["@{"]...@litchar["}"] to return a (syntactic) list, +which is useful for implementing languages that are textual by default. + +The given @racket[command-char] is used to customize the readtable +used by the reader, effectively passing it along to @racket[make-at-readtable]. + +@history[#:changed "1.1" @elem{Changed to use @racket['dynamic] for the command and datum readtables.}] } @defproc[(make-at-readtable [#:readtable readtable readtable? (current-readtable)] [#:command-char command-char char? #\@] + [#:command-readtable command-readtable (or/c readtable? 'dynamic) readtable] [#:datum-readtable datum-readtable - (or/c readtable? boolean? - (readtable? . -> . readtable?)) + (or/c readtable? + boolean? + (readtable? . -> . readtable?) + 'dynamic) #t] [#:syntax-post-processor syntax-post-proc (syntax? . -> . syntax?) @@ -220,11 +235,31 @@ resulting reader in several ways: @item{@racket[command-char] --- the character used for @tech{@"@"-forms}.} -@item{@racket[datum-readtable] --- determines the readtable used for - reading the datum part. A @racket[#t] values uses the - @"@"-readtable, otherwise it can be a readtable, or a - readtable-to-readtable function that will construct one from the - @"@"-readtable. The idea is that you may want to have completely +@item{@racket[command-readtable] --- determines the readtable that is + extended for reading the command part of an @tech{@"@"-form}: + + @itemlist[ + @item{a readtable --- extended to make @litchar{|} a delimiter + instead of a symbol-quoting character} + + @item{@racket['dynamic] --- extends @racket[(current-readtable)] + at the point where a command is parsed to make @litchar{|} a + delimiter} + ]} + +@item{@racket[datum-readtable] --- the readtable used for + reading the datum part of an @tech{@"@"-form}: + + @itemlist[ + @item{@racket[#t] --- uses the constructed @"@"-readtable itself} + @item{a readtable --- uses the given readtable} + @item{a readtable-to-readtable function --- called to construct a readtable + from the generated @"@"-readtable} + @item{@racket['dynamic] --- uses @racket[(current-readtable)] at the + point where the datum part is parsed} + ] + + The idea is that you may want to have completely different uses for the datum part, for example, introducing a convenient @litchar{key=val} syntax for attributes.} @@ -243,7 +278,11 @@ resulting reader in several ways: [_else (error "@ forms must have a body")]))) ]} -]} +] + +@history[#:changed "1.1" @elem{Added @racket[#:command-readtable] and + the @racket['dynamic] option for @racket[#:datum-readtable].}]} + @defproc[(make-at-reader [#:syntax? syntax? #t] [#:inside? inside? #f] ...) procedure?]{ @@ -268,6 +307,7 @@ reading. Note that if @racket[syntax?] is true, the @racket[read]-like function is constructed by simply converting a syntax result back into a datum.} + @defproc[(use-at-readtable ...) void?]{ Passes all arguments to @racket[make-at-readtable], and installs the diff --git a/pkgs/scribble-pkgs/scribble-test/tests/scribble/reader.rkt b/pkgs/scribble-pkgs/scribble-test/tests/scribble/reader.rkt index 31b5df2621..5b225963d0 100644 --- a/pkgs/scribble-pkgs/scribble-test/tests/scribble/reader.rkt +++ b/pkgs/scribble-pkgs/scribble-test/tests/scribble/reader.rkt @@ -898,6 +898,26 @@ END-OF-TESTS (define -@error-> (mk-error-test scr:read)) (define -\\error-> (mk-error-test read/BS)) +(define (make-@+-readtable #:command-readtable [command-readtable (current-readtable)] + #:datum-readtable [datum-readtable (current-readtable)]) + (make-readtable (scr:make-at-readtable #:command-readtable command-readtable + #:datum-readtable datum-readtable) + #\+ 'terminating-macro (lambda args 'PLUS))) +(define @+-readtable (make-@+-readtable)) +(define @c+-readtable (make-@+-readtable #:command-readtable 'dynamic)) +(define @d+-readtable (make-@+-readtable #:datum-readtable 'dynamic)) +(define @cd+-readtable (make-@+-readtable #:command-readtable 'dynamic + #:datum-readtable 'dynamic)) + +(define-syntax-rule (@+checker a b readtable) + (equal? (parameterize ([current-readtable readtable]) + (read (open-input-string a))) + b)) +(define-syntax-rule (a . -@+> . b) (@+checker a b @+-readtable)) +(define-syntax-rule (a . -@c+> . b) (@+checker a b @c+-readtable)) +(define-syntax-rule (a . -@d+> . b) (@+checker a b @d+-readtable)) +(define-syntax-rule (a . -@cd+> . b) (@+checker a b @cd+-readtable)) + ;; running the tests (provide reader-tests) (module+ main (reader-tests)) @@ -932,4 +952,15 @@ END-OF-TESTS (format "bad result in\n ~a\n results:\n ~s != ~s" (regexp-replace* #rx"\n" t "\n ") x y) - (matching? x y)))))))))) + (matching? x y)))))))) + + ;; Check static versus dynamic readtable for command (dynamic when "c" in the + ;; name) and datum (dynamic when "d" in the name) parts: + (-@+> "10" 10) + (-@+> "(+ @+[+] +)" '(PLUS (+ +) PLUS)) + (-@+> "@+[+]" '(+ +)) + (-@d+> "@+[+]" '(+ PLUS)) + (-@d+> "(+ @+[+])" '(PLUS (+ PLUS))) + (-@c+> "@+[+]" '(PLUS +)) + (-@c+> "@|+|" 'PLUS) + (-@cd+> "@+[+]" '(PLUS PLUS))))