racket/collects/macro-debugger/analysis/show-dependencies.rkt
2011-10-02 14:17:07 -06:00

131 lines
4.5 KiB
Racket

#lang racket/base
(require racket/cmdline
"private/util.rkt")
(provide get-dependencies
show-dependencies
main)
(define (get-dependencies-table #:include? include? ms)
(define visited (make-hash)) ;; resolved-module-path => (listof mpi-list)
(define (loop m ctx)
(let* ([resolved (module-path-index-resolve m)]
[ctx (cons m ctx)]
[already-visited? (hash-ref visited resolved #f)])
(when (or include? (pair? (cdr ctx)))
;; hack to not record initial list (unless inter-dependencies)
(hash-set! visited resolved
(cons ctx (hash-ref visited resolved null))))
(unless already-visited?
(unless (symbol? (resolved-module-path-name resolved))
(let ([imports (get-module-imports m)])
(for* ([phase+mods (in-list imports)]
[mod (in-list (cdr phase+mods))])
(loop mod ctx)))))))
(for ([m (in-list ms)])
(loop (module-path-index-join m #f) null))
visited)
;; table->dependencies : table -> (listof (list module-path (listof module-path)))
(define (table->dependencies visited)
(let* ([unsorted
(for/list ([(key mpi-lists) (in-hash visited)])
(list (mpi-list->module-path (car mpi-lists))
(sort (map mpi-list->module-path
(filter pair? (map cdr mpi-lists)))
module-path<?)))])
(sort unsorted
module-path<?
#:key car)))
(define (module-path<? A B)
(cond [(and (symbol? A) (symbol? B))
(string<? (symbol->string A) (symbol->string B))]
[(symbol? A) #t]
[(symbol? B) #f]
[(and (string? A) (string? B))
(string<? A B)]
[(string? A) #t]
[(string? B) #f]
[else
;; obviously, we don't care that much about performance in this case
(string<? (format "~s" A) (format "~s" B))]))
;; get-dependencies : module-path ... #:excludse (listof module-path)
;; -> (listof (list module-path (listof module-path)))
(define (get-dependencies #:exclude [exclusions null]
. module-paths)
(let* ([table
(get-dependencies-table #:include? #f module-paths)]
[exclude-table
(get-dependencies-table #:include? #t exclusions)])
(for ([key (in-hash-keys exclude-table)])
(hash-remove! table key))
(table->dependencies table)))
(define (show-dependencies #:exclude [exclusions null]
#:show-context? [context? #f]
. module-paths)
(for ([dep (in-list (apply get-dependencies #:exclude exclusions module-paths))])
(let ([mod (car dep)]
[direct-requirers (cadr dep)])
(printf "~s" mod)
(when context?
(printf " <- ~s" direct-requirers))
(newline))))
;; ====
(define (main . argv)
(define mode 'auto)
(define context? #f)
(define exclusions null)
(command-line
#:argv argv
#:once-each
[("-c" "--context") "Show who directly requires each module"
(set! context? #t)]
[("-f" "--file") "Interpret arguments as file-paths"
(set! mode 'file)]
[("-m" "--module-path") "Interpret arguments as module-paths"
(set! mode 'module-path)]
[("-x" "--exclude") exclude "Exclude modules reachable from <exclude>"
(set! exclusions (cons exclude exclusions))]
[("-b") "Same as --exclude racket/base"
(set! exclusions (cons 'racket/base exclusions))]
#:args module-path
(let ()
(define (->modpath x)
(cond [(string? x)
(case mode
((auto)
(if (file-exists? x)
`(file ,x)
(read (open-input-string x))))
((file) `(file ,x))
((module-path)
(read (open-input-string x))))]
[else x]))
(apply show-dependencies
#:exclude (map ->modpath exclusions)
#:show-context? context?
(map ->modpath module-path)))))
#|
For example,
racket -lm macro-debugger/analysis/show-dependencies -- -bc mzscheme
shows the additional modules used to implement mzscheme beyond those
already needed for the implementation of racket/base. And
racket -lm macro-debugger/analysis/show-dependencies -- -bc syntax/parse/pre
shows that syntax/parse/pre has no dependencies on the contract
library. Actually, it shows that it has no *residual* dependencies;
contracts are used in the code that is lazily loaded, but using
syntax/parse/pre does not cause a module's compiled code to depend on
racket/contract/base.
|#