check-requires: report renamings

original commit: c074093339f13a0656862aad45d718827400a59d

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 'keep   module-path-index phase Refs)
-  (list 'bypass module-path-index phase list)
+  (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)])
+             (let ([bypass (flatten-bypass bypass)])
-               (match r
+               (for/list ([(modpath+reqphase inner) (in-hash bypass)])
-                 [(list rmpis rphase uses)
+                 (list (car modpath+reqphase)
-                  (list (mpi-list->module-path rmpis) rphase)])))]
+                       (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)
+  (define (show-bypass mpi bypass)
-    (for ([replacement (in-list replacements)])
+    (for ([(modname+reqphase inner) (flatten-bypass bypass)])
-      (match replacement
+      (let ([modname (car modname+reqphase)]
-        [(list repl-mod-list phase uses)
+            [reqphase (cdr modname+reqphase)]
-         (printf "  TO ~s at ~a\n"
+            [use-table (imps->use-table inner)])
-                 (mpi-list->module-path (append repl-mod-list (list mpi)))
+        (printf "  TO ~s at ~s~a\n" modname reqphase
-                 phase)
+                (cond [(any-renames? use-table)
-         (show-uses uses 4)])))
+                       " WITH RENAMING"]
-
+                      [else ""]))
-  (define (show-uses uses indent)
+        (when show-uses?
-    (when show-uses?
+          (show-uses use-table 4)))))
-      (for ([use (in-list uses)])
-        (match use
-          [(list sym phase modes)
-           (printf "~a~a ~a ~a\n" (make-string indent #\space) sym phase modes)]))))
 
   (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))]
+           (when show-uses?
-        [(list 'bypass mpi phase replacements)
+             (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)
+           (printf "BYPASS ~s at ~s\n" (mpi->key mpi) phase)
-           (show-bypass mpi replacements))]
+           (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])
+;; flatten-bypass : RefineTable -> hash[(cons module-path int) => Imps]
-            (cond [mpi
+(define (flatten-bypass table)
-                   (let-values ([(mod base) (module-path-index-split mpi)])
+  (let ([flat-table (make-hash)]) ;; hash[(cons module-path int) => Imps]
-                     (cond [mod (module-path-index-join mod (loop base mpi-list))]
+    (let loop ([table table] [mpi-ctx null])
-                           [else (loop #f mpi-list)]))]
+      (for ([(mod+reqphase inner) (in-hash table)])
-                  [(pair? mpi-list)
+        (let* ([mod (car mod+reqphase)]
-                   (loop (car mpi-list) (cdr mpi-list))]
+               [reqphase (cdr mod+reqphase)]
-                  [else #f]))]
+               [mpis (cons mod mpi-ctx)])
-         [collapsed
+          (cond [(hash? inner)
-          (let loop ([mpi mpi*])
+                 (loop inner mpis)]
-            (cond [mpi 
+                [else
-                   (let-values ([(mod base) (module-path-index-split mpi)])
+                 ;; key may already exist, eg with import diamonds; so append
-                     (cond [mod
+                 (let* ([modpath (mpi-list->module-path mpis)]
-                            (collapse-module-path mod (lambda () (loop base)))]
+                        [key (cons modpath reqphase)])
-                           [else (build-path 'same)]))]
+                   (hash-set! flat-table key
-                  [else (build-path 'same)]))])
+                              (append inner (hash-ref flat-table key null))))]))))
-    (match collapsed
+    flat-table))
-      [(list 'lib str)
+
-       (cond [(regexp-match? #rx"\\.rkt$" str)
+(define (ref->symbol r)
-              (let* ([no-suffix (path->string (path-replace-suffix str ""))]
+  (match r
-                     [no-main
+    [(ref phase id mode (list dm ds nm ns dp ips np))
-                      (cond [(regexp-match #rx"^([^/]+)/main$" no-suffix)
+     (cond [id (syntax-e id)]
-                             => cadr]
+           [else ns])]))
-                            [else no-suffix])])
+
-                (string->symbol no-main))]
+;; imps->use-table : Imps -> hash[(list phase prov-sym ref-sym) => (listof mode)]
-             [else collapsed])]
+(define (imps->use-table imps)
-      [(? path?)
+  (let ([table (make-hash)])
-       (path->string (simplify-path collapsed #f))] ;; to get rid of "./" at beginning
+    (for ([i (in-list imps)])
-      [_ collapsed])))
+      (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)]))]))))
 
 ;; ========================================
 

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 'bypass mod phase bypass)
-                   (list 'keep mod phase (process-refs nom-refs))))]
+                   (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))))])))))

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

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
+    If the @tt{WITH RENAMING} clause is present, it indicates that at
-    different name than @racket[_req-module]; you must use
+    least one of the replacement modules provides a binding under a
-    @racket[rename-in] or adjust the references for the replacement to
+    different name from the one used locally in the module. Either the
-    work.
+    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