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

expander: fix srcloc tracking for set! on rename transformer

Browse Source
This commit is contained in:
Matthew Flatt 2020-09-29 14:08:17 -06:00
parent c7e6cbc001
commit 46a191df03
5 changed files with 1308 additions and 1359 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
pkgs/racket-test-core/tests/racket/macro.rktl
View File

@ -2447,19 +2447,40 @@
(module rename-transformer-introduction-scope racket/base
(require (for-syntax racket/base))
(provide sym free-id=? original?)
(provide sym free-id=? original? sameloc?
set-sym set-free-id=? set-original? set-sameloc?)
(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)))
(define orig-y #'y)
(define expanded-y (syntax-local-introduce (local-expand orig-y 'expression '())))
(define expanded-set-y (syntax-local-introduce (local-expand #`(set! #,orig-y 5) 'expression '())))
(define (same-srcloc? a b) (and (equal? (syntax-source a) (syntax-source b))
(equal? (syntax-line a) (syntax-line b))
(equal? (syntax-column a) (syntax-column b))))
(syntax-case expanded-set-y ()
[(_ set!ed-y _)
#`(values '#,(syntax-e expanded-y)
'#,(free-identifier=? expanded-y #'x)
'#,(syntax-original? expanded-y)
'#,(same-srcloc? expanded-y orig-y)
'#,(syntax-e #'set!ed-y)
'#,(free-identifier=? #'set!ed-y #'x)
'#,(syntax-original? #'set!ed-y)
'#,(same-srcloc? #'set!ed-y orig-y))]))
(define-values (sym free-id=? original? sameloc?
set-sym set-free-id=? set-original? set-sameloc?)
(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?)
(test #t dynamic-require ''rename-transformer-introduction-scope 'sameloc?)
(test 'x dynamic-require ''rename-transformer-introduction-scope 'set-sym)
(test #t dynamic-require ''rename-transformer-introduction-scope 'set-free-id=?)
(test #f dynamic-require ''rename-transformer-introduction-scope 'set-original?)
(test #t dynamic-require ''rename-transformer-introduction-scope 'set-sameloc?)
;; ----------------------------------------
;; Make sure replacing scopes of binding on reference does not

1406
racket/src/bc/src/startup.inc
View File

File diff suppressed because it is too large Load Diff

1214
racket/src/cs/schemified/expander.scm
View File

File diff suppressed because it is too large Load Diff

13
racket/src/expander/expand/expr.rkt
View File

@ -708,19 +708,16 @@
[(rename-transformer? t)
(cond
[(not-in-this-expand-context? t ctx)
(expand (avoid-current-expand-context (substitute-set!-rename s disarmed-s (m 'set!) (m 'rhs) id from-rename? ctx t) t ctx)
(expand (avoid-current-expand-context (substitute-set!-rename s disarmed-s (m 'set!) (m 'rhs) id from-rename? ctx) t ctx)
ctx)]
[else (rename-loop (syntax-track-origin (rename-transformer-target-in-context t ctx) id id) #t)])]
[else (rename-loop (apply-rename-transformer t id ctx) #t)])]
[else
(raise-syntax-error #f "cannot mutate syntax identifier" s id)]))))
(define (substitute-set!-rename s disarmed-s set!-id id rhs-s from-rename? ctx [t #f])
(define (substitute-set!-rename s disarmed-s set!-id id rhs-s from-rename? ctx)
(cond
[(or t from-rename?)
(define new-id (if t
(rename-transformer-target-in-context t ctx)
id))
(syntax-rearm (datum->syntax disarmed-s (list set!-id new-id rhs-s) disarmed-s disarmed-s)
[from-rename?
(syntax-rearm (datum->syntax disarmed-s (list set!-id id rhs-s) disarmed-s disarmed-s)
s)]
[else s]))

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

@ -52,6 +52,7 @@
context->transformer-context
eval-for-syntaxes-binding
eval-for-bindings
apply-rename-transformer
keep-properties-only
keep-properties-only~