check-requires: report renamings
original commit: c074093339f13a0656862aad45d718827400a59d
This commit is contained in:
Ryan Culpepper
parent
a20bef3827
commit
8cdf572246
|
|
@ -61,8 +61,6 @@ The limitations:
|
|||
|
||||
TODO
|
||||
|
||||
Indicate when renaming is necessary.
|
||||
|
||||
Handle for-label.
|
||||
|
||||
Let user provide database of modules that should never be dropped, eg
|
||||
|
|
@ -78,8 +76,8 @@ into independent submodules.
|
|||
|
||||
#|
|
||||
A recommendation is one of
|
||||
(list 'keep module-path-index phase list)
|
||||
(list 'bypass module-path-index phase list)
|
||||
(list 'keep module-path-index phase Refs)
|
||||
(list 'bypass module-path-index phase RefineTable)
|
||||
(list 'drop module-path-index phase)
|
||||
|#
|
||||
|
||||
|
|
@ -107,12 +105,13 @@ and simplifies the replacements lists.
|
|||
(match entry
|
||||
[(list 'keep mpi phase uses)
|
||||
(list 'keep (mpi->key mpi) phase)]
|
||||
[(list 'bypass mpi phase replacements)
|
||||
[(list 'bypass mpi phase bypass)
|
||||
(list 'bypass (mpi->key mpi) phase
|
||||
(for/list ([r (in-list replacements)])
|
||||
(match r
|
||||
[(list rmpis rphase uses)
|
||||
(list (mpi-list->module-path rmpis) rphase)])))]
|
||||
(let ([bypass (flatten-bypass bypass)])
|
||||
(for/list ([(modpath+reqphase inner) (in-hash bypass)])
|
||||
(list (car modpath+reqphase)
|
||||
(cdr modpath+reqphase)
|
||||
(any-renames? (imps->use-table inner))))))]
|
||||
[(list 'drop mpi phase)
|
||||
(list 'drop (mpi->key mpi) phase)])))
|
||||
|
||||
|
|
@ -124,69 +123,107 @@ and simplifies the replacements lists.
|
|||
#:show-drop? [show-drop? #t]
|
||||
#:show-uses? [show-uses? #f])
|
||||
|
||||
(define (show-bypass mpi replacements)
|
||||
(for ([replacement (in-list replacements)])
|
||||
(match replacement
|
||||
[(list repl-mod-list phase uses)
|
||||
(printf " TO ~s at ~a\n"
|
||||
(mpi-list->module-path (append repl-mod-list (list mpi)))
|
||||
phase)
|
||||
(show-uses uses 4)])))
|
||||
|
||||
(define (show-uses uses indent)
|
||||
(define (show-bypass mpi bypass)
|
||||
(for ([(modname+reqphase inner) (flatten-bypass bypass)])
|
||||
(let ([modname (car modname+reqphase)]
|
||||
[reqphase (cdr modname+reqphase)]
|
||||
[use-table (imps->use-table inner)])
|
||||
(printf " TO ~s at ~s~a\n" modname reqphase
|
||||
(cond [(any-renames? use-table)
|
||||
" WITH RENAMING"]
|
||||
[else ""]))
|
||||
(when show-uses?
|
||||
(for ([use (in-list uses)])
|
||||
(match use
|
||||
[(list sym phase modes)
|
||||
(printf "~a~a ~a ~a\n" (make-string indent #\space) sym phase modes)]))))
|
||||
(show-uses use-table 4)))))
|
||||
|
||||
(let ([recs (analyze-requires mod)])
|
||||
(for ([rec (in-list recs)])
|
||||
(match rec
|
||||
[(list 'keep mpi phase uses)
|
||||
(when show-keep?
|
||||
(printf "KEEP ~s at ~a\n"
|
||||
(printf "KEEP ~s at ~s\n"
|
||||
(mpi->key mpi) phase)
|
||||
(show-uses uses 2))]
|
||||
[(list 'bypass mpi phase replacements)
|
||||
(when show-uses?
|
||||
(show-uses (imps->use-table uses) 2)))]
|
||||
[(list 'bypass mpi phase bypass)
|
||||
(when show-bypass?
|
||||
(printf "BYPASS ~s at ~a\n" (mpi->key mpi) phase)
|
||||
(show-bypass mpi replacements))]
|
||||
(printf "BYPASS ~s at ~s\n" (mpi->key mpi) phase)
|
||||
(show-bypass mpi bypass))]
|
||||
[(list 'drop mpi phase)
|
||||
(when show-drop?
|
||||
(printf "DROP ~s at ~a\n" (mpi->key mpi) phase))]))))
|
||||
(printf "DROP ~s at ~s\n" (mpi->key mpi) phase))]))))
|
||||
|
||||
(define (mpi-list->module-path mpi-list)
|
||||
(let* ([mpi*
|
||||
(let loop ([mpi #f] [mpi-list mpi-list])
|
||||
(cond [mpi
|
||||
(let-values ([(mod base) (module-path-index-split mpi)])
|
||||
(cond [mod (module-path-index-join mod (loop base mpi-list))]
|
||||
[else (loop #f mpi-list)]))]
|
||||
[(pair? mpi-list)
|
||||
(loop (car mpi-list) (cdr mpi-list))]
|
||||
[else #f]))]
|
||||
[collapsed
|
||||
(let loop ([mpi mpi*])
|
||||
(cond [mpi
|
||||
(let-values ([(mod base) (module-path-index-split mpi)])
|
||||
(cond [mod
|
||||
(collapse-module-path mod (lambda () (loop base)))]
|
||||
[else (build-path 'same)]))]
|
||||
[else (build-path 'same)]))])
|
||||
(match collapsed
|
||||
[(list 'lib str)
|
||||
(cond [(regexp-match? #rx"\\.rkt$" str)
|
||||
(let* ([no-suffix (path->string (path-replace-suffix str ""))]
|
||||
[no-main
|
||||
(cond [(regexp-match #rx"^([^/]+)/main$" no-suffix)
|
||||
=> cadr]
|
||||
[else no-suffix])])
|
||||
(string->symbol no-main))]
|
||||
[else collapsed])]
|
||||
[(? path?)
|
||||
(path->string (simplify-path collapsed #f))] ;; to get rid of "./" at beginning
|
||||
[_ collapsed])))
|
||||
;; ----
|
||||
|
||||
;; flatten-bypass : RefineTable -> hash[(cons module-path int) => Imps]
|
||||
(define (flatten-bypass table)
|
||||
(let ([flat-table (make-hash)]) ;; hash[(cons module-path int) => Imps]
|
||||
(let loop ([table table] [mpi-ctx null])
|
||||
(for ([(mod+reqphase inner) (in-hash table)])
|
||||
(let* ([mod (car mod+reqphase)]
|
||||
[reqphase (cdr mod+reqphase)]
|
||||
[mpis (cons mod mpi-ctx)])
|
||||
(cond [(hash? inner)
|
||||
(loop inner mpis)]
|
||||
[else
|
||||
;; key may already exist, eg with import diamonds; so append
|
||||
(let* ([modpath (mpi-list->module-path mpis)]
|
||||
[key (cons modpath reqphase)])
|
||||
(hash-set! flat-table key
|
||||
(append inner (hash-ref flat-table key null))))]))))
|
||||
flat-table))
|
||||
|
||||
(define (ref->symbol r)
|
||||
(match r
|
||||
[(ref phase id mode (list dm ds nm ns dp ips np))
|
||||
(cond [id (syntax-e id)]
|
||||
[else ns])]))
|
||||
|
||||
;; imps->use-table : Imps -> hash[(list phase prov-sym ref-sym) => (listof mode)]
|
||||
(define (imps->use-table imps)
|
||||
(let ([table (make-hash)])
|
||||
(for ([i (in-list imps)])
|
||||
(match i
|
||||
[(imp _m _p prov-sym _prov-phase r)
|
||||
(let* ([phase (ref-phase r)]
|
||||
[ref-sym (ref->symbol r)]
|
||||
[mode (ref-mode r)]
|
||||
[key (list phase prov-sym ref-sym)]
|
||||
[modes (hash-ref table key null)])
|
||||
(unless (memq mode modes)
|
||||
(hash-set! table key (cons mode modes))))]))
|
||||
table))
|
||||
|
||||
;; any-renames? : use-table -> boolean
|
||||
(define (any-renames? use-table)
|
||||
(for/or ([key (in-hash-keys use-table)])
|
||||
(match key
|
||||
[(list phase prov-sym ref-sym)
|
||||
(not (eq? prov-sym ref-sym))])))
|
||||
|
||||
;; show-uses : use-table nat -> void
|
||||
(define (show-uses use-table indent)
|
||||
(let* ([unsorted
|
||||
(for/list ([(key modes) (in-hash use-table)])
|
||||
(cons key (sort modes < #:key mode->nat)))]
|
||||
[sorted
|
||||
(sort unsorted
|
||||
(lambda (A B)
|
||||
(let ([pA (car A)]
|
||||
[pB (car B)])
|
||||
(or (< pA pB)
|
||||
(and (= pA pB)
|
||||
(let ([strA (symbol->string (cadr A))]
|
||||
[strB (symbol->string (cadr B))])
|
||||
(string<? strA strB))))))
|
||||
#:key car)]
|
||||
[spacer (make-string indent #\space)])
|
||||
(for ([elem (in-list sorted)])
|
||||
(match elem
|
||||
[(cons (list phase prov-sym ref-sym) modes)
|
||||
(printf "~a~a at ~a ~a~a\n"
|
||||
spacer prov-sym phase modes
|
||||
(cond [(eq? ref-sym prov-sym) ""]
|
||||
[else (format " RENAMED TO ~a" ref-sym)]))]))))
|
||||
|
||||
;; ========================================
|
||||
|
||||
|
|
|
|||
|
|
@ -99,13 +99,6 @@
|
|||
(let* ([imps (map ref->imp refs)])
|
||||
(refine-imps/one-require mod reqphase imps)))
|
||||
|
||||
;; ref->imp : ref -> imp
|
||||
;; Assumes id gotten from nom-mod, etc.
|
||||
(define (ref->imp r)
|
||||
(match (ref-binding r)
|
||||
[(list _dm _ds nom-mod nom-sym _dp imp-shift nom-orig-phase)
|
||||
(imp nom-mod imp-shift nom-sym nom-orig-phase r)]))
|
||||
|
||||
;; refine-imps/one-require : mod phase Imps -> RefineTable or #f
|
||||
;; where all imps come from mod at phase
|
||||
;; the result table contains new (refined) imps
|
||||
|
|
@ -181,59 +174,18 @@
|
|||
[def-refs (hash-ref DEF-USES key null)])
|
||||
(cond [(and (pair? nom-refs) (pair? def-refs))
|
||||
;; We use refs defined in the module (and we got them from the module)
|
||||
(list 'keep mod phase (process-refs nom-refs))]
|
||||
(list 'keep mod phase (map ref->imp nom-refs))]
|
||||
[(pair? nom-refs)
|
||||
;; We use refs gotten from the module (but defined elsewhere)
|
||||
(let ([bypass
|
||||
(and (allow-bypass? mod)
|
||||
(try-bypass mod phase nom-refs))])
|
||||
(if bypass
|
||||
(list 'bypass mod phase (process-bypass bypass))
|
||||
(list 'keep mod phase (process-refs nom-refs))))]
|
||||
(list 'bypass mod phase bypass)
|
||||
(list 'keep mod phase (map ref->imp nom-refs))))]
|
||||
[else
|
||||
;; We don't have any refs gotten from the module
|
||||
;; (although we may---possibly---have refs defined in it, but gotten elsewhere)
|
||||
(if (allow-drop? mod)
|
||||
(list 'drop mod phase)
|
||||
(list 'keep mod phase null))]))))
|
||||
|
||||
;; process-refs : Refs phase -> (listof (list symbol int (listof mode)))
|
||||
(define (process-refs refs)
|
||||
;; table : hash[(cons phase symbol) => (listof mode)]
|
||||
(define table (make-hash))
|
||||
(for ([r (in-list refs)])
|
||||
(match r
|
||||
[(ref phase _id mode
|
||||
(list def-mod def-sym nom-mod nom-sym def-phase imp-phase-shift nom-phase))
|
||||
(let* ([key (cons nom-sym phase)] ;; was nom-phase
|
||||
[modes (hash-ref table key null)])
|
||||
(unless (memq mode modes)
|
||||
(hash-set! table key (cons mode modes))))]))
|
||||
(let* ([unsorted
|
||||
(for/list ([(key modes) (in-hash table)])
|
||||
(cons key (sort modes < #:key mode->nat)))]
|
||||
[sorted
|
||||
(sort unsorted
|
||||
(lambda (A B)
|
||||
(let ([strA (symbol->string (car A))]
|
||||
[strB (symbol->string (car B))])
|
||||
(or (string<? strA strB)
|
||||
(and (string=? strA strB)
|
||||
(< (cdr A) (cdr B))))))
|
||||
#:key car)])
|
||||
(for/list ([elem (in-list sorted)])
|
||||
(list (caar elem) (cdar elem) (cdr elem)))))
|
||||
|
||||
;; process-bypass : RefineTable
|
||||
;; -> (listof (list (listof mpi) int (listof (list symbol int (listof mode)))))
|
||||
(define (process-bypass bypass [mpi-ctx null])
|
||||
(apply append
|
||||
(for/list ([(mod+reqphase inner) (in-hash bypass)])
|
||||
(let ([mod (car mod+reqphase)]
|
||||
[reqphase (cdr mod+reqphase)])
|
||||
(cond [(hash? inner)
|
||||
(process-bypass inner (cons mod mpi-ctx))]
|
||||
[else
|
||||
(list (list (cons mod mpi-ctx)
|
||||
reqphase
|
||||
(process-refs (map imp-ref inner))))])))))
|
||||
|
|
|
|||
|
|
@ -1,14 +1,17 @@
|
|||
#lang racket/base
|
||||
(require racket/path
|
||||
racket/match
|
||||
syntax/modcode
|
||||
syntax/modresolve
|
||||
syntax/modcollapse
|
||||
macro-debugger/model/trace)
|
||||
|
||||
;; --------
|
||||
|
||||
(provide (struct-out ref)
|
||||
mode->nat
|
||||
(struct-out imp))
|
||||
(struct-out imp)
|
||||
ref->imp)
|
||||
|
||||
;; A Ref is (ref phase id/#f identifier-binding Mode)
|
||||
;; the def-mod, def-sym, etc parts of identifier-binding may be #f (eg, provide)
|
||||
|
|
@ -29,12 +32,20 @@
|
|||
;; interpretation: reference ref could be satisfied by
|
||||
;; (require (only (for-meta reqphase (just-meta exp-phase mod)) sym))
|
||||
|
||||
;; ref->imp : Ref -> Imp
|
||||
;; Assumes id gotten from nom-mod, etc.
|
||||
(define (ref->imp r)
|
||||
(match (ref-binding r)
|
||||
[(list _dm _ds nom-mod nom-sym _dp imp-shift nom-orig-phase)
|
||||
(imp nom-mod imp-shift nom-sym nom-orig-phase r)]))
|
||||
|
||||
;; --------
|
||||
|
||||
(provide get-module-code/trace
|
||||
here-mpi?
|
||||
mpi->key
|
||||
mpi->list)
|
||||
mpi->list
|
||||
mpi-list->module-path)
|
||||
|
||||
;; get-module-derivation : module-path -> (values compiled Deriv)
|
||||
(define (get-module-code/trace path)
|
||||
|
|
@ -67,6 +78,38 @@
|
|||
[else
|
||||
(list x)]))
|
||||
|
||||
(define (mpi-list->module-path mpi-list)
|
||||
(let* ([mpi*
|
||||
(let loop ([mpi #f] [mpi-list mpi-list])
|
||||
(cond [mpi
|
||||
(let-values ([(mod base) (module-path-index-split mpi)])
|
||||
(cond [mod (module-path-index-join mod (loop base mpi-list))]
|
||||
[else (loop #f mpi-list)]))]
|
||||
[(pair? mpi-list)
|
||||
(loop (car mpi-list) (cdr mpi-list))]
|
||||
[else #f]))]
|
||||
[collapsed
|
||||
(let loop ([mpi mpi*])
|
||||
(cond [mpi
|
||||
(let-values ([(mod base) (module-path-index-split mpi)])
|
||||
(cond [mod
|
||||
(collapse-module-path mod (lambda () (loop base)))]
|
||||
[else (build-path 'same)]))]
|
||||
[else (build-path 'same)]))])
|
||||
(match collapsed
|
||||
[(list 'lib str)
|
||||
(cond [(regexp-match? #rx"\\.rkt$" str)
|
||||
(let* ([no-suffix (path->string (path-replace-suffix str ""))]
|
||||
[no-main
|
||||
(cond [(regexp-match #rx"^([^/]+)/main$" no-suffix)
|
||||
=> cadr]
|
||||
[else no-suffix])])
|
||||
(string->symbol no-main))]
|
||||
[else collapsed])]
|
||||
[(? path?)
|
||||
(path->string (simplify-path collapsed #f))] ;; to get rid of "./" at beginning
|
||||
[_ collapsed])))
|
||||
|
||||
;; --------
|
||||
|
||||
(provide get-module-imports
|
||||
|
|
|
|||
|
|
@ -370,7 +370,7 @@ Modules required @racket[for-label] are not analyzed.
|
|||
@racket[module-to-analyze] on @racket[_req-module] are enumerated,
|
||||
one per line, in the following format:
|
||||
|
||||
@defoutput[@tt{@racket[_exp-name] @racket[_use-phase] (@racket[_mode ...])}]{
|
||||
@defoutput[@tt{@racket[_exp-name] at @racket[_use-phase] (@racket[_mode ...]) [RENAMED TO @racket[_ref-name]]}]{
|
||||
|
||||
Indicates an export named @racket[_exp-name] is used at phase
|
||||
@racket[_use-phase] (not necessarily the phase it was provided at,
|
||||
|
|
@ -379,6 +379,12 @@ Modules required @racket[for-label] are not analyzed.
|
|||
The @racket[_modes] indicate what kind(s) of dependencies were
|
||||
observed: used as a @tt{reference}, appeared in a syntax template
|
||||
(@tt{quote-syntax}), etc.
|
||||
|
||||
If the @tt{RENAMED TO} clause is present, it indicates that the
|
||||
binding is renamed on import into the module, and
|
||||
@racket[_ref-name] gives the local name used (@racket[_exp-name]
|
||||
is the name under which @racket[_req-module] provides the
|
||||
binding).
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -393,7 +399,7 @@ Modules required @racket[for-label] are not analyzed.
|
|||
A list of replacement requires is given, one per line, in the
|
||||
following format:
|
||||
|
||||
@defoutput[@tt{TO @racket[_repl-module] at @racket[_repl-phase]}]{
|
||||
@defoutput[@tt{TO @racket[_repl-module] at @racket[_repl-phase] [WITH RENAMING]}]{
|
||||
|
||||
Add a require of @racket[_repl-module] at phase
|
||||
@racket[_repl-phase]. If @racket[show-uses?] is true, then
|
||||
|
|
@ -401,10 +407,11 @@ Modules required @racket[for-label] are not analyzed.
|
|||
that would be satisfied by @racket[_repl-module] in the same
|
||||
format as described under @tt{KEEP} below.
|
||||
|
||||
Note: @racket[_repl-module] may provide an export under a
|
||||
different name than @racket[_req-module]; you must use
|
||||
@racket[rename-in] or adjust the references for the replacement to
|
||||
work.
|
||||
If the @tt{WITH RENAMING} clause is present, it indicates that at
|
||||
least one of the replacement modules provides a binding under a
|
||||
different name from the one used locally in the module. Either the
|
||||
references should be changed or @racket[rename-in] should be used
|
||||
with the replacement modules as necessary.
|
||||
}
|
||||
|
||||
Bypass recommendations are restricted by the following rules:
|
||||
|
|
@ -457,7 +464,7 @@ typical reasons for such bad suggestions:
|
|||
|
||||
@defproc[(show-requires [module-name module-path?])
|
||||
(listof (list/c 'keep module-path? number?)
|
||||
(list/c 'bypass module-path? number?)
|
||||
(list/c 'bypass module-path? number? list?)
|
||||
(list/c 'drop module-path? number?))]{
|
||||
|
||||
Like @racket[check-requires], but returns the analysis as a list
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user