syntax/moddep: DAG repair and #:show argument

This commit is contained in:
Matthew Flatt 2018-08-08 09:53:32 -06:00
parent 088f72c8c5
commit f2a7405dda
2 changed files with 19 additions and 10 deletions

View File

@ -11,18 +11,25 @@ and @racketmodname[syntax/modresolve], in addition to the following:
@defproc[(show-import-tree [module-path-v module-path?]
[#:dag? dag? any/c #f]
[#:path-to path-to-module-path-v (or/c #f module-path?) #f])
[#:path-to path-to-module-path-v (or/c #f module-path?) #f]
[#:show show
(string? any/c string? (or/c #f exact-integer?) . -> . any)
(lambda (indent path require-mode phase)
(printf "~a~a~a ~a\n" indent path require-mode phase))])
void?]{
A debugging aid that prints the import hierarchy starting from a given
module path.
A debugging aid that prints (by default) the import hierarchy starting
from a given module path. Supply an alternate @racket[show] function
to handle each path instead of having it printed; the second argument
is a result of @racket[resolved-module-path-name].
If @racket[dag?] is true, then a module is printed only the first time
is encountered in the hierarchy.
If @racket[dag?] is true, then a module is passed to @racket[show]
only the first time is encountered in the hierarchy at a given phase.
If @racket[path-to-module-path-v] is a module path, then only the
spines of the tree that reach @racket[path-to-module-path-v] are
shown.
@history[#:changed "6.12.0.4" @elem{Added the @racket[#:dag?] and
@racket[#:path-to] arguments.}]}
@racket[#:path-to] arguments.}
#:changed "7.0.0.10" @elem{Added the @racket[#:show] argument.}]}

View File

@ -12,12 +12,12 @@
(define (show-import-tree module-path
#:dag? [dag? #f]
#:path-to [given-path-to #f])
#:path-to [given-path-to #f]
#:show [show (lambda (indent path require-mode phase)
(printf "~a~a~a ~a\n" indent path require-mode phase))])
(define path-to (and given-path-to (simplify-path (resolve-module-path given-path-to #f))))
(define seen (and dag? (make-hash)))
(let loop ([path (resolve-module-path module-path #f)] [indent ""] [fs ""] [phase 0] [accum '()])
(unless path-to
(printf "~a~a~a ~a\n" indent path fs phase))
(when (equal? path-to path)
(let ([accum (let loop ([accum (cons (list indent path fs phase) accum)])
(cond
@ -27,8 +27,10 @@
(hash-set! seen accum #t)
(cons (car accum) (loop (cdr accum)))]))])
(for ([i (in-list (reverse accum))])
(apply printf "~a~a~a ~a\n" i))))
(apply show i))))
(unless (and seen (hash-ref seen (cons path phase) #f))
(unless path-to
(show indent path fs phase))
(when seen (hash-set! seen (cons path phase) #t))
(define plain-path (if (pair? path) (cadr path) path))
(let ([code (get-module-code plain-path