diff options
author | Andy Wingo <wingo@pobox.com> | 2010-09-10 12:55:09 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-09-10 12:55:09 +0200 |
commit | 348fb7040fef1e11e7f7becb49ee73ac7a62873a (patch) | |
tree | c6644f6bc32b6cefe1a7f33e4d0b60e9f5be3248 | |
parent | d8e4f9e509f2ce24e1cb74ba4e0a43e64e0e3f14 (diff) | |
download | guile-348fb7040fef1e11e7f7becb49ee73ac7a62873a.tar.gz |
(system xref) uses module-submodules
* module/system/xref.scm (ensure-callers-db): Fix up to use
module-submodules.
-rw-r--r-- | module/system/xref.scm | 27 |
1 files changed, 19 insertions, 8 deletions
diff --git a/module/system/xref.scm b/module/system/xref.scm index acf5ed2f5..2b6d52db4 100644 --- a/module/system/xref.scm +++ b/module/system/xref.scm @@ -25,6 +25,10 @@ procedure-callees procedure-callers)) +;;; +;;; The cross-reference database: who calls whom. +;;; + (define (program-callee-rev-vars prog) (define (cons-uniq x y) (if (memq x y) y (cons x y))) @@ -134,7 +138,7 @@ (define (ensure-callers-db mod-name) (let ((mod (and mod-name (resolve-module mod-name))) (visited #f)) - (define (visit-variable var recurse mod-name) + (define (visit-variable var mod-name) (if (variable-bound? var) (let ((x (variable-ref var))) (cond @@ -146,24 +150,31 @@ (for-each (lambda (callee) (add-caller callee x mod-name)) callees) - (add-callees callees mod-name))) - ((and recurse (module? x)) - (visit-module x #t)))))) + (add-callees callees mod-name))))))) - (define (visit-module mod recurse) + (define (visit-module mod) (if visited (hashq-set! visited mod #t)) (if (not (memq on-module-modified (module-observers mod))) (module-observe mod on-module-modified)) (let ((name (module-name mod))) (module-for-each (lambda (sym var) - (visit-variable var recurse name)) + (visit-variable var name)) mod))) + (define (visit-submodules mod) + (hash-for-each + (lambda (name sub) + (if (not (and visited (hashq-ref visited sub))) + (begin + (visit-module sub) + (visit-submodules sub)))) + (module-submodules mod))) + (cond ((and (not mod-name) (not *callers-db*)) (set! *callers-db* (make-hash-table 1000)) (set! visited (make-hash-table 1000)) - (visit-module the-root-module #t)) - (mod-name (visit-module mod #f))))) + (visit-submodules (resolve-module '() #f))) + (mod-name (visit-module mod))))) (define (procedure-callers var) "Returns an association list, keyed by module name, of known callers |