diff --git a/pkgs/racket-test-core/tests/racket/macro.rktl b/pkgs/racket-test-core/tests/racket/macro.rktl index 08b66120ac..33051e2531 100644 --- a/pkgs/racket-test-core/tests/racket/macro.rktl +++ b/pkgs/racket-test-core/tests/racket/macro.rktl @@ -2442,6 +2442,25 @@ (test #t dynamic-require ''syntax-local-value-free-id-context 'result) +;; ---------------------------------------- +;; Ensure the expansion of a rename transformer is not `syntax-original?` + +(module rename-transformer-introduction-scope racket/base + (require (for-syntax racket/base)) + (provide sym free-id=? original?) + (define x #f) + (define-syntax y (make-rename-transformer #'x)) + (define-syntax (m stx) + (define expanded-y (syntax-local-introduce (local-expand #'y 'expression '()))) + #`(values '#,(syntax-e expanded-y) + '#,(free-identifier=? expanded-y #'x) + '#,(syntax-original? expanded-y))) + (define-values (sym free-id=? original?) (m))) + +(test 'x dynamic-require ''rename-transformer-introduction-scope 'sym) +(test #t dynamic-require ''rename-transformer-introduction-scope 'free-id=?) +(test #f dynamic-require ''rename-transformer-introduction-scope 'original?) + ;; ---------------------------------------- ;; Make sure replacing scopes of binding on reference does not ;; turn a non-`syntax-original?` identifier into a `syntax-original?` diff --git a/racket/src/expander/expand/main.rkt b/racket/src/expander/expand/main.rkt index 68c4705f2a..3d5766dd72 100644 --- a/racket/src/expander/expand/main.rkt +++ b/racket/src/expander/expand/main.rkt @@ -323,12 +323,7 @@ (cond [(expand-context-just-once? ctx) exp-s] [else (expand exp-s re-ctx - #:alternate-id (and (rename-transformer? t) - (syntax-track-origin (transfer-srcloc - (rename-transformer-target-in-context t ctx) - id) - id - id)) + #:alternate-id (and (rename-transformer? t) (apply-rename-transformer t id ctx)) #:skip-log? (or (expand-context-only-immediate? ctx) (rename-transformer? t)) #:fail-non-transformer (and (rename-transformer? t) fail-non-transformer))])])) @@ -485,6 +480,17 @@ ;; ---------------------------------------- +;; "Apply" a rename transformer, replacing it with its target. +(define (apply-rename-transformer t id ctx) + (define target-id (rename-transformer-target-in-context t ctx)) + ;; Adding a macro-introduction scope doesn't affect scoping at all, but it can affect + ;; whether the result is `syntax-original?` + (define intro-scope (new-scope 'macro)) + (define intro-id (add-scope target-id intro-scope)) + (syntax-track-origin (transfer-srcloc intro-id id) id id)) + +;; ---------------------------------------- + ;; Helper to lookup a binding in an expansion context (define (lookup b ctx id #:in [in-s #f] diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index 3ecad7960e..54ebaa7bb2 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -43558,12 +43558,7 @@ static const char *startup_source = "((re-ctx195_0) re-ctx_0)" "((temp196_0)" "(if(1/rename-transformer? t_0)" -"(syntax-track-origin$1" -"(transfer-srcloc" -"(rename-transformer-target-in-context t_0 ctx_0)" -" id_0)" -" id_0" -" id_0)" +"(apply-rename-transformer t_0 id_0 ctx_0)" " #f))" "((temp197_0)" "(let-values(((or-part_0)(expand-context-only-immediate? ctx_0)))" @@ -43826,6 +43821,14 @@ static const char *startup_source = "(expand-context/outer-name the-struct_0)))" " (raise-argument-error 'struct-copy \"expand-context/outer?\" the-struct_0))))))))" "(define-values" +"(apply-rename-transformer)" +"(lambda(t_0 id_0 ctx_0)" +"(begin" +"(let-values(((target-id_0)(rename-transformer-target-in-context t_0 ctx_0)))" +"(let-values(((intro-scope_0)(new-scope 'macro)))" +"(let-values(((intro-id_0)(add-scope target-id_0 intro-scope_0)))" +"(syntax-track-origin$1(transfer-srcloc intro-id_0 id_0) id_0 id_0)))))))" +"(define-values" "(lookup62.1)" "(lambda(in55_0 out-of-context-as-variable?56_0 b59_0 ctx60_0 id61_0)" "(begin"