expander: propagate srcloc on rename-transformer expansion
This commit is contained in:
parent
3c69a1296a
commit
de27be536d
|
@ -2524,4 +2524,15 @@
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(test #t
|
||||||
|
'rename-transformer-srcloc
|
||||||
|
;; make sure `cons` in the expansion gets the same source line as `1`
|
||||||
|
(let ([stx (expand #'(letrec-syntax ([kons (make-rename-transformer #'cons)])
|
||||||
|
(kons 1 2)))])
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ () (_app cons one . _))
|
||||||
|
(equal? (syntax-line #'cons) (syntax-line #'one))])))
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -292,7 +292,9 @@
|
||||||
[(expand-context-just-once? ctx) exp-s]
|
[(expand-context-just-once? ctx) exp-s]
|
||||||
[else (expand exp-s re-ctx
|
[else (expand exp-s re-ctx
|
||||||
#:alternate-id (and (rename-transformer? t)
|
#:alternate-id (and (rename-transformer? t)
|
||||||
(syntax-track-origin (rename-transformer-target-in-context t ctx)
|
(syntax-track-origin (transfer-srcloc
|
||||||
|
(rename-transformer-target-in-context t ctx)
|
||||||
|
id)
|
||||||
id
|
id
|
||||||
id))
|
id))
|
||||||
#:skip-log? (or (expand-context-only-immediate? ctx)
|
#:skip-log? (or (expand-context-only-immediate? ctx)
|
||||||
|
@ -742,3 +744,12 @@
|
||||||
(when (rename-transformer? val)
|
(when (rename-transformer? val)
|
||||||
(parameterize ([current-expand-context ctx])
|
(parameterize ([current-expand-context ctx])
|
||||||
(maybe-install-free=id! val id phase))))
|
(maybe-install-free=id! val id phase))))
|
||||||
|
|
||||||
|
;; Transfer the original ID's source location, if any, when expanding
|
||||||
|
;; a reference to a rename transformer
|
||||||
|
(define (transfer-srcloc new-s old-s)
|
||||||
|
(define srcloc (syntax-srcloc old-s))
|
||||||
|
(if srcloc
|
||||||
|
(struct-copy syntax new-s
|
||||||
|
[srcloc srcloc])
|
||||||
|
new-s))
|
||||||
|
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user