1
Fork 0
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:
Ludovic Courtès 2010-02-02 23:58:03 +01:00
parent df685ee46b
commit a670e67211

View file

@ -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)))
;;; ;;;