nom-use-alg.rkt (8255B)
1 #lang racket/base 2 (require racket/match 3 "moduledb.rkt" 4 "util.rkt") 5 (provide nom-use-alg) 6 7 ;; nom-use-alg : Refs compiled -> (listof recommendation) 8 (define (nom-use-alg refs0 compiled) 9 (let ([refs (append (provides->refs compiled) refs0)]) 10 (let-values ([(NOM-USES DEF-USES) (calculate-used-approximations refs)]) 11 (report NOM-USES DEF-USES (get-requires compiled))))) 12 13 ;; ======== 14 15 ;; sMPI = S-expr form of mpi (see mpi->key) 16 ;; Using MPIs doesn't work. I conjecture that the final module shift means that 17 ;; all during-expansion MPIs are different from all compiled-expr MPIs. 18 19 ;; A UsedTable = hash[(list int sMPI) => Refs] 20 21 ;; calculate-used-approximations : Refs -> (values UsedTable UsedTable) 22 (define (calculate-used-approximations refs) 23 (let ([NOM-USES (make-hash)] 24 [DEF-USES (make-hash)]) 25 (for ([ref (in-list refs)]) 26 (when (relevant? ref) 27 (match (ref-binding ref) 28 [(list def-mod def-sym nom-mod nom-sym 29 def-phase nom-imp-phase nom-exp-phase) 30 (define use-phase (ref-phase ref)) 31 (when def-mod 32 ;; use-phase = def-phase + required-phase 33 ;; thus required-phase = use-phase - def-phase 34 (let* ([required-phase (- use-phase def-phase)] 35 [key (list required-phase (mpi->key def-mod))]) 36 (hash-set! DEF-USES key 37 (cons ref (hash-ref DEF-USES key null))))) 38 ;; We just care about nom-imp-phase, since importing into *here* 39 (let* ([key (list nom-imp-phase (mpi->key nom-mod))]) 40 (hash-set! NOM-USES key 41 (cons ref (hash-ref NOM-USES key null))))] 42 [_ (void)]))) 43 (values NOM-USES DEF-USES))) 44 45 ;; relevant? : Ref -> boolean 46 ;; Only want identifiers actually originating from module being analyzed, 47 ;; not identifiers from other modules inserted by macro expansion. 48 ;; - Actually, want identifiers with lexical context of module, which includes 49 ;; some identifiers not originating from module (eg, inserted by unit-from-context). 50 ;; - Also, if ref represents a re-export, no identifier but still relevant. 51 ;; So, use syntax-source-module conservatively: only to disqualify refs. 52 (define (relevant? ref) 53 (let* ([phase (ref-phase ref)] 54 [id (ref-id ref)] 55 [binding (ref-binding ref)] 56 [srcmod (and id (syntax-source-module id))]) 57 (cond [(and srcmod (not (here-mpi? srcmod))) #f] 58 [else #t]))) 59 60 ;; ======== 61 62 ;; get-requires : compiled-module-expr -> (listof (list int MPI)) 63 (define (get-requires compiled) 64 (let ([phase+mods-list (module-compiled-imports compiled)]) 65 (for*/list ([phase+mods (in-list phase+mods-list)] 66 #:when (car phase+mods) ;; Skip for-label requires 67 [mod (cdr phase+mods)]) 68 (list (car phase+mods) mod)))) 69 70 ;; provides->refs : compiled-module-expr -> Refs 71 (define (provides->refs compiled) 72 (let-values ([(vprov sprov) (module-compiled-exports compiled)]) 73 (for*/list ([phase+exps (in-list (append vprov sprov))] 74 #:when (car phase+exps) ;; Skip for-label provides 75 [name+srcs (in-list (cdr phase+exps))] 76 [src (in-list (cadr name+srcs))]) 77 (let ([phase (car phase+exps)] 78 [name (car name+srcs)]) 79 80 (define (->ref nom-mod exp-sym phase-shift sym orig-phase) 81 ;; We don't have the DEF information, so put #f 82 (let ([b (list #f #f nom-mod sym #f phase-shift orig-phase)]) 83 (ref phase #f 'provide b))) 84 85 (match src 86 [(? module-path-index?) 87 (->ref src name 0 name phase)] 88 [(list imp-mod imp-phase-shift imp-name imp-orig-phase) 89 (->ref imp-mod name imp-phase-shift imp-name imp-orig-phase)]))))) 90 91 ;; ======== 92 93 ;; A RefineTable is hash[(cons mpi phase) => (or RefineTable Imps)] 94 ;; preserve nesting because inner MPIs need to be resolved wrt outer MPIs 95 96 ;; try-bypass : mpi phase Refs -> RefineTable or #f 97 (define (try-bypass mod reqphase refs) 98 ;; refs are all nominally from mod 99 (let* ([imps (map ref->imp refs)]) 100 (refine-imps/one-require mod reqphase imps))) 101 102 ;; refine-imps/one-require : mpi phase Imps -> RefineTable or #f 103 ;; where all imps come from mod at phase 104 ;; the result table contains new (refined) imps 105 (define (refine-imps/one-require mod reqphase imps) 106 (let ([use-table (make-hash)] ;; RefineTable 107 [bytable (mod->bypass-table mod)]) 108 (and (for/and ([i (in-list imps)]) 109 (match i 110 [(imp _m _rp sym exp-phase r) 111 (let* ([bykey (cons sym exp-phase)] 112 [src (hash-ref bytable bykey #f)]) 113 (match src 114 [(renm srcmod phase-shift srcsym srcphase) 115 (let ([use-key (cons srcmod (+ reqphase phase-shift))] 116 [imp* (imp srcmod (+ reqphase phase-shift) srcsym srcphase r)]) 117 (hash-set! use-table use-key (cons imp* (hash-ref use-table use-key null)))) 118 #t] 119 [else #f]))])) 120 (refine-imps* use-table)))) 121 122 (define (refine-imps* partitions) 123 (for/hash ([(mod+reqphase imps) (in-hash partitions)]) 124 (values mod+reqphase 125 (let ([mod (car mod+reqphase)] 126 [reqphase (cdr mod+reqphase)]) 127 (or (and (allow-bypass? mod) 128 (refine-imps/one-require mod reqphase imps)) 129 imps))))) 130 131 ;; ======== 132 133 ;; A BypassTable is hash[(cons sym phase) => Renm 134 ;; Contains only approved modules (no private, etc). 135 136 ;; A Renm is (renm srcmod reqphase srcsym) 137 (struct renm (srcmod phase-shift srcsym srcphase)) 138 139 ;; mod->bypass-table : mpi -> BypassTable 140 ;; FIXME: cache tables 141 (define (mod->bypass-table mod) 142 (define table (make-hash)) 143 (let/ec escape 144 (define prov 145 ;; FIXME: hack around mis-resolution of mpis in case of submodules 146 ;; by just bailing out; should just result in missed bypass opportunities 147 (with-handlers ([(lambda (e) #t) 148 (lambda (e) (escape (void)))]) 149 (get-module-all-exports mod))) 150 (for* ([phase+exps (in-list prov)] 151 #:when (car phase+exps) ;; Skip for-label provides 152 [name+srcs (in-list (cdr phase+exps))] 153 [src (in-list (cadr name+srcs))]) 154 (let ([phase (car phase+exps)] 155 [name (car name+srcs)]) 156 157 (define (add-source! src-mod phase-offset src-sym) 158 (when (bypass-ok-mpi? src-mod) 159 (let ([key (cons name phase)] 160 ;; src-phase + phase-shift = phase 161 [src-phase (- phase phase-offset)]) 162 (hash-ref! table key (renm src-mod phase-offset src-sym src-phase))))) 163 164 (match src 165 [(? module-path-index?) 166 (add-source! src 0 name)] 167 [(list imp-mod imp-phase-shift imp-name imp-orig-phase) 168 (add-source! imp-mod imp-phase-shift imp-name)])))) 169 table) 170 171 ;; ======== 172 173 ;; report : UseTable UseTable (listof (list int mpi)) -> (listof recommendation) 174 (define (report NOM-USES DEF-USES phase+mod-list) 175 (for/list ([phase+mod (in-list phase+mod-list)]) 176 (let* ([phase (car phase+mod)] 177 [mod (cadr phase+mod)] 178 [key (list phase (mpi->key mod))] 179 [nom-refs (hash-ref NOM-USES key null)] 180 [def-refs (hash-ref DEF-USES key null)]) 181 (cond [(and (pair? nom-refs) (pair? def-refs)) 182 ;; We use refs defined in the module (and we got them from the module) 183 (list 'keep mod phase (map ref->imp nom-refs))] 184 [(pair? nom-refs) 185 ;; We use refs gotten from the module (but defined elsewhere) 186 (let ([bypass 187 (and (allow-bypass? mod) 188 (try-bypass mod phase nom-refs))]) 189 (if bypass 190 (list 'bypass mod phase bypass) 191 (list 'keep mod phase (map ref->imp nom-refs))))] 192 [else 193 ;; We don't have any refs gotten from the module 194 ;; (although we may---possibly---have refs defined in it, but gotten elsewhere) 195 (if (allow-drop? mod) 196 (list 'drop mod phase) 197 (list 'keep mod phase null))]))))