mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +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)))
(define (ensure-callers-db)
(let ((visited '())
(let ((visited #f)
(db #f))
(define (visit-variable var)
(if (variable-bound? var)
(let ((x (variable-ref var)))
(cond
((hashq-ref visited x))
((procedure? x)
(hashq-set! visited x #t)
(for-each
(lambda (callee)
(if (variable-bound? callee)
(hashq-set! db callee
(cons x (hashq-ref db callee '())))))
(procedure-callee-rev-vars x)))
((and (module? x) (not (memq x visited)))
((module? x)
(visit-module x))))))
(define (visit-module mod)
(set! visited (cons mod visited))
(hashq-set! visited mod #t)
(if (not (memq on-module-modified (module-observers mod)))
(module-observe mod on-module-modified))
(module-for-each (lambda (sym var)
@ -121,7 +123,8 @@
(if (not *callers-db*)
(begin
(set! db (make-hash-table))
(set! db (make-hash-table 1000))
(set! visited (make-hash-table 1000))
(visit-module the-root-module)
(set! *callers-db* db)))))