show-dependencies.rkt (7192B)
1 #lang racket/base 2 (require racket/cmdline 3 racket/match 4 racket/pretty 5 raco/command-name 6 syntax/modresolve 7 "private/util.rkt") 8 (provide get-dependencies 9 show-dependencies 10 main) 11 12 ;; A Table is hash[resolved-module-path => (listof mpi-list)] 13 14 (define (get-dependencies-table ms #:include? include?) 15 (define visited (make-hash)) ;; Table 16 (define (loop m ctx relto) 17 (let* ([resolved (resolve-module-path-index* m relto)] 18 [ctx (cons m ctx)] 19 [already-visited? (hash-ref visited resolved #f)]) 20 (when (or include? (pair? (cdr ctx))) 21 ;; hack to not record initial list (unless inter-dependencies) 22 (hash-set! visited resolved 23 (cons ctx (hash-ref visited resolved null)))) 24 (unless already-visited? 25 (let* ([resolved-mod (resolved-module-path-name resolved)] 26 [resolved-base (if (pair? resolved-mod) (car resolved-mod) resolved-mod)]) 27 (unless (symbol? resolved-base) 28 (let ([imports (get-module-imports resolved)]) 29 (for* ([phase+mods (in-list imports)] 30 [mod (in-list (cdr phase+mods))]) 31 (loop mod ctx resolved-base)))))))) 32 (for ([m (in-list ms)]) 33 (loop (module-path-index-join m #f) null #f)) 34 visited) 35 36 ;; resolve-module-path-index* : mpi file-path -> resolved-module-path 37 (define (resolve-module-path-index* mpi relto) 38 (let ([v (resolve-module-path-index mpi relto)]) 39 (match v 40 [(? path?) (make-resolved-module-path (simplify-path v))] 41 [(? symbol?) (make-resolved-module-path v)] 42 [(list* 'submod (? path? base) syms) 43 (make-resolved-module-path (cons (simplify-path base) syms))] 44 [(list* 'submod (? symbol? base) syms) 45 (error 'resolve-module-path-index* 46 "failed to resolve submodule path base in: ~e" v)]))) 47 48 ;; table->dependencies : Table -> (listof (list module-path (listof module-path))) 49 (define (table->dependencies visited) 50 (let* ([unsorted 51 (for/list ([(key mpi-lists) (in-hash visited)]) 52 (list (mpi-list->module-path (car mpi-lists)) 53 (sort (map mpi-list->module-path 54 (filter pair? (map cdr mpi-lists))) 55 module-path<?)))]) 56 (sort unsorted 57 module-path<? 58 #:key car))) 59 60 (define (module-path<? A B) 61 (cond [(and (symbol? A) (symbol? B)) 62 (symbol<? A B)] 63 [(symbol? A) #t] 64 [(symbol? B) #f] 65 [(and (string? A) (string? B)) 66 (string<? A B)] 67 [(string? A) #t] 68 [(string? B) #f] 69 [else 70 ;; obviously, we don't care that much about performance in this case 71 (string<? (format "~s" A) (format "~s" B))])) 72 73 ;; get-dependencies : module-path ... #:exclude (listof module-path) 74 ;; -> (listof (list module-path (listof module-path))) 75 (define (get-dependencies #:exclude [exclude null] 76 #:exclude-deps [exclude-deps null] 77 . module-paths) 78 (let* ([table 79 (get-dependencies-table #:include? #f module-paths)] 80 [exclude-table 81 (get-dependencies-table #:include? #t exclude)] 82 [exclude-deps-roots 83 (for/hash ([mod (in-list exclude-deps)]) 84 (values (resolve-module-path-index* (module-path-index-join mod #f) #f) #t))] 85 [exclude-deps-table 86 (get-dependencies-table #:include? #f exclude-deps)]) 87 (for ([key (in-hash-keys exclude-table)]) 88 (hash-remove! table key)) 89 (for ([key (in-hash-keys exclude-deps-table)]) 90 (unless (hash-ref exclude-deps-roots key #f) 91 (hash-remove! table key))) 92 (table->dependencies table))) 93 94 (define (show-dependencies #:exclude [exclude null] 95 #:exclude-deps [exclude-deps null] 96 #:show-context? [context? #f] 97 #:multi-line-context? [multi-line-context? #f] 98 . module-paths) 99 (for ([dep (in-list (apply get-dependencies 100 #:exclude exclude 101 #:exclude-deps exclude-deps 102 module-paths))]) 103 (let ([mod (car dep)] 104 [direct-requirers (cadr dep)]) 105 (parameterize ([pretty-print-columns 'infinity]) (pretty-write mod)) 106 (when context? 107 (printf " <- ") 108 (cond 109 [multi-line-context? 110 (for ([direct-requirer (in-list direct-requirers)] 111 [i (in-naturals)]) 112 (if (zero? i) 113 (printf "\n (") 114 (printf "\n ")) 115 (parameterize ([pretty-print-columns 'infinity]) 116 (pretty-write direct-requirer))) 117 (printf ")")] 118 [else 119 (parameterize ([pretty-print-columns 'infinity]) 120 (pretty-write direct-requirers))])) 121 (newline)))) 122 123 ;; ==== 124 125 (define (main . argv) 126 (define mode 'auto) 127 (define context? #f) 128 (define multi-line-context? #f) 129 (define excludes null) 130 (define exclude-deps null) 131 (command-line 132 #:program (short-program+command-name) 133 #:argv argv 134 #:once-each 135 [("-c" "--context") "Show who directly requires each module" 136 (set! context? #t)] 137 [("-l" "--multi-line-context") "Like --context, but use multiple lines" 138 (set! context? #t) 139 (set! multi-line-context? #t)] 140 [("-f" "--file") "Interpret arguments as file-paths" 141 (set! mode 'file)] 142 [("-m" "--module-path") "Interpret arguments as module-paths" 143 (set! mode 'module-path)] 144 [("-x" "--exclude") mod "Exclude <mod> and its dependencies" 145 (set! excludes (cons mod excludes))] 146 [("-X" "--exclude-deps") mod "Exclude the dependencies of <mod> (but not <mod> itself)" 147 (set! exclude-deps (cons mod exclude-deps))] 148 [("-b") "Same as --exclude racket/base" 149 (set! excludes (cons 'racket/base excludes))] 150 #:args module-path 151 (let () 152 (define (->modpath x) 153 (cond [(string? x) 154 (case mode 155 ((auto) 156 (if (file-exists? x) 157 `(file ,x) 158 (read (open-input-string x)))) 159 ((file) `(file ,x)) 160 ((module-path) 161 (read (open-input-string x))))] 162 [else x])) 163 (apply show-dependencies 164 #:exclude (map ->modpath excludes) 165 #:exclude-deps (map ->modpath exclude-deps) 166 #:show-context? context? 167 #:multi-line-context? multi-line-context? 168 (map ->modpath module-path))))) 169 170 (module* main #f 171 (apply main (vector->list (current-command-line-arguments)))) 172 173 #| 174 175 For example, 176 177 raco show-dependencies -bc mzscheme 178 179 shows the additional modules used to implement mzscheme beyond those 180 already needed for the implementation of racket/base. And 181 182 raco show-dependencies -bl syntax/parse/pre 183 184 shows that syntax/parse/pre has no dependencies on the contract 185 library. Actually, it shows that it has no *residual* dependencies; 186 contracts are used in the code that is lazily loaded, but using 187 syntax/parse/pre does not cause a module's compiled code to depend on 188 racket/contract/base. 189 190 |#