suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

make syntax/moddep more useful

Browse Source 
This tool seems misplaced, but improve it a little to be practical for
larger module hierarchies.
This commit is contained in:
Matthew Flatt 2018-02-19 06:42:57 -07:00
parent 11e81f8776
commit 32b274dee1
2 changed files with 61 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pkgs/racket-doc/syntax/scribblings/moddep.scrbl
View File

@ -9,7 +9,20 @@ Re-exports @racketmodname[syntax/modread],
@racketmodname[syntax/modcode], @racketmodname[syntax/modcollapse],
and @racketmodname[syntax/modresolve], in addition to the following:
@defproc[(show-import-tree [module-path-v module-path?]) void?]{
@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])
void?]{
A debugging aid that prints the import hierarchy starting from a given
module path.}
module path.
If @racket[dag?] is true, then a module is printed only the first time
is encountered in the hierarchy.
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.}]}

67
racket/collects/syntax/moddep.rkt
View File

@ -10,24 +10,49 @@
(all-from-out "modresolve.rkt")
show-import-tree)
(define (show-import-tree module-path)
(let loop ([path (resolve-module-path module-path #f)][indent ""][fs ""])
(printf "~a~a~a\n" indent path fs)
(let ([code (get-module-code path)])
(let ([imports (module-compiled-imports code)])
(define ((mk-loop fs) i)
(let ([p (resolve-module-path-index i path)])
(unless (symbol? p)
(loop p
(format " ~a" indent)
fs))))
(for-each (lambda (i)
(for-each
(mk-loop (case (car i)
[(0) ""]
[(1) " [for-syntax]"]
[(-1) " [for-syntax]"]
[(#f) " [for-label]"]
[else (format " [for-meta ~a]" (car i))]))
(cdr i)))
imports))))))
(define (show-import-tree module-path
#:dag? [dag? #f]
#:path-to [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)))
(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
[(null? accum) null]
[(hash-ref seen accum #f) null]
[else
(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))))
(unless (and seen (hash-ref seen (cons path phase) #f))
(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
#:submodule-path (if (pair? path) (cddr path) '()))])
(let ([imports (module-compiled-imports code)]
[accum (cons (list indent path fs phase) accum)])
(define ((mk-loop phase-shift fs) i)
(let ([p (resolve-module-path-index i plain-path)])
(unless (symbol? p)
(loop (if (path? p)
(simplify-path p)
(list* 'submod (simplify-path (cadr p)) (cddr p)))
(format " ~a" indent)
fs
(and phase phase-shift (+ phase phase-shift))
accum))))
(for-each (lambda (i)
(for-each
(mk-loop (car i)
(case (car i)
[(0) ""]
[(1) " [for-syntax]"]
[(-1) " [for-template]"]
[(#f) " [for-label]"]
[else (format " [for-meta ~a]" (car i))]))
(cdr i)))
imports)))))))