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

expander: don't turn local reference into syntax-original?

Browse Source 
When a reference to a local variable is updated with the scopes of its
binding in a fully expanded program, remove the syntax-original
property if the original reference had macro-intrudction scopes.

Closes #2820
This commit is contained in:
Matthew Flatt 2019-09-26 14:52:37 -06:00
parent 01de71981b
commit c651cedc1f
3 changed files with 45 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2442,6 +2442,35 @@
(test #t dynamic-require ''syntax-local-value-free-id-context 'result)
;; ----------------------------------------
;; Make sure replacing scopes of binding on reference does not
;; turn a non-`syntax-original?` identifier into a `syntax-original?`
;; one
(let ([m #'(module m racket/base
(let ()
(define x 10)
(define-syntax y
(syntax-rules ()
[(_) x]))
(+ (y)
x)))])
(define found-it? #f)
(define (check s)
(cond
[(syntax? s)
(when (and (syntax-original? s)
(eq? (syntax-e s) 'x))
(test #f = (syntax-line s) (+ (syntax-line m) 6))
(when (= (syntax-line s) (+ (syntax-line m) 7))
(set! found-it? #t)))
(check (syntax-e s))]
[(pair? s)
(check (car s))
(check (cdr s))]))
(check (expand m))
(test #t values found-it?))
;; ----------------------------------------
(report-errs)

10
racket/src/expander/expand/env.rkt
View File

@ -6,6 +6,8 @@
"../syntax/taint.rkt"
"../common/phase.rkt"
"../syntax/binding.rkt"
"../syntax/original.rkt"
"../syntax/property.rkt"
"../namespace/namespace.rkt"
"../namespace/module.rkt"
"protect.rkt"
@ -57,8 +59,12 @@
(if (and no-stops? (local-variable? t))
(let ([bind-id (local-variable-id t)])
;; Keep source locations and properties of original reference:
(syntax-rearm (datum->syntax (syntax-disarm bind-id) (syntax-e bind-id) id id)
id))
(define pruned-id (datum->syntax (syntax-disarm bind-id) (syntax-e bind-id) id id))
;; Don't transition from non-`syntax-original?` to `syntax-original?`
(define new-id (if (syntax-any-macro-scopes? id)
(syntax-property-remove pruned-id original-property-sym)
pruned-id))
(syntax-rearm new-id id))
id))
;; `missing` is a token to represent the absence of a binding; a

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

@ -167,9 +167,7 @@ static const char *startup_source =
" v_0"
" orig-l_0))))))"
" member_0))))))"
"(define-values"
"(current-parameterization)"
"(lambda()(begin(extend-parameterization(continuation-mark-set-first #f parameterization-key)))))"
"(define-values(current-parameterization)(lambda()(begin(continuation-mark-set-first #f parameterization-key))))"
"(define-values"
"(call-with-parameterization)"
"(lambda(paramz_0 thunk_0)"
@ -15157,7 +15155,13 @@ static const char *startup_source =
"(let-values()"
"(if(if no-stops?_0(local-variable? t_0) #f)"
"(let-values(((bind-id_0)(local-variable-id t_0)))"
"(syntax-rearm$1(datum->syntax$1(syntax-disarm$1 bind-id_0)(syntax-e$1 bind-id_0) id_0 id_0) id_0))"
"(let-values(((pruned-id_0)"
"(datum->syntax$1(syntax-disarm$1 bind-id_0)(syntax-e$1 bind-id_0) id_0 id_0)))"
"(let-values(((new-id_0)"
"(if(syntax-any-macro-scopes? id_0)"
"(1/syntax-property-remove pruned-id_0 original-property-sym)"
" pruned-id_0)))"
"(syntax-rearm$1 new-id_0 id_0))))"
" id_0))))))))"
"(define-values(missing)(gensym 'missing))"
"(define-values"