syntax/module-reader: add a #:module-wrapper option

A `#:module-wrapper` option is useful for adding a scope to an
entire `module` form.
This commit is contained in:
Matthew Flatt 2015-07-28 14:25:57 -06:00
parent cc1c989942
commit e3ed57633e
2 changed files with 44 additions and 13 deletions

View File

@ -37,6 +37,7 @@ language, though it may also be @racket[require]d to get
(code:line #:whole-body-readers? whole?-expr) (code:line #:whole-body-readers? whole?-expr)
(code:line #:wrapper1 wrapper1-expr) (code:line #:wrapper1 wrapper1-expr)
(code:line #:wrapper2 wrapper2-expr) (code:line #:wrapper2 wrapper2-expr)
(code:line #:module-wrapper module-wrapper-expr)
(code:line #:language lang-expr) (code:line #:language lang-expr)
(code:line #:info info-expr) (code:line #:info info-expr)
(code:line #:language-info language-info-expr)]) (code:line #:language-info language-info-expr)])
@ -49,6 +50,8 @@ language, though it may also be @racket[require]d to get
. -> . any/c) . -> . any/c)
(input-port? (input-port? . -> . any/c) (input-port? (input-port? . -> . any/c)
boolean? . -> . any/c))] boolean? . -> . any/c))]
[module-wrapper (or/c ((-> any/c) . -> . any/c)
((-> any/c) boolean? . -> . any/c))]
[info-expr (symbol? any/c (symbol? any/c . -> . any/c) . -> . any/c)] [info-expr (symbol? any/c (symbol? any/c . -> . any/c) . -> . any/c)]
[language-info-expr (or/c (vector/c module-path? symbol? any/c) #f)] [language-info-expr (or/c (vector/c module-path? symbol? any/c) #f)]
[lang-expr (or/c module-path? [lang-expr (or/c module-path?
@ -151,6 +154,23 @@ identifiers used by the @racket[reader-option]s.
boolean that indicates whether it is used in @racket[read] boolean that indicates whether it is used in @racket[read]
(@racket[#f]) or @racket[read-syntax] (@racket[#t]) mode.} (@racket[#f]) or @racket[read-syntax] (@racket[#t]) mode.}
@item{@racket[#:module-wrapper] specifies a function that controls
the dynamic context in which the overall @racket[module] form
is produced, including calls to the @racket[read] and
@racket[read-syntax] functions and to any @racket[#:wrapper1]
and @racket[#:wrapper2] functions. The
@racket[#:module-wrapper1]-specified function must accept a
thunk, and it can optionally accept a boolean that indicates
whether it is used in @racket[read] (@racket[#f]) or
@racket[read-syntax] (@racket[#t]) mode.
While a @racket[#:wrapper1]-specified or
@racket[#:wrapper2]-specified function sees only individual
forms within the read module, a
@racket[#:module-wrapper]-specified function sees the entire
result @racket[module] form (via the result of its thunk
argument).}
@item{@racket[#:info] specifies an implementation of reflective @item{@racket[#:info] specifies an implementation of reflective
information that is used by external tools to manipulate the information that is used by external tools to manipulate the
@emph{source} of modules in the language @racket[_something]. For @emph{source} of modules in the language @racket[_something]. For
@ -342,7 +362,9 @@ concisely:
For such cases, however, the alternative reader constructor For such cases, however, the alternative reader constructor
@racket[make-meta-reader] implements a might tightly controlled @racket[make-meta-reader] implements a might tightly controlled
reading of the module language.} reading of the module language.
@history[#:changed "6.2.900.6" @elem{Added the @racket[#:module-reader] option.}]}
@defproc[(make-meta-reader [self-sym symbol?] @defproc[(make-meta-reader [self-sym symbol?]

View File

@ -39,6 +39,7 @@
[#:read-syntax ~read-syntax #'read-syntax] [#:read-syntax ~read-syntax #'read-syntax]
[#:wrapper1 ~wrapper1 #'#f] [#:wrapper1 ~wrapper1 #'#f]
[#:wrapper2 ~wrapper2 #'#f] [#:wrapper2 ~wrapper2 #'#f]
[#:module-wrapper ~module-wrapper #'#f]
[#:whole-body-readers? ~whole-body-readers? #'#f] [#:whole-body-readers? ~whole-body-readers? #'#f]
[#:info ~info #'#f] [#:info ~info #'#f]
[#:language-info ~module-get-info #'#f] [#:language-info ~module-get-info #'#f]
@ -72,24 +73,32 @@
#,~read)] #,~read)]
[w1 #,~wrapper1] [w1 #,~wrapper1]
[w2 #,~wrapper2] [w2 #,~wrapper2]
[mw #,~module-wrapper]
[whole? #,~whole-body-readers?] [whole? #,~whole-body-readers?]
[rd (lambda (in) [rd (lambda (in)
(wrap-internal (if (and (not stx?) (syntax? lang)) (wrap-internal (if (and (not stx?) (syntax? lang))
(syntax->datum lang) (syntax->datum lang)
lang) lang)
in read whole? w1 stx? in read whole? w1 stx?
modpath src line col pos))] modpath src line col pos))])
[r (cond [(not w2) (rd in)] ((or (and mw
[(ar? w2 3) (w2 in rd stx?)] (if (procedure-arity-includes? mw 2)
[else (w2 in rd)])]) mw
(if stx? (lambda (thunk stx?) (mw thunk))))
(let ([prop #,(if (syntax-e ~module-get-info) (lambda (thunk stx?) (thunk)))
~module-get-info (lambda ()
#'#f)]) (let ([r (cond [(not w2) (rd in)]
(if prop [(ar? w2 3) (w2 in rd stx?)]
(syntax-property r 'module-language prop) [else (w2 in rd)])])
r)) (if stx?
r))) (let ([prop #,(if (syntax-e ~module-get-info)
~module-get-info
#'#f)])
(if prop
(syntax-property r 'module-language prop)
r))
r)))
stx?)))
(define read-properties (lang->read-properties #,~lang)) (define read-properties (lang->read-properties #,~lang))
(define (get-info in modpath line col pos) (define (get-info in modpath line col pos)
(get-info-getter (read-properties in modpath line col pos))) (get-info-getter (read-properties in modpath line col pos)))