diff --git a/pkgs/racket-doc/scribblings/reference/stx-ops.scrbl b/pkgs/racket-doc/scribblings/reference/stx-ops.scrbl index 9da779d421..ab58cddf78 100644 --- a/pkgs/racket-doc/scribblings/reference/stx-ops.scrbl +++ b/pkgs/racket-doc/scribblings/reference/stx-ops.scrbl @@ -89,10 +89,11 @@ marshaling compiled @tech{syntax object}s.} Returns @racket[#t] if @racket[stx] has the property that @racket[read-syntax] attaches to the @tech{syntax object}s that they generate (see @secref["stxprops"]), and if -@racket[stx]'s @tech{lexical information} does not indicate that the -object was introduced by a syntax transformer (see -@secref["stxobj-model"]). The result is @racket[#f] otherwise. This -predicate can be used to distinguish @tech{syntax object}s in an expanded +@racket[stx]'s @tech{lexical information} does not include any macro-introduction scopes (which indicate that the +object was introduced by a syntax transformer; see +@secref["stxobj-model"]). The result is @racket[#f] otherwise. + +This predicate can be used to distinguish @tech{syntax object}s in an expanded expression that were directly present in the original expression, as opposed to @tech{syntax object}s inserted by macros.} diff --git a/pkgs/racket-doc/scribblings/reference/stx-trans.scrbl b/pkgs/racket-doc/scribblings/reference/stx-trans.scrbl index 5db184a0ac..7203dc28da 100644 --- a/pkgs/racket-doc/scribblings/reference/stx-trans.scrbl +++ b/pkgs/racket-doc/scribblings/reference/stx-trans.scrbl @@ -791,22 +791,31 @@ on macro-introduction and use-site @tech{scopes}. @transform-time[]} -@defproc[(make-syntax-introducer) ((syntax?) ((or/c 'flip 'add 'remove)) . ->* . syntax?)]{ +@defproc[(make-syntax-introducer [as-use-site? any/c #f]) + ((syntax?) ((or/c 'flip 'add 'remove)) . ->* . syntax?)]{ -Produces a procedure that behaves similar to -@racket[syntax-local-introduce], but using a fresh @tech{scope}, -and where the action of the scope can be @racket['flip] (the default), -@racket['add] to add the scope regardless of whether it is present already, -or @racket['remove] to remove the scope when it is currently present. +Produces a procedure that encapsulates a fresh @tech{scope} and flips, +adds, or removes it in a given syntax object. By default, the fresh +scope is a macro-introduction scope, but providing a true value for +@racket[as-use-site?] creates a scope that is like a use-site scope; +the difference is in how the scopes are treated by +@racket[syntax-original?]. + +The action of the generated procedure can be @racket['flip] (the +default) to flip the presence of a scope in each part of a given +syntax object, @racket['add] to add the scope to each regardless of +whether it is present already, or @racket['remove] to remove the scope +when it is currently present in any part. Multiple applications of the same @racket[make-syntax-introducer] result procedure use the same scope, and different result procedures use distinct scopes. -@history[#:changed "6.3" @elem{Added the optional operation argument +@history[#:changed "6.3" @elem{Added the optional + @racket[as-use-site?] argument, and + added the optional operation argument in the result procedure.}]} - @defproc[(make-syntax-delta-introducer [ext-stx syntax?] [base-stx (or/c syntax? #f)] [phase-level (or/c #f exact-integer?) diff --git a/pkgs/racket-test-core/tests/racket/stx.rktl b/pkgs/racket-test-core/tests/racket/stx.rktl index 78a137d37c..ec15e601e6 100644 --- a/pkgs/racket-test-core/tests/racket/stx.rktl +++ b/pkgs/racket-test-core/tests/racket/stx.rktl @@ -142,6 +142,12 @@ (syntax-case #'#&(1 2 3) () [#&(x ...) #'(0 x ... 4)])) +;; ---------------------------------------- + +(test #t syntax-original? #'here) +(test #f syntax-original? ((make-syntax-introducer) #'here)) +(test #t syntax-original? ((make-syntax-introducer #t) #'here)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Test basic expansion and property propagation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/racket/src/racket/src/env.c b/racket/src/racket/src/env.c index ca46f6f9fb..41e72ccfaa 100644 --- a/racket/src/racket/src/env.c +++ b/racket/src/racket/src/env.c @@ -2578,8 +2578,14 @@ make_introducer(int argc, Scheme_Object *argv[]) { Scheme_Object *scope, **info; Scheme_Env *genv; + int kind; - scope = scheme_new_scope(SCHEME_STX_MACRO_SCOPE); + if ((argc > 0) && SCHEME_TRUEP(argv[0])) + kind = SCHEME_STX_USE_SITE_SCOPE; + else + kind = SCHEME_STX_MACRO_SCOPE; + + scope = scheme_new_scope(kind); info = MALLOC_N(Scheme_Object*, 2); info[0] = scope;