add provide pre-transformers
This commit is contained in:
Matthew Flatt
parent
1ae6cc0505
commit
9d27b21f91
|
|
@ -127,14 +127,15 @@
|
|||
(import-source-mode source))))
|
||||
sources)))]))
|
||||
|
||||
(define-for-syntax (make-require+provide-transformer r p)
|
||||
(define-for-syntax (make-require+provide-transformer r p pp)
|
||||
(let-values ([(s: mk s? s-ref s-set!)
|
||||
(make-struct-type 'req+prov
|
||||
#f
|
||||
0 0 #f
|
||||
(list
|
||||
(cons prop:require-transformer (lambda (a) r))
|
||||
(cons prop:provide-transformer (lambda (a) p))))])
|
||||
(cons prop:provide-transformer (lambda (a) p))
|
||||
(cons prop:provide-pre-transformer (lambda (a) pp))))])
|
||||
(mk)))
|
||||
|
||||
(define-for-syntax (exports-at-phase stx modes mode)
|
||||
|
|
@ -155,48 +156,65 @@
|
|||
(lambda (stx)
|
||||
(shift-subs stx 1))
|
||||
(lambda (stx modes)
|
||||
(exports-at-phase stx modes 1))))
|
||||
(exports-at-phase stx modes 1))
|
||||
(lambda (stx modes)
|
||||
(recur-pre stx (if (null? modes) '(1) (map add1 modes))))))
|
||||
|
||||
(define-syntax for-template
|
||||
(make-require+provide-transformer
|
||||
(lambda (stx)
|
||||
(shift-subs stx -1))
|
||||
(lambda (stx modes)
|
||||
(exports-at-phase stx modes -1))))
|
||||
(exports-at-phase stx modes -1))
|
||||
(lambda (stx modes)
|
||||
(recur-pre stx (if (null? modes) '(-1) (map sub1 modes))))))
|
||||
|
||||
(define-syntax for-label
|
||||
(make-require+provide-transformer
|
||||
(lambda (stx)
|
||||
(shift-subs stx #f))
|
||||
(lambda (stx modes)
|
||||
(exports-at-phase stx modes #f))))
|
||||
|
||||
(define-syntax for-meta
|
||||
(make-require+provide-transformer
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ mode in ...)
|
||||
(let ([base-mode (syntax-e #'mode)])
|
||||
(unless (or (not base-mode)
|
||||
(exact-integer? base-mode))
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"phase level must be #f or an exact integer"
|
||||
stx
|
||||
#'mode))
|
||||
(shift-subs #'(for-meta in ...) base-mode))]))
|
||||
(exports-at-phase stx modes #f))
|
||||
(lambda (stx modes)
|
||||
(syntax-case stx ()
|
||||
[(_ mode out ...)
|
||||
(let ([base-mode (syntax-e #'mode)])
|
||||
(unless (or (not base-mode)
|
||||
(exact-integer? base-mode))
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"phase level must be #f or an exact integer"
|
||||
stx
|
||||
#'mode))
|
||||
(exports-at-phase #'(for-meta out ...) modes base-mode))]))))
|
||||
(recur-pre stx '(#f)))))
|
||||
|
||||
(define-syntax for-meta
|
||||
(let ([extract-phase
|
||||
(lambda (stx mode)
|
||||
(let ([base-mode (syntax-e mode)])
|
||||
(unless (or (not base-mode)
|
||||
(exact-integer? base-mode))
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"phase level must be #f or an exact integer"
|
||||
stx
|
||||
mode))
|
||||
base-mode))])
|
||||
(make-require+provide-transformer
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ mode in ...)
|
||||
(let ([base-mode (extract-phase stx #'mode)])
|
||||
(shift-subs #'(for-meta in ...) base-mode))]))
|
||||
(lambda (stx modes)
|
||||
(syntax-case stx ()
|
||||
[(_ mode out ...)
|
||||
(let ([base-mode (extract-phase stx #'mode)])
|
||||
(exports-at-phase #'(for-meta out ...) modes base-mode))]))
|
||||
(lambda (stx modes)
|
||||
(syntax-case stx ()
|
||||
[(_ mode out ...)
|
||||
(let* ([base-mode (extract-phase stx #'mode)]
|
||||
[modes (if (null? modes)
|
||||
(list base-mode)
|
||||
(if (null? base-mode)
|
||||
(list base-mode)
|
||||
(map (lambda (v) (+ v base-mode)) modes)))])
|
||||
(with-syntax ([(out ...) (map (lambda (o)
|
||||
(pre-expand-export o modes))
|
||||
(syntax->list #'(out ...)))])
|
||||
(syntax/loc stx
|
||||
(for-meta mode out ...))))])))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; require
|
||||
|
|
@ -591,12 +609,15 @@
|
|||
|
||||
(syntax-case stx ()
|
||||
[(_ out ...)
|
||||
(syntax-property
|
||||
(quasisyntax/loc stx
|
||||
(#%provide #,(syntax-property
|
||||
#`(expand (provide-trampoline out ...))
|
||||
'certify-mode 'transparent)))
|
||||
'certify-mode 'transparent)]))
|
||||
(with-syntax ([(out ...)
|
||||
(map (lambda (o) (pre-expand-export o null))
|
||||
(syntax->list #'(out ...)))])
|
||||
(syntax-property
|
||||
(quasisyntax/loc stx
|
||||
(#%provide #,(syntax-property
|
||||
#`(expand (provide-trampoline out ...))
|
||||
'certify-mode 'transparent)))
|
||||
'certify-mode 'transparent))]))
|
||||
|
||||
(define-syntax (provide-trampoline stx)
|
||||
(syntax-case stx ()
|
||||
|
|
@ -631,6 +652,15 @@
|
|||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; provide transformers
|
||||
|
||||
(define-for-syntax (recur-pre stx modes)
|
||||
(syntax-case stx ()
|
||||
[(fm out ...)
|
||||
(with-syntax ([(out ...) (map (lambda (o)
|
||||
(pre-expand-export o modes))
|
||||
(syntax->list #'(out ...)))])
|
||||
(syntax/loc stx
|
||||
(fm out ...)))]))
|
||||
|
||||
(define-syntax all-defined-out
|
||||
(make-provide-transformer
|
||||
(lambda (stx modes)
|
||||
|
|
@ -743,24 +773,25 @@
|
|||
(apply
|
||||
append
|
||||
(map (lambda (mode)
|
||||
(map (lambda (orig-id bind-id)
|
||||
(unless (list? (identifier-binding orig-id mode))
|
||||
(raise-syntax-error
|
||||
#f
|
||||
(format "no binding~a for identifier"
|
||||
(cond
|
||||
[(eq? mode 0) ""]
|
||||
[(not mode) " in the label phase level"]
|
||||
[(not mode) (format " at phase level ~a" mode)]
|
||||
[else ""]))
|
||||
stx
|
||||
orig-id))
|
||||
(make-export orig-id
|
||||
(syntax-e bind-id)
|
||||
mode
|
||||
#f
|
||||
bind-id))
|
||||
orig-ids bind-ids))
|
||||
(let ([abs-mode (and mode (+ mode (syntax-local-phase-level)))])
|
||||
(map (lambda (orig-id bind-id)
|
||||
(unless (list? (identifier-binding orig-id abs-mode))
|
||||
(raise-syntax-error
|
||||
#f
|
||||
(format "no binding~a for identifier"
|
||||
(cond
|
||||
[(eq? mode 0) ""]
|
||||
[(not mode) " in the label phase level"]
|
||||
[(not mode) (format " at phase level ~a" mode)]
|
||||
[else ""]))
|
||||
stx
|
||||
orig-id))
|
||||
(make-export orig-id
|
||||
(syntax-e bind-id)
|
||||
mode
|
||||
#f
|
||||
bind-id))
|
||||
orig-ids bind-ids)))
|
||||
(if (null? modes)
|
||||
'(0)
|
||||
modes))))]))))
|
||||
|
|
@ -799,7 +830,9 @@
|
|||
(export-local-id export)
|
||||
(export-mode export))))
|
||||
exceptions)))
|
||||
exports))]))))
|
||||
exports))]))
|
||||
(lambda (stx modes)
|
||||
(recur-pre stx modes))))
|
||||
|
||||
(define-for-syntax (build-name id . parts)
|
||||
(datum->syntax
|
||||
|
|
@ -925,7 +958,9 @@
|
|||
append
|
||||
(map (lambda (out)
|
||||
(expand-export out modes))
|
||||
(syntax->list #'(out ...))))]))))
|
||||
(syntax->list #'(out ...))))]))
|
||||
(lambda (stx modes)
|
||||
(recur-pre stx modes))))
|
||||
|
||||
(define-syntax protect-out
|
||||
(make-provide-transformer
|
||||
|
|
@ -944,30 +979,42 @@
|
|||
(export-mode e)
|
||||
#t
|
||||
(export-orig-stx e)))
|
||||
exports))]))))
|
||||
exports))]))
|
||||
(lambda (stx modes)
|
||||
(recur-pre stx modes))))
|
||||
|
||||
(define-syntax prefix-out
|
||||
(make-provide-transformer
|
||||
(lambda (stx modes)
|
||||
(syntax-case stx ()
|
||||
[(_ pfx out)
|
||||
(let ([exports (expand-export #'out modes)])
|
||||
(unless (identifier? #'pfx)
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"expected an <id> for prefix, found something else"
|
||||
stx
|
||||
#'pfx))
|
||||
(map (lambda (e)
|
||||
(make-export
|
||||
(export-local-id e)
|
||||
(string->symbol (format "~s~s"
|
||||
(syntax-e #'pfx)
|
||||
(export-out-sym e)))
|
||||
(export-mode e)
|
||||
(export-protect? e)
|
||||
(export-orig-stx e)))
|
||||
exports))]))))
|
||||
(let ([check-prefix
|
||||
(lambda (stx pfx)
|
||||
(unless (identifier? pfx)
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"expected an <id> for prefix, found something else"
|
||||
stx
|
||||
pfx)))])
|
||||
(make-provide-transformer
|
||||
(lambda (stx modes)
|
||||
(syntax-case stx ()
|
||||
[(_ pfx out)
|
||||
(check-prefix stx #'pfx)
|
||||
(let ([exports (expand-export #'out modes)])
|
||||
(map (lambda (e)
|
||||
(make-export
|
||||
(export-local-id e)
|
||||
(string->symbol (format "~s~s"
|
||||
(syntax-e #'pfx)
|
||||
(export-out-sym e)))
|
||||
(export-mode e)
|
||||
(export-protect? e)
|
||||
(export-orig-stx e)))
|
||||
exports))]))
|
||||
(lambda (stx modes)
|
||||
(syntax-case stx ()
|
||||
[(_ pfx out)
|
||||
(check-prefix stx #'pfx)
|
||||
(with-syntax ([out (pre-expand-export #'out modes)])
|
||||
(syntax/loc stx (prefix-out pfx out)))])))))
|
||||
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
|
|||
|
|
@ -7,9 +7,10 @@
|
|||
"private/small-scheme.rkt"
|
||||
"private/define.rkt")
|
||||
|
||||
(#%provide expand-export
|
||||
(#%provide expand-export pre-expand-export
|
||||
syntax-local-provide-certifier
|
||||
make-provide-transformer prop:provide-transformer provide-transformer?
|
||||
make-provide-pre-transformer prop:provide-pre-transformer provide-pre-transformer?
|
||||
;; the export struct type:
|
||||
export struct:export make-export export?
|
||||
export-local-id export-out-sym export-orig-stx export-protect? export-mode)
|
||||
|
|
@ -27,14 +28,30 @@
|
|||
(raise-type-error 'make-export "syntax" stx))
|
||||
(values i s mode (and protect? #t) stx)))
|
||||
|
||||
(define-values (prop:provide-pre-transformer provide-pre-transformer? provide-pre-transformer-get-proc)
|
||||
(make-struct-type-property 'provide-pre-transformer))
|
||||
|
||||
(define-values (prop:provide-transformer provide-transformer? provide-transformer-get-proc)
|
||||
(make-struct-type-property 'provide-transformer))
|
||||
|
||||
(define-struct* pt (proc)
|
||||
#:property prop:provide-transformer (lambda (t) (pt-proc t)))
|
||||
(define-struct* p+t (pre-proc proc)
|
||||
#:property prop:provide-transformer (lambda (t) (p+t-proc t))
|
||||
#:property prop:provide-pre-transformer (lambda (t) (p+t-pre-proc t)))
|
||||
|
||||
(define (make-provide-transformer proc)
|
||||
(make-pt proc))
|
||||
(define make-provide-transformer
|
||||
(case-lambda
|
||||
[(proc)
|
||||
(make-pt proc)]
|
||||
[(proc pre-proc)
|
||||
(make-p+t pre-proc proc)]))
|
||||
|
||||
(define-struct* ppt (proc)
|
||||
#:property prop:provide-pre-transformer (lambda (t) (ppt-proc t)))
|
||||
|
||||
(define (make-provide-pre-transformer proc)
|
||||
(make-ppt proc))
|
||||
|
||||
;; For backward compatibility:
|
||||
(define (syntax-local-provide-certifier)
|
||||
|
|
@ -45,6 +62,25 @@
|
|||
(define orig-insp (variable-reference->module-declaration-inspector
|
||||
(#%variable-reference)))
|
||||
|
||||
(define (pre-expand-export stx modes)
|
||||
(if (identifier? stx)
|
||||
stx
|
||||
(let ([disarmed-stx (syntax-disarm stx orig-insp)])
|
||||
(syntax-case disarmed-stx ()
|
||||
[(id . rest)
|
||||
(identifier? #'id)
|
||||
(let ([t (syntax-local-value #'id (lambda () #f))])
|
||||
(if (provide-pre-transformer? t)
|
||||
(let ([v (((provide-pre-transformer-get-proc t) t) disarmed-stx modes)])
|
||||
(unless (syntax? v)
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"result from provide pre-transformer is not a list of exports"
|
||||
stx))
|
||||
v)
|
||||
stx))]
|
||||
[_ stx]))))
|
||||
|
||||
;; expand-export : stx -> (listof export)
|
||||
(define (expand-export stx modes)
|
||||
(if (identifier? stx)
|
||||
|
|
|
|||
|
|
@ -814,9 +814,10 @@ The @racket[liberal-define-context?] predicate returns @racket[#t] if
|
|||
|
||||
A @tech{transformer binding} whose value is a structure with the
|
||||
@racket[prop:require-transformer] property implements a derived
|
||||
@racket[_require-spec] for @racket[require].
|
||||
@racket[_require-spec] for @racket[require] as a @deftech{require
|
||||
transformer}.
|
||||
|
||||
The transformer is called with the syntax object representing its use
|
||||
A @tech{require transformer} is called with the syntax object representing its use
|
||||
as a @racket[_require-spec] within a @racket[require] form, and the
|
||||
result must be two lists: a list of @racket[import]s and a list of
|
||||
@racket[import-source]s.
|
||||
|
|
@ -847,14 +848,13 @@ former list).}
|
|||
(listof import-source?)))])
|
||||
require-transformer?]{
|
||||
|
||||
Creates a @deftech{require transformer} (i.e., a structure with the
|
||||
@racket[prop:require-transformer] property) using the given procedure
|
||||
as the transformer.}
|
||||
Creates a @tech{require transformer} using the given procedure as the
|
||||
transformer.}
|
||||
|
||||
|
||||
@defthing[prop:require-transformer struct-type-property?]{
|
||||
|
||||
A property to identify @racket[require] transformers. The property
|
||||
A property to identify @tech{require transformers}. The property
|
||||
value must be a procedure that takes a syntax object and returns
|
||||
import and import-source lists.}
|
||||
|
||||
|
|
@ -935,20 +935,41 @@ first argument.}
|
|||
|
||||
A @tech{transformer binding} whose value is a structure with the
|
||||
@racket[prop:provide-transformer] property implements a derived
|
||||
@racket[_provide-spec] for @racket[provide].
|
||||
@racket[_provide-spec] for @racket[provide] as a @deftech{provide transformer}.
|
||||
A @tech{provide transformer} is applied as part of the last phase of
|
||||
a module's expansion, after all other declarations and expressions within
|
||||
the module are expanded.
|
||||
|
||||
The transformer is called with the syntax object representing its use
|
||||
as a @racket[_provide-spec] within a @racket[provide] form and a list
|
||||
of symbols representing the export modes specified by enclosing
|
||||
@racket[_provide-spec]s. The result must be a list of
|
||||
@racket[export]s.
|
||||
A @tech{transformer binding} whose value is a structure with the
|
||||
@racket[prop:provide-pre-transformer] property implements a derived
|
||||
@racket[_provide-spec] for @racket[provide] as a @deftech{provide
|
||||
pre-transformer}. A @tech{provide pre-transformer} is applied as part
|
||||
of the first phase of a module's expansion. Since it is used in the
|
||||
first phase, a @tech{provide pre-transformer} can use functions such
|
||||
as @racket[syntax-local-lift-expression] to introduce expressions and
|
||||
definitions in the enclosing module.
|
||||
|
||||
If the derived form contains a sub-form that is a
|
||||
@racket[_provide-spec], then it can call @racket[expand-export] to
|
||||
transform the sub-@racket[_provide-spec] to a list of exports.
|
||||
An identifier can have a @tech{transformer binding} to a value that
|
||||
acts both as a @tech{provide transformer} and @tech{provide
|
||||
pre-transformer}. The result of a @tech{provide
|
||||
pre-transformer} is @emph{not} automatically re-expanded, so a
|
||||
@tech{provide pre-transformer} can usefully expand to itself in that case.
|
||||
|
||||
A transformer is called with the syntax object representing its use as
|
||||
a @racket[_provide-spec] within a @racket[provide] form and a list of
|
||||
symbols representing the export modes specified by enclosing
|
||||
@racket[_provide-spec]s. The result of a @tech{provide transformer}
|
||||
must be a list of @racket[export]s, while the result of a
|
||||
@tech{provide pre-transformer} is a syntax object to be used as a
|
||||
@racket[_provide-spec] in the last phase of module expansion.
|
||||
|
||||
If a derived form contains a sub-form that is a
|
||||
@racket[_provide-spec], then it can call @racket[expand-export] or
|
||||
@racket[pre-expand-export] to transform the sub-@racket[_provide-spec]
|
||||
sub-form.
|
||||
|
||||
See also @racket[define-provide-syntax], which supports macro-style
|
||||
@racket[provide] transformers.
|
||||
@tech{provide transformers}.
|
||||
|
||||
|
||||
@defproc[(expand-export [stx syntax?] [modes (listof (or/c exact-integer? #f))])
|
||||
|
|
@ -957,33 +978,68 @@ See also @racket[define-provide-syntax], which supports macro-style
|
|||
Expands the given @racket[_provide-spec] to a list of exports. The
|
||||
@racket[modes] list controls the expansion of
|
||||
sub-@racket[_provide-specs]; for example, an identifier refers to a
|
||||
@tech{phase level} 0 binding unless the @racket[modes] list specifies
|
||||
otherwise. Normally, @racket[modes] is either empty or contains a
|
||||
single element.}
|
||||
binding in the @tech{phase level} of the enclosing @racket[provide]
|
||||
form, unless the @racket[modes] list specifies otherwise. Normally,
|
||||
@racket[modes] is either empty or contains a single element.}
|
||||
|
||||
|
||||
@defproc[(make-provide-transformer [proc (syntax? (listof (or/c exact-integer? #f))
|
||||
. -> . (listof export?))])
|
||||
provide-transformer?]{
|
||||
@defproc[(pre-expand-export [stx syntax?] [modes (listof (or/c exact-integer? #f))])
|
||||
syntax?]{
|
||||
|
||||
Creates a @deftech{provide transformer} (i.e., a structure with the
|
||||
Expands the given @racket[_provide-spec] at the level of @tech{provide
|
||||
pre-transformers}. The @racket[modes] argument is the same as for
|
||||
@racket[expand-export].}
|
||||
|
||||
|
||||
@defproc*[([(make-provide-transformer [proc (syntax? (listof (or/c exact-integer? #f))
|
||||
. -> . (listof export?))])
|
||||
provide-transformer?]
|
||||
[(make-provide-transformer [proc (syntax? (listof (or/c exact-integer? #f))
|
||||
. -> . (listof export?))]
|
||||
[pre-proc (syntax? (listof (or/c exact-integer? #f))
|
||||
. -> . syntax?)])
|
||||
(and/c provide-transformer? provide-pre-transformer?)])]{
|
||||
|
||||
Creates a @tech{provide transformer} (i.e., a structure with the
|
||||
@racket[prop:provide-transformer] property) using the given procedure
|
||||
as the transformer.}
|
||||
as the transformer. If a @racket[pre-proc] is provided, then the result is also a
|
||||
@tech{provide pre-transformer}.}
|
||||
|
||||
|
||||
@defproc[(make-provide-pre-transformer [pre-proc (syntax? (listof (or/c exact-integer? #f))
|
||||
. -> . syntax?)])
|
||||
provide-pre-transformer?]{
|
||||
|
||||
Like @racket[make-provide-transformer], but for a value that is a
|
||||
@tech{provide pre-transformer}, only.}
|
||||
|
||||
|
||||
@defthing[prop:provide-transformer struct-type-property?]{
|
||||
|
||||
A property to identify @racket[provide] transformers. The property
|
||||
A property to identify @tech{provide transformers}. The property
|
||||
value must be a procedure that takes a syntax object and mode list and
|
||||
returns an export list.}
|
||||
|
||||
|
||||
@defthing[prop:provide-pre-transformer struct-type-property?]{
|
||||
|
||||
A property to identify @tech{provide pre-transformers}. The property
|
||||
value must be a procedure that takes a syntax object and mode list and
|
||||
returns a syntax object.}
|
||||
|
||||
|
||||
@defproc[(provide-transformer? [v any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[v] has the
|
||||
@racket[prop:provide-transformer] property, @racket[#f] otherwise.}
|
||||
|
||||
|
||||
@defproc[(provide-pre-transformer? [v any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[v] has the
|
||||
@racket[prop:provide-pre-transformer] property, @racket[#f] otherwise.}
|
||||
|
||||
|
||||
@defstruct[export ([local-id identifier?]
|
||||
[out-sym symbol?]
|
||||
[mode (or/c exact-integer? #f)]
|
||||
|
|
|
|||
|
|
@ -722,9 +722,10 @@ default, the relevant phase level is the number of
|
|||
@racket[begin-for-syntax] forms that enclose the @racket[provide]
|
||||
form.
|
||||
|
||||
The syntax of @racket[provide-spec] can be extended via
|
||||
@racket[define-provide-syntax], but the pre-defined forms are as
|
||||
follows.
|
||||
The syntax of @racket[provide-spec] can be extended by bindings to
|
||||
@tech{provide transformers} or @tech{provide pre-transformers}, such
|
||||
as via @racket[define-provide-syntax], but the pre-defined forms are
|
||||
as follows.
|
||||
|
||||
@specsubform[id]{ Exports @racket[id], which must be @tech{bound}
|
||||
within the module (i.e., either defined or imported) at the relevant
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user