check-requires.rkt (9637B)
1 #lang racket/base 2 (require racket/contract/base 3 racket/cmdline 4 racket/match 5 syntax/modcollapse 6 "private/get-references.rkt" 7 "private/nom-use-alg.rkt" 8 "private/util.rkt") 9 (provide/contract 10 [check-requires 11 (->* (module-path?) 12 (#:show-keep? any/c 13 #:show-bypass? any/c 14 #:show-drop? any/c 15 #:show-uses? any/c) 16 void?)] 17 [show-requires (-> module-path? list?)] 18 [mpi->key (-> module-path-index? any/c)]) 19 20 #| 21 ========== 22 23 Notes 24 25 Ignore recommendations to DROP or BYPASS modules with side 26 effects. Read the section below (How it works) and also see 27 util/moduledb.rkt for whitelisting side-effectful modules. 28 29 The script is not intelligent about the language, which causes 30 certain spurious recommendations to appear frequently. For example, 31 32 DROP scheme/mzscheme at 1 33 34 means that the module's language is mzscheme, which automatically 35 inserts (require-for-syntax scheme/mzscheme). It's infeasible to 36 remove it except by rewriting the module in scheme/base or 37 racket/base. 38 39 ========== 40 41 How it works 42 43 Determining whether a require is actually useless is impossible: a 44 module may be required for compile-time side effect only, and there's 45 no way to monitor that. 46 47 Here are some approximations that are feasible to calculate: 48 49 NOM-USES = A require R is "used" by a module M if, during the 50 compilation of M, a reference is resolved to a binding exported by R. 51 52 DEF-USES = A require R is "used" by a module M if, during the 53 compilation of M, a reference is resolved to a binding defined in R. 54 55 The limitations: 56 - misses side-effects 57 - misses identifiers recognized via 'free-identifier=?' 58 (But those should be recorded as 'disappeared-use anyway.) 59 60 ========== 61 62 TODO 63 64 Handle for-label. 65 66 Let user provide database of modules that should never be dropped, eg 67 because they have side effects. 68 - wouldn't it be awesome if this db could be a datalog program? 69 - start simpler, though 70 71 Ambitious mode could analyze module and recommend ways to split module 72 into independent submodules. 73 |# 74 75 ;; ======================================== 76 77 #| 78 A recommendation is one of 79 (list 'keep module-path-index phase Refs) 80 (list 'bypass module-path-index phase RefineTable) 81 (list 'drop module-path-index phase) 82 |# 83 84 ;; analyze-requires : module-path -> (listof recommendation) 85 (define (analyze-requires mod-path) 86 (let-values ([(compiled deriv) (get-module-code/trace mod-path)]) 87 (nom-use-alg (deriv->refs deriv) compiled))) 88 89 ;; ======================================== 90 91 #| 92 A displayed-recommendation is one of 93 (list 'keep module-path phase) 94 (list 'bypass module-path phase (listof (list module-path phase))) 95 (list 'drop module-path phase) 96 97 A displayed-recommendation is similar to a recommendation, but 98 converts the module-path-indexes to module paths, omits the use-lists, 99 and simplifies the replacements lists. 100 |# 101 102 ;; show-requires: module-path -> (listof displayed-recommendation) 103 (define (show-requires mod-path) 104 (for/list ([entry (in-list (analyze-requires mod-path))]) 105 (match entry 106 [(list 'keep mpi phase uses) 107 (list 'keep (mpi->key mpi) phase)] 108 [(list 'bypass mpi phase bypass) 109 (list 'bypass (mpi->key mpi) phase 110 (let ([bypass (flatten-bypass bypass)]) 111 (for/list ([(modpath+reqphase inner) (in-hash bypass)]) 112 (list (car modpath+reqphase) 113 (cdr modpath+reqphase) 114 (any-renames? (imps->use-table inner))))))] 115 [(list 'drop mpi phase) 116 (list 'drop (mpi->key mpi) phase)]))) 117 118 ;; ======================================== 119 120 (define (check-requires mod 121 #:show-keep? [show-keep? #t] 122 #:show-bypass? [show-bypass? #t] 123 #:show-drop? [show-drop? #t] 124 #:show-uses? [show-uses? #f]) 125 126 (define (show-bypass mpi bypass) 127 (for ([(modname+reqphase inner) (flatten-bypass bypass)]) 128 (let ([modname (car modname+reqphase)] 129 [reqphase (cdr modname+reqphase)] 130 [use-table (imps->use-table inner)]) 131 (printf " TO ~s at ~s~a\n" modname reqphase 132 (cond [(any-renames? use-table) 133 " WITH RENAMING"] 134 [else ""])) 135 (when show-uses? 136 (show-uses use-table 4))))) 137 138 (let ([recs (analyze-requires mod)]) 139 (for ([rec (in-list recs)]) 140 (match rec 141 [(list 'keep mpi phase uses) 142 (when show-keep? 143 (printf "KEEP ~s at ~s\n" 144 (mpi->key mpi) phase) 145 (when show-uses? 146 (show-uses (imps->use-table uses) 2)))] 147 [(list 'bypass mpi phase bypass) 148 (when show-bypass? 149 (printf "BYPASS ~s at ~s\n" (mpi->key mpi) phase) 150 (show-bypass mpi bypass))] 151 [(list 'drop mpi phase) 152 (when show-drop? 153 (printf "DROP ~s at ~s\n" (mpi->key mpi) phase))])))) 154 155 ;; ---- 156 157 ;; flatten-bypass : RefineTable -> hash[(cons module-path int) => Imps] 158 (define (flatten-bypass table) 159 (let ([flat-table (make-hash)]) ;; hash[(cons module-path int) => Imps] 160 (let loop ([table table] [mpi-ctx null]) 161 (for ([(mod+reqphase inner) (in-hash table)]) 162 (let* ([mod (car mod+reqphase)] 163 [reqphase (cdr mod+reqphase)] 164 [mpis (cons mod mpi-ctx)]) 165 (cond [(hash? inner) 166 (loop inner mpis)] 167 [else 168 ;; key may already exist, eg with import diamonds; so append 169 (let* ([modpath (mpi-list->module-path mpis)] 170 [key (cons modpath reqphase)]) 171 (hash-set! flat-table key 172 (append inner (hash-ref flat-table key null))))])))) 173 flat-table)) 174 175 (define (ref->symbol r) 176 (match r 177 [(ref phase id mode (list dm ds nm ns dp ips np)) 178 (cond [id (syntax-e id)] 179 [else ns])])) 180 181 ;; imps->use-table : Imps -> hash[(list phase prov-sym ref-sym) => (listof mode)] 182 (define (imps->use-table imps) 183 (let ([table (make-hash)]) 184 (for ([i (in-list imps)]) 185 (match i 186 [(imp _m _p prov-sym _prov-phase r) 187 (let* ([phase (ref-phase r)] 188 [ref-sym (ref->symbol r)] 189 [mode (ref-mode r)] 190 [key (list phase prov-sym ref-sym)] 191 [modes (hash-ref table key null)]) 192 (unless (memq mode modes) 193 (hash-set! table key (cons mode modes))))])) 194 table)) 195 196 ;; any-renames? : use-table -> boolean 197 (define (any-renames? use-table) 198 (for/or ([key (in-hash-keys use-table)]) 199 (match key 200 [(list phase prov-sym ref-sym) 201 (not (eq? prov-sym ref-sym))]))) 202 203 ;; show-uses : use-table nat -> void 204 (define (show-uses use-table indent) 205 (let* ([unsorted 206 (for/list ([(key modes) (in-hash use-table)]) 207 (cons key (sort modes < #:key mode->nat)))] 208 [sorted 209 (sort unsorted 210 (lambda (A B) 211 (let ([pA (car A)] 212 [pB (car B)]) 213 (or (< pA pB) 214 (and (= pA pB) 215 (let ([strA (symbol->string (cadr A))] 216 [strB (symbol->string (cadr B))]) 217 (string<? strA strB)))))) 218 #:key car)] 219 [spacer (make-string indent #\space)]) 220 (for ([elem (in-list sorted)]) 221 (match elem 222 [(cons (list phase prov-sym ref-sym) modes) 223 (printf "~a~a at ~a ~a~a\n" 224 spacer prov-sym phase modes 225 (cond [(eq? ref-sym prov-sym) ""] 226 [else (format " RENAMED TO ~a" ref-sym)]))])))) 227 228 ;; ======================================== 229 230 (require racket/cmdline 231 raco/command-name) 232 (provide main) 233 234 #| 235 Example (from racket root directory): 236 237 racket -lm macro-debugger/analysis/check-requires \ 238 collects/syntax/*.rkt 239 240 racket -lm macro-debugger/analysis/check-requires -- -bu \ 241 collects/syntax/*.rkt 242 243 |# 244 245 (define (main . args) 246 247 ;; show-keep? : boolean 248 ;; Show KEEP messages in output. 249 (define show-keep? #f) 250 251 ;; show-bypass? : boolean 252 ;; Show BYPASS messages in output. 253 (define show-bypass? #f) 254 255 ;; show-uses? : boolean 256 (define show-uses? #f) 257 258 ;; ======== 259 260 (define (go mod) 261 (printf "~s:\n" mod) 262 (with-handlers ([exn:fail? 263 (lambda (exn) 264 (printf "ERROR in ~s\n" mod) 265 ((error-display-handler) (exn-message exn) exn))]) 266 (check-requires mod 267 #:show-keep? show-keep? 268 #:show-bypass? show-bypass? 269 #:show-uses? show-uses?)) 270 (newline)) 271 272 ;; Command-line args are interpreted as files if the file exists, 273 ;; module names otherwise. 274 (command-line 275 #:program (short-program+command-name) 276 #:argv args 277 #:once-each 278 [("-k" "--show-keep") 279 "Show KEEP recommendations" 280 (set! show-keep? #t)] 281 [("-b" "--show-bypass") 282 "Show BYPASS recommendations" 283 (set! show-bypass? #t)] 284 [("-u" "--show-uses") 285 "Show uses for each module" 286 (set! show-uses? #t)] 287 #:args args 288 (for ([arg (in-list args)]) 289 (cond [(file-exists? arg) 290 (go `(file ,arg))] 291 [else 292 (let* ([inport (open-input-string arg)] 293 [mod (read inport)]) 294 (unless (eof-object? (peek-char inport)) 295 (error "bad module name:" arg)) 296 (go mod))])))) 297 298 (module* main #f 299 (apply main (vector->list (current-command-line-arguments))))