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

fix duplicates in procedure-callers

Browse source 
* module/system/xref.scm (ensure-callers-db): OK! Since we can see the
  same variable twice, e.g. in different modules, keep a unified hash of
  seen vars and modules. Prevents duplicates in procedure-callers.
This commit is contained in:
Andy Wingo 2009-03-28 22:21:00 -07:00
parent 154a611669
commit 6ecae97fb8
1 changed files with 7 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

11
module/system/xref.scm
View file

@ -95,24 +95,26 @@
(set! *callers-db* #f))) (set! *callers-db* #f)))
(define (ensure-callers-db) (define (ensure-callers-db)
(let ((visited '()) (let ((visited #f)
(db #f)) (db #f))
(define (visit-variable var) (define (visit-variable var)
(if (variable-bound? var) (if (variable-bound? var)
(let ((x (variable-ref var))) (let ((x (variable-ref var)))
(cond (cond
((hashq-ref visited x))
((procedure? x) ((procedure? x)
(hashq-set! visited x #t)
(for-each (for-each
(lambda (callee) (lambda (callee)
(if (variable-bound? callee) (if (variable-bound? callee)
(hashq-set! db callee (hashq-set! db callee
(cons x (hashq-ref db callee '()))))) (cons x (hashq-ref db callee '())))))
(procedure-callee-rev-vars x))) (procedure-callee-rev-vars x)))
((and (module? x) (not (memq x visited))) ((module? x)
(visit-module x)))))) (visit-module x))))))
(define (visit-module mod) (define (visit-module mod)
(set! visited (cons mod 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))
(module-for-each (lambda (sym var) (module-for-each (lambda (sym var)
@ -121,7 +123,8 @@
(if (not *callers-db*) (if (not *callers-db*)
(begin (begin
(set! db (make-hash-table)) (set! db (make-hash-table 1000))
(set! visited (make-hash-table 1000))
(visit-module the-root-module) (visit-module the-root-module)
(set! *callers-db* db))))) (set! *callers-db* db)))))