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

Improve how multi-in assigns source location info for its expansion

Browse Source 
This changes how multi-in is implemented so that the location for each
expanded element in the final require spec is tied to the last relevant
module path element. This allows DrRacket to intelligently show arrows
linking each imported binding with a relevant piece of the multi-in
import spec.
This commit is contained in:
Alexis King 2015-10-24 13:17:59 -07:00 committed by Vincent St-Amour
parent 67e3899272
commit dd97e7b72e
1 changed files with 32 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
racket/collects/racket/require.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base racket/require-transform racket/list (require (for-syntax racket/base racket/require-transform racket/list syntax/stx
(only-in racket/syntax syntax-local-eval)) (only-in racket/syntax syntax-local-eval))
"require-syntax.rkt") "require-syntax.rkt")
@ -100,24 +100,26 @@
(define-for-syntax (multi xs) (define-for-syntax (multi xs)
(define (loop xs) (define (loop xs)
(if (null? xs) (if (stx-null? xs)
'(()) '(())
(let ([first (car xs)] (let ([first (stx-car xs)]
[rest (loop (cdr xs))]) [rest (loop (stx-cdr xs))])
(if (list? first) (if (stx-list? first)
(let ([bads (filter list? first)]) (let ([bads (filter stx-list? (syntax->list first))])
(if (null? bads) (if (null? bads)
(append-map (λ (x) (map (λ (y) (cons x y)) rest)) first) (append-map (λ (x) (map (λ (y) (cons x y)) rest)) (syntax->list first))
(error 'multi-in "not a simple element" (car bads)))) (error 'multi-in "not a simple element" (car (syntax->datum bads)))))
(map (λ (x) (cons first x)) rest))))) (map (λ (x) (cons first x)) rest)))))
(define options (loop xs)) (define options (loop xs))
(define (try pred? ->str str->) (define (try pred? ->str str->)
(and (andmap (λ (x) (andmap pred? x)) options) (and (andmap (λ (x) (andmap pred? (map syntax-e x))) options)
(map (λ (x) (map (λ (x)
(let ([r (apply string-append (let* ([d (map syntax-e x)]
(add-between (if ->str (map ->str x) x) [r (apply string-append
"/"))]) (add-between (if ->str (map ->str d) d)
(if str-> (str-> r) r))) "/"))]
[ctxt (last x)])
(datum->syntax ctxt (if str-> (str-> r) r) ctxt ctxt)))
options))) options)))
(or (try string? #f #f) (or (try string? #f #f)
(try symbol? symbol->string string->symbol) (try symbol? symbol->string string->symbol)
@ -128,25 +130,25 @@
(syntax-case stx () (syntax-case stx ()
[(_ elem0 elem ...) [(_ elem0 elem ...)
(quasisyntax/loc stx (quasisyntax/loc stx
(combine-in #,@(datum->syntax stx (multi (syntax->datum #'(elem0 elem ...))) (combine-in #,@(multi #'(elem0 elem ...))))]))
stx stx stx)))]))
;; Tests for multi. ;; Tests for multi.
;; We don't want to run them every time the file is required, so they are ;; We don't want to run them every time the file is required, so they are
;; commented out. A proper test suite for racket/require should be written. ;; commented out. A proper test suite for racket/require should be written.
;; (require tests/eli-tester) #;(begin-for-syntax
;; (test (multi '("a" "b" "c")) => '("a/b/c") (require tests/eli-tester)
;; (multi '("a" ("b" "c") "d")) => '("a/b/d" "a/c/d") (test (map syntax-e (multi #'("a" "b" "c"))) => '("a/b/c")
;; (multi '("a" "b" ("c" "d"))) => '("a/b/c" "a/b/d") (map syntax-e (multi #'("a" ("b" "c") "d"))) => '("a/b/d" "a/c/d")
;; (multi '(("a" "b") "c" "d")) => '("a/c/d" "b/c/d") (map syntax-e (multi #'("a" "b" ("c" "d")))) => '("a/b/c" "a/b/d")
;; (multi '(("a" "b") ("c" "d"))) => '("a/c" "a/d" "b/c" "b/d") (map syntax-e (multi #'(("a" "b") "c" "d"))) => '("a/c/d" "b/c/d")
;; (multi '(("a" "b" "c" "d"))) => '("a" "b" "c" "d") (map syntax-e (multi #'(("a" "b") ("c" "d")))) => '("a/c" "a/d" "b/c" "b/d")
;; (multi '(("a" "b" ("c" "d")))) =error> "" (map syntax-e (multi #'(("a" "b" "c" "d")))) => '("a" "b" "c" "d")
;; (multi '(a b c)) => '(a/b/c) (map syntax-e (multi #'(("a" "b" ("c" "d"))))) =error> ""
;; (multi '(a (b c) d)) => '(a/b/d a/c/d) (map syntax-e (multi #'(a b c))) => '(a/b/c)
;; (multi '(a b (c d))) => '(a/b/c a/b/d) (map syntax-e (multi #'(a (b c) d))) => '(a/b/d a/c/d)
;; (multi '((a b) c d)) => '(a/c/d b/c/d) (map syntax-e (multi #'(a b (c d)))) => '(a/b/c a/b/d)
;; (multi '((a b) (c d))) => '(a/c a/d b/c b/d) (map syntax-e (multi #'((a b) c d))) => '(a/c/d b/c/d)
;; (multi '((a b c d))) => '(a b c d) (map syntax-e (multi #'((a b) (c d)))) => '(a/c a/d b/c b/d)
;; (multi '((a b (c d)))) =error> "") (map syntax-e (multi #'((a b c d)))) => '(a b c d)
(map syntax-e (multi #'((a b (c d))))) =error> ""))