cm: collect dependencies for submodules

This commit is contained in:
Matthew Flatt 2012-05-11 06:28:22 -06:00
parent 1432912357
commit 8fc3d25be4
2 changed files with 20 additions and 10 deletions

View File

@ -121,12 +121,21 @@
(t (string-append (indent) (apply format fmt args))))))
(define (get-deps code path)
(filter-map (lambda (x)
(let* ([r (resolve-module-path-index x path)]
[r (if (pair? r) (cadr r) r)])
(and (path? r)
(path->bytes r))))
(append-map cdr (module-compiled-imports code))))
(define ht
(let loop ([code code] [ht (hash)])
(define new-ht
(for*/fold ([ht ht]) ([imports (in-list (module-compiled-imports code))]
[x (in-list (cdr imports))])
(let* ([r (resolve-module-path-index x path)]
[r (if (pair? r) (cadr r) r)])
(if (and (path? r)
(not (equal? path r)))
(hash-set ht (path->bytes r) #t)
ht))))
(for*/fold ([ht new-ht]) ([non-star? (in-list '(#f #t))]
[subcode (in-list (module-compiled-submodules code non-star?))])
(loop subcode ht))))
(for/list ([k (in-hash-keys ht)]) k))
(define (get-compilation-dir+name mode path)
(let-values ([(base name must-be-dir?) (split-path path)])

View File

@ -85,12 +85,13 @@
("f.rkt" "(module f scheme/base (provide (all-from-out scheme/base)))" #t)
("g.rkt" "(module g scheme/base (require (for-syntax scheme/base scheme/include \"i.rkt\")) (define-syntax (f stx) (include \"h.sch\")))" #t)
("h.sch" "(quote-syntax 12)" #f)
("i.rkt" "(module i scheme/base)" #t))
("i.rkt" "(module i scheme/base)" #t)
("j.rkt" "(module j racket/base (module+ main (require \"b.rkt\")))" #t))
'([("a.rkt") ("a.rkt") ("a.rkt")]
[("b.rkt") ("a.rkt") ("a.rkt" "b.rkt")]
[("b.rkt") ("b.rkt") ("b.rkt")]
[("b.rkt") ("a.rkt") ("a.rkt" "b.rkt" "j.rkt")]
[("b.rkt") ("b.rkt") ("b.rkt" "j.rkt")]
[() ("a.rkt") ("a.rkt")]
[("c.sch") ("a.rkt") ("a.rkt" "b.rkt")]
[("c.sch") ("a.rkt") ("a.rkt" "b.rkt" "j.rkt")]
[("f.rkt") ("a.rkt") ("a.rkt" "d.rkt" "f.rkt")]
[("e.rkt") ("e.rkt") ("e.rkt")]
[() ("a.rkt") ("a.rkt" "d.rkt")]