mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-03 08:10:31 +02:00
Use vhashes in `unused-variable-analysis'.
* module/language/tree-il/analyze.scm (unused-variable-analysis): Use vhashes instead of alists/lists.
This commit is contained in:
parent
df685ee46b
commit
a670e67211
1 changed files with 24 additions and 27 deletions
|
@ -594,7 +594,7 @@ accurate information is missing from a given `tree-il' element."
|
||||||
(vars (binding-info-vars info)))
|
(vars (binding-info-vars info)))
|
||||||
(record-case x
|
(record-case x
|
||||||
((<lexical-ref> gensym)
|
((<lexical-ref> gensym)
|
||||||
(make-binding-info vars (cons gensym refs)))
|
(make-binding-info vars (vhash-consq gensym #t refs)))
|
||||||
(else info))))
|
(else info))))
|
||||||
|
|
||||||
(lambda (x info env locs)
|
(lambda (x info env locs)
|
||||||
|
@ -604,14 +604,15 @@ accurate information is missing from a given `tree-il' element."
|
||||||
(vars (binding-info-vars info))
|
(vars (binding-info-vars info))
|
||||||
(src (tree-il-src x)))
|
(src (tree-il-src x)))
|
||||||
(define (extend inner-vars inner-names)
|
(define (extend inner-vars inner-names)
|
||||||
(append (map (lambda (var name)
|
(fold (lambda (var name vars)
|
||||||
(list var name src))
|
(vhash-consq var (list name src) vars))
|
||||||
inner-vars
|
vars
|
||||||
inner-names)
|
inner-vars
|
||||||
vars))
|
inner-names))
|
||||||
|
|
||||||
(record-case x
|
(record-case x
|
||||||
((<lexical-set> gensym)
|
((<lexical-set> gensym)
|
||||||
(make-binding-info vars (cons gensym refs)))
|
(make-binding-info vars (vhash-consq gensym #t refs)))
|
||||||
((<lambda-case> req opt inits rest kw vars)
|
((<lambda-case> req opt inits rest kw vars)
|
||||||
(let ((names `(,@req
|
(let ((names `(,@req
|
||||||
,@(or opt '())
|
,@(or opt '())
|
||||||
|
@ -632,25 +633,21 @@ accurate information is missing from a given `tree-il' element."
|
||||||
(let ((refs (binding-info-refs info))
|
(let ((refs (binding-info-refs info))
|
||||||
(vars (binding-info-vars info)))
|
(vars (binding-info-vars info)))
|
||||||
(define (shrink inner-vars refs)
|
(define (shrink inner-vars refs)
|
||||||
(for-each (lambda (var)
|
(vlist-for-each
|
||||||
(let ((gensym (car var)))
|
(lambda (var)
|
||||||
;; Don't report lambda parameters as
|
(let ((gensym (car var)))
|
||||||
;; unused.
|
;; Don't report lambda parameters as unused.
|
||||||
(if (and (not (memq gensym refs))
|
(if (and (memq gensym inner-vars)
|
||||||
(not (and (lambda-case? x)
|
(not (vhash-assq gensym refs))
|
||||||
(memq gensym
|
(not (lambda-case? x)))
|
||||||
inner-vars))))
|
(let ((name (cadr var))
|
||||||
(let ((name (cadr var))
|
;; We can get approximate source location by going up
|
||||||
;; We can get approximate
|
;; the LOCS location stack.
|
||||||
;; source location by going up
|
(loc (or (caddr var)
|
||||||
;; the LOCS location stack.
|
(find pair? locs))))
|
||||||
(loc (or (caddr var)
|
(warning 'unused-variable loc name)))))
|
||||||
(find pair? locs))))
|
vars)
|
||||||
(warning 'unused-variable loc name)))))
|
(vlist-drop vars (length inner-vars)))
|
||||||
(filter (lambda (var)
|
|
||||||
(memq (car var) inner-vars))
|
|
||||||
vars))
|
|
||||||
(fold alist-delete vars inner-vars))
|
|
||||||
|
|
||||||
;; For simplicity, we leave REFS untouched, i.e., with
|
;; For simplicity, we leave REFS untouched, i.e., with
|
||||||
;; names of variables that are now going out of scope.
|
;; names of variables that are now going out of scope.
|
||||||
|
@ -668,7 +665,7 @@ accurate information is missing from a given `tree-il' element."
|
||||||
(else info))))
|
(else info))))
|
||||||
|
|
||||||
(lambda (result env) #t)
|
(lambda (result env) #t)
|
||||||
(make-binding-info '() '())))
|
(make-binding-info vlist-null vlist-null)))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue