make-syntax-introducer: add optional argument to change kind of scope

Genereating a use-site scope, instead of a macro-introduction scope,
prevents the scope's presense from triggering a #f result from
`syntax-original?`.

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
+@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
+object was introduced by a syntax transformer; see
-@secref["stxobj-model"]). The result is @racket[#f] otherwise. This
+@secref["stxobj-model"]). The result is @racket[#f] otherwise.
-predicate can be used to distinguish @tech{syntax object}s in an expanded
+
+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.}
 

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
+Produces a procedure that encapsulates a fresh @tech{scope} and flips,
-@racket[syntax-local-introduce], but using a fresh @tech{scope},
+adds, or removes it in a given syntax object. By default, the fresh
-and where the action of the scope can be @racket['flip] (the default),
+scope is a macro-introduction scope, but providing a true value for
-@racket['add] to add the scope regardless of whether it is present already,
+@racket[as-use-site?] creates a scope that is like a use-site scope;
-or @racket['remove] to remove the scope when it is currently present.
+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?)

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
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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;