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