syntax/moddep: DAG repair and #:show
argument
This commit is contained in:
parent
088f72c8c5
commit
f2a7405dda
|
@ -11,18 +11,25 @@ and @racketmodname[syntax/modresolve], in addition to the following:
|
||||||
|
|
||||||
@defproc[(show-import-tree [module-path-v module-path?]
|
@defproc[(show-import-tree [module-path-v module-path?]
|
||||||
[#:dag? dag? any/c #f]
|
[#: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?]{
|
void?]{
|
||||||
|
|
||||||
A debugging aid that prints the import hierarchy starting from a given
|
A debugging aid that prints (by default) the import hierarchy starting
|
||||||
module path.
|
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
|
If @racket[dag?] is true, then a module is passed to @racket[show]
|
||||||
is encountered in the hierarchy.
|
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
|
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
|
spines of the tree that reach @racket[path-to-module-path-v] are
|
||||||
shown.
|
shown.
|
||||||
|
|
||||||
@history[#:changed "6.12.0.4" @elem{Added the @racket[#:dag?] and
|
@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.}]}
|
||||||
|
|
|
@ -12,12 +12,12 @@
|
||||||
|
|
||||||
(define (show-import-tree module-path
|
(define (show-import-tree module-path
|
||||||
#:dag? [dag? #f]
|
#: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 path-to (and given-path-to (simplify-path (resolve-module-path given-path-to #f))))
|
||||||
(define seen (and dag? (make-hash)))
|
(define seen (and dag? (make-hash)))
|
||||||
(let loop ([path (resolve-module-path module-path #f)] [indent ""] [fs ""] [phase 0] [accum '()])
|
(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)
|
(when (equal? path-to path)
|
||||||
(let ([accum (let loop ([accum (cons (list indent path fs phase) accum)])
|
(let ([accum (let loop ([accum (cons (list indent path fs phase) accum)])
|
||||||
(cond
|
(cond
|
||||||
|
@ -27,8 +27,10 @@
|
||||||
(hash-set! seen accum #t)
|
(hash-set! seen accum #t)
|
||||||
(cons (car accum) (loop (cdr accum)))]))])
|
(cons (car accum) (loop (cdr accum)))]))])
|
||||||
(for ([i (in-list (reverse 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 (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))
|
(when seen (hash-set! seen (cons path phase) #t))
|
||||||
(define plain-path (if (pair? path) (cadr path) path))
|
(define plain-path (if (pair? path) (cadr path) path))
|
||||||
(let ([code (get-module-code plain-path
|
(let ([code (get-module-code plain-path
|
||||||
|
|
Loading…
Reference in New Issue
Block a user