suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

expander: fix 'origin on let-syntax-bound id-macro expansions

Browse Source
This commit is contained in:
Matthew Flatt 2018-03-07 08:20:57 -07:00
parent 3861da41ed
commit ac2addeeb6
3 changed files with 18 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/racket-test-core/tests/racket/stx.rktl
View File

@ -389,6 +389,17 @@
(tree-map syntax-e) (tree-map syntax-e)
(syntax-property se 'origin)) (syntax-property se 'origin))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure `let-syntax` (which involves a rename transformer)
;; attaches the right 'origin
(test #t
syntax-original?
(let ([stx (expand #'(let-syntax ([m (lambda (stx) #''m)])
m))])
(syntax-case stx ()
[(_ () (_ () e)) (car (syntax-property #'e 'origin))])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; #%app, etc. ;; #%app, etc.

4
racket/src/expander/expand/main.rkt
View File

@ -340,7 +340,7 @@
(define (apply-transformer t insp-of-t s id ctx binding) (define (apply-transformer t insp-of-t s id ctx binding)
(performance-region (performance-region
['expand '_ 'macro] ['expand '_ 'macro]
(log-expand ctx 'enter-macro s) (log-expand ctx 'enter-macro s)
(define disarmed-s (syntax-disarm s)) (define disarmed-s (syntax-disarm s))
(define intro-scope (new-scope 'macro)) (define intro-scope (new-scope 'macro))
@ -366,7 +366,7 @@
;; any expansion result ;; any expansion result
(define post-s (maybe-add-post-expansion-scope result-s ctx)) (define post-s (maybe-add-post-expansion-scope result-s ctx))
;; Track expansion: ;; Track expansion:
(define tracked-s (syntax-track-origin post-s cleaned-s id)) (define tracked-s (syntax-track-origin post-s cleaned-s (if (identifier? s) s (car (syntax-e s)))))
(define rearmed-s (taint-dispatch tracked-s (lambda (t-s) (syntax-rearm t-s s)) (expand-context-phase ctx))) (define rearmed-s (taint-dispatch tracked-s (lambda (t-s) (syntax-rearm t-s s)) (expand-context-phase ctx)))
(log-expand ctx 'exit-macro rearmed-s) (log-expand ctx 'exit-macro rearmed-s)
(values rearmed-s (values rearmed-s

6
racket/src/racket/src/startup.inc
View File

@ -39169,7 +39169,11 @@ static const char *startup_source =
" id_64)))" " id_64)))"
"(let-values(((result-s_5)(flip-scope transformed-s_0 intro-scope_0)))" "(let-values(((result-s_5)(flip-scope transformed-s_0 intro-scope_0)))"
"(let-values(((post-s_0)(maybe-add-post-expansion-scope result-s_5 ctx_25)))" "(let-values(((post-s_0)(maybe-add-post-expansion-scope result-s_5 ctx_25)))"
"(let-values(((tracked-s_0)(syntax-track-origin$1 post-s_0 cleaned-s_0 id_64)))" "(let-values(((tracked-s_0)"
"(syntax-track-origin$1"
" post-s_0"
" cleaned-s_0"
"(if(identifier? s_56) s_56(car(syntax-e$1 s_56))))))"
"(let-values(((rearmed-s_0)" "(let-values(((rearmed-s_0)"
"(taint-dispatch" "(taint-dispatch"
" tracked-s_0" " tracked-s_0"