commit 8cdf572246cff447e66e53ddf1e6ed4aba4187c2
parent a20bef3827826311c42fc5605079818819eafcb2
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date: Wed, 28 Sep 2011 21:03:31 -0600
check-requires: report renamings
original commit: c074093339f13a0656862aad45d718827400a59d
Diffstat:
4 files changed, 161 insertions(+), 122 deletions(-)
diff --git a/collects/macro-debugger/analysis/check-requires.rkt b/collects/macro-debugger/analysis/check-requires.rkt
@@ -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)
- (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)]))))
+ (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?
+ (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))]))))
-
-(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])))
+ (printf "DROP ~s at ~s\n" (mpi->key mpi) phase))]))))
+
+;; ----
+
+;; 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)]))]))))
;; ========================================
diff --git a/collects/macro-debugger/analysis/private/nom-use-alg.rkt b/collects/macro-debugger/analysis/private/nom-use-alg.rkt
@@ -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))))])))))
diff --git a/collects/macro-debugger/analysis/private/util.rkt b/collects/macro-debugger/analysis/private/util.rkt
@@ -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
diff --git a/collects/macro-debugger/macro-debugger.scrbl b/collects/macro-debugger/macro-debugger.scrbl
@@ -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
