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

Adjust local-require to be more deliberate about syntax-local-introduce

Browse Source 
This ensures macro-introduction scopes don’t unintentionally end up on
lifted pieces of syntax, which causes problems for Check Syntax, since
it affects the syntax-original?-ness of the require spec.
This commit is contained in:
Alexis King 2018-05-11 16:47:50 -05:00
parent a539825dc9
commit bbbdee2853
1 changed files with 21 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
racket/collects/racket/private/reqprov.rkt
View File

@ -1182,7 +1182,7 @@
(import-mode i)
(list #'rename
(import-src-mod-path i)
(syntax-local-introduce (import-local-id i))
(import-local-id i)
(import-src-sym i))))
(import-orig-stx i)))
@ -1192,25 +1192,26 @@
(define-syntax (local-require stx)
(when (eq? 'expression (syntax-local-context))
(raise-syntax-error #f "not allowed in an expression context" stx))
(syntax-case stx []
[(_ spec ...)
(let*-values ([(imports sources)
(expand-import
(datum->syntax
stx
(list* #'only-meta-in 0 (syntax->list #'(spec ...)))
stx))]
[(names) (map import-local-id imports)]
[(reqd-names)
(let ([ctx (syntax-local-get-shadower (datum->syntax #f (gensym)))])
(map (lambda (n) (datum->syntax ctx (syntax-e n) n)) names))]
[(renamed-imports) (map rename-import imports reqd-names)]
[(raw-specs) (map import->raw-require-spec renamed-imports)]
[(lifts) (map syntax-local-lift-require raw-specs reqd-names)])
(with-syntax ([(name ...) names]
[(lifted ...) lifts])
(syntax/loc stx (define-syntaxes (name ...)
(values (make-rename-transformer (quote-syntax lifted)) ...)))))]))
(let ([stx (syntax-local-introduce stx)])
(syntax-case stx []
[(_ spec ...)
(let*-values ([(imports sources)
(expand-import
(datum->syntax
stx
(list* #'only-meta-in 0 (syntax->list #'(spec ...)))
stx))]
[(names) (map import-local-id imports)]
[(reqd-names)
(let ([ctx (syntax-local-get-shadower (datum->syntax #f (gensym)))])
(map (lambda (n) (datum->syntax ctx (syntax-e n) n)) names))]
[(renamed-imports) (map rename-import imports reqd-names)]
[(raw-specs) (map import->raw-require-spec renamed-imports)]
[(lifts) (map syntax-local-lift-require raw-specs reqd-names)])
(with-syntax ([(name ...) (map syntax-local-introduce names)]
[(lifted ...) (map syntax-local-introduce lifts)])
(syntax/loc stx (define-syntaxes (name ...)
(values (make-rename-transformer (quote-syntax lifted)) ...)))))])))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)