mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-03 13:20:26 +02:00
Code Activity

(system xref) uses module-submodules

Browse source 
* module/system/xref.scm (ensure-callers-db): Fix up to use
  module-submodules.
This commit is contained in:
Andy Wingo 2010-09-10 12:55:09 +02:00
parent d8e4f9e509
commit 348fb7040f
1 changed files with 19 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

27
module/system/xref.scm
View file

@ -25,6 +25,10 @@
procedure-callees procedure-callees
procedure-callers)) procedure-callers))
;;;
;;; The cross-reference database: who calls whom.
;;;
(define (program-callee-rev-vars prog) (define (program-callee-rev-vars prog)
(define (cons-uniq x y) (define (cons-uniq x y)
(if (memq x y) y (cons x y))) (if (memq x y) y (cons x y)))
@ -134,7 +138,7 @@
(define (ensure-callers-db mod-name) (define (ensure-callers-db mod-name)
(let ((mod (and mod-name (resolve-module mod-name))) (let ((mod (and mod-name (resolve-module mod-name)))
(visited #f)) (visited #f))
(define (visit-variable var recurse mod-name) (define (visit-variable var mod-name)
(if (variable-bound? var) (if (variable-bound? var)
(let ((x (variable-ref var))) (let ((x (variable-ref var)))
(cond (cond
@ -146,24 +150,31 @@
(for-each (lambda (callee) (for-each (lambda (callee)
(add-caller callee x mod-name)) (add-caller callee x mod-name))
callees) callees)
(add-callees callees mod-name))) (add-callees callees mod-name)))))))
((and recurse (module? x))
(visit-module x #t))))))
(define (visit-module mod recurse) (define (visit-module mod)
(if visited (hashq-set! visited mod #t)) (if visited (hashq-set! visited mod #t))
(if (not (memq on-module-modified (module-observers mod))) (if (not (memq on-module-modified (module-observers mod)))
(module-observe mod on-module-modified)) (module-observe mod on-module-modified))
(let ((name (module-name mod))) (let ((name (module-name mod)))
(module-for-each (lambda (sym var) (module-for-each (lambda (sym var)
(visit-variable var recurse name)) (visit-variable var name))
mod))) 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*)) (cond ((and (not mod-name) (not *callers-db*))
(set! *callers-db* (make-hash-table 1000)) (set! *callers-db* (make-hash-table 1000))
(set! visited (make-hash-table 1000)) (set! visited (make-hash-table 1000))
(visit-module the-root-module #t)) (visit-submodules (resolve-module '() #f)))
(mod-name (visit-module mod #f))))) (mod-name (visit-module mod)))))
(define (procedure-callers var) (define (procedure-callers var)
"Returns an association list, keyed by module name, of known callers "Returns an association list, keyed by module name, of known callers