wrap-expr/c: don't put build-time paths in expansion (closes #2006)

This commit is contained in:
Ryan Culpepper 2018-03-31 18:35:45 +02:00
parent 262ed468d0
commit bcb6299b4b

View File

@ -96,24 +96,28 @@
[(eq? source 'unknown) [(eq? source 'unknown)
#'(quote "unknown")] #'(quote "unknown")]
[(eq? source 'from-macro) [(eq? source 'from-macro)
(if (syntax? ctx) (get-source-expr (extract-source ctx) #f)]
(get-source-expr (extract-source ctx) #f)
(get-source-expr 'unknown #f))]
[(string? source) #`(quote #,source)] [(string? source) #`(quote #,source)]
[(syntax? source) #`(quote #,(source-location->string source))] [(syntax? source) #`(quote #,(source-location->string source))]
[(module-path-index? source) [(module-path-index? source)
;; FIXME: extend collapse-module-path-index to accept #f, return rel mod path ;; FIXME: This assumes that if source is relative, it is relative to
(let* ([here (current-load-relative-directory)] ;; the current self-index (the module currently being compiled). That
[collapsed ;; should usually be the case, but it's not necessarily true.
(collapse-module-path-index source (or here (build-path 'same)))]) (define collapsed (collapse-module-path-index source))
(cond [(and (path? collapsed) here) (cond [(eq? collapsed #f)
#`(quote #,collapsed)] #'(quote-module-path)]
[(path? collapsed) [(relative-module-path? collapsed)
(let-values ([(rel base) (module-path-index-split source)]) #`(relative-source (variable-reference->module-path-index
#`(quote #,rel))] (#%variable-reference))
[else '#,collapsed)]
#`(quote #,(format "~s" collapsed))]))])) [else #`(quote #,collapsed)])]))
(define (relative-module-path? mp)
(or (string? mp) (path? mp)
(and (pair? mp) (eq? (car mp) 'submod)
(let ([base (cadr mp)]) (or (string? base) (path? base))))))
;; extract-source : (U Syntax #f) -> (U ModulePathIndex 'use-site 'unknown)
(define (extract-source stx) (define (extract-source stx)
(let ([id (syntax-case stx () (let ([id (syntax-case stx ()
[(x . _) (identifier? #'x) #'x] [(x . _) (identifier? #'x) #'x]
@ -124,3 +128,17 @@
(cond [(list? b) (car b)] ;; module-path-index (cond [(list? b) (car b)] ;; module-path-index
[else 'use-site])) [else 'use-site]))
'unknown))) 'unknown)))
(module source racket/base
(provide relative-source)
(define (relative-source base-mpi rel-mod-path)
(define r
(resolved-module-path-name
(module-path-index-resolve
(module-path-index-join rel-mod-path base-mpi))))
(cond [(pair? r)
(cons 'submod r)]
[(symbol? r)
(list 'quote r)]
[else r])))
(require (for-template (submod "." source)))