diff --git a/collects/macro-debugger/analysis/check-requires.rkt b/collects/macro-debugger/analysis/check-requires.rkt index 7c53641..5c42a8f 100644 --- 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))])))) + (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))]) + (stringimp 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 (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 index 10f8c48..84a3842 100644 --- 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 index 0a3c1e3..c0570c4 100644 --- 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