diff --git a/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl b/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl index b4fa4dbea1..646c63e94b 100644 --- a/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl +++ b/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl @@ -578,8 +578,8 @@ a call of the @tech{syntax transformer} by the expander; see @secref["expand-steps"]. Before the expander passes a @tech{syntax object} to a transformer, -the @tech{syntax object} is extended with a fresh @tech{scope} (that -applies to all sub-@tech{syntax objects}) to distinguish @tech{syntax objects} +the @tech{syntax object} is extended with a fresh @deftech{macro-introduction scope} +(that applies to all sub-@tech{syntax objects}) to distinguish @tech{syntax objects} at the macro's use site from @tech{syntax objects} that are introduced by the macro; in the result of the transformer the presence of the @tech{scope} is flipped, so that introduced @tech{syntax objects} retain the @tech{scope}, diff --git a/pkgs/racket-doc/syntax/scribblings/apply-transformer.scrbl b/pkgs/racket-doc/syntax/scribblings/apply-transformer.scrbl new file mode 100644 index 0000000000..7fb2100a6e --- /dev/null +++ b/pkgs/racket-doc/syntax/scribblings/apply-transformer.scrbl @@ -0,0 +1,27 @@ +#lang scribble/doc +@(require "common.rkt" (for-label syntax/apply-transformer)) + +@title[#:tag "syntax/apply-transformer"]{Applying Macro Transformers} + +@defmodule[syntax/apply-transformer] + +@defproc[(local-apply-transformer [transformer (or/c (-> syntax? syntax?) set!-transformer?)] + [stx syntax?] + [context (or/c 'expression 'top-level 'module 'module-begin list?)] + [intdef-ctxs (listof internal-definition-context?) '()]) + syntax?]{ + +Applies @racket[transformer] as a @tech[#:doc refman]{syntax transformer} to @racket[stx] in the +current expansion context. The result is similar to expanding @racket[(m stx)] with +@racket[local-expand], where @racket[m] is bound to @racket[transformer], except that expansion is +guaranteed to stop after applying a single macro transformation (assuming @racket[transformer] does +not explicitly force further recursive expansion). + +Unlike simply applying @racket[transformer] to @racket[stx] directly, using +@racket[local-apply-transformer] introduces the appropriate @tech[#:doc refman]{use-site scope} and +@tech[#:doc refman]{macro-introduction scope} that would be added by the expander. + +The @racket[context] and @racket[intdef-ctxs] arguments are treated the same way as the corresponding +arguments to @racket[local-expand]. + +@history[#:added "6.90.0.29"]} diff --git a/pkgs/racket-doc/syntax/scribblings/transformer-helpers.scrbl b/pkgs/racket-doc/syntax/scribblings/transformer-helpers.scrbl index 4da2d4d75b..325be1b97f 100644 --- a/pkgs/racket-doc/syntax/scribblings/transformer-helpers.scrbl +++ b/pkgs/racket-doc/syntax/scribblings/transformer-helpers.scrbl @@ -11,3 +11,4 @@ @include-section["path-spec.scrbl"] @include-section["template.scrbl"] @include-section["transformer.scrbl"] +@include-section["apply-transformer.scrbl"] diff --git a/racket/collects/syntax/apply-transformer.rkt b/racket/collects/syntax/apply-transformer.rkt new file mode 100644 index 0000000000..44c6e8aa50 --- /dev/null +++ b/racket/collects/syntax/apply-transformer.rkt @@ -0,0 +1,55 @@ +#lang racket/base + +(require (for-template racket/base) + racket/syntax) + +(provide local-apply-transformer) + +(define ((make-quoting-transformer transformer-proc) stx) + (syntax-case stx () + [(_ form) + (let ([result (transformer-proc #'form)]) + (unless (syntax? result) + (raise-arguments-error 'local-apply-transformer + "received value from syntax expander was not syntax" + "received" result)) + #`(quote #,result))])) + +(define (local-apply-transformer transformer stx context [intdef-ctxs '()]) + (unless (or (set!-transformer? transformer) + (and (procedure? transformer) + (procedure-arity-includes? transformer 1))) + (raise-argument-error 'local-apply-transformer + "(or/c (-> syntax? syntax?) set!-transformer?)" + transformer)) + (unless (syntax? stx) + (raise-argument-error 'local-apply-transformer "syntax?" stx)) + (unless (or (eq? context 'expression) + (eq? context 'top-level) + (eq? context 'module) + (eq? context 'module-begin) + (list? context)) + (raise-argument-error 'local-apply-transformer + "(or/c 'expression 'top-level 'module 'module-begin list?)" + context)) + (unless (and (list? intdef-ctxs) + (andmap internal-definition-context? intdef-ctxs)) + (raise-argument-error 'local-apply-transformer + "(listof internal-definition-context?)" + intdef-ctxs)) + (unless (syntax-transforming?) + (raise-arguments-error 'local-apply-transformer "not currently expanding")) + (let* ([intdef-ctx (syntax-local-make-definition-context #f #f)] + [transformer-proc (if (set!-transformer? transformer) + (set!-transformer-procedure transformer) + transformer)] + [transformer-id (internal-definition-context-introduce + intdef-ctx + (generate-temporary 'local-apply-transformer))] + [intdef-ctxs* (cons intdef-ctx intdef-ctxs)]) + (syntax-local-bind-syntaxes + (list transformer-id) + #`(quote #,(make-quoting-transformer transformer-proc)) + intdef-ctx) + (syntax-case (local-expand #`(#,transformer-id #,stx) context '() intdef-ctxs*) (quote) + [(quote form) #'form])))