[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Reporting unused local variables
From: |
Ludovic Courtès |
Subject: |
Re: Reporting unused local variables |
Date: |
Tue, 28 Jul 2009 23:51:16 +0200 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/23.1.50 (gnu/linux) |
Hello Guilers!
Here's a third attempt. This time, it's done as a separate pass at the
tree-il level *and* in a purely functional way.
I owe a great debt to a famous Scheme hacker whose paper /Applications
of fold to XML transformation/ was a invaluable source of
inspiration [0]. Thanks! :-)
If we agree on this approach, I'll polish it up, make the pass optional
based on compilation options (disabled by default), and separate out the
UI-related things (messages, that is).
Thanks,
Ludo'.
[0] http://wingolog.org/archives/2007/07/11/fold-xml-presentations
This one is not the "official" version with the ACM copyright, but
it can easily be found on the Internet (and the content is
essentially the same, I think.)
diff --git a/module/language/tree-il/analyze.scm
b/module/language/tree-il/analyze.scm
index 4ed796c..1e97c49 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -307,4 +307,150 @@
(analyze! x #f)
(allocate! x #f 0)
+ (report-unused-variables x)
allocation)
+
+(define (tree-il-fold leaf down up seed tree)
+ "Traverse TREE, calling LEAF on each leaf encountered, DOWN upon descent
+into a sub-tree, and UP when leaving a sub-tree. Each of these procedures is
+invoked as `(PROC TREE SEED)', where TREE is the sub-tree or leaf considered
+and SEED is the current result, intially seeded with SEED.
+
+This is an implementation of `foldts' as described by Andy Wingo in
+``Applications of fold to XML transformation''."
+ (let loop ((tree tree)
+ (result seed))
+ (if (or (null? tree) (pair? tree))
+ (fold loop result tree)
+ (record-case tree
+ ((<lexical-set> exp)
+ (up tree (loop exp (down tree result))))
+ ((<module-set> exp)
+ (up tree (loop exp (down tree result))))
+ ((<toplevel-set> exp)
+ (up tree (loop exp (down tree result))))
+ ((<toplevel-define> exp)
+ (up tree (loop exp (down tree result))))
+ ((<conditional> test then else)
+ (up tree (loop else
+ (loop then
+ (loop test (down tree result))))))
+ ((<application> proc args)
+ (up tree (loop (cons proc args) (down tree result))))
+ ((<sequence> exps)
+ (up tree (loop exps (down tree result))))
+ ((<lambda> body)
+ (up tree (loop body (down tree result))))
+ ((<let> vals body)
+ (up tree (loop body
+ (loop vals
+ (down tree result)))))
+ ((<letrec> vals body)
+ (up tree (loop body
+ (loop vals
+ (down tree result)))))
+ ((<let-values> body)
+ (up tree (loop body (down tree result))))
+ (else
+ (leaf tree result))))))
+
+(define (make-binding-info vars refs) (vector vars refs))
+(define (binding-info-vars info) (vector-ref info 0))
+(define (binding-info-refs info) (vector-ref info 1))
+
+(define (report-unused-variables tree)
+ "Report about unused variables in TREE. Return TREE."
+
+ (define (location-string loc)
+ (if (pair? loc)
+ (format #f "~a:~a:~a"
+ (or (assoc-ref loc 'filename) "<stdin>")
+ (1+ (assoc-ref loc 'line))
+ (assoc-ref loc 'column))
+ "<unknown-location>"))
+
+ (define (dotless-list lst)
+ ;; If LST is a dotted list, return a proper list equal to LST except that
+ ;; the very last element is a pair; otherwise return LST.
+ (let loop ((lst lst)
+ (result '()))
+ (cond ((null? lst)
+ (reverse result))
+ ((pair? lst)
+ (loop (cdr lst) (cons (car lst) result)))
+ (else
+ (loop '() (cons lst result))))))
+
+ (tree-il-fold (lambda (x info)
+ ;; X is a leaf: extend INFO's refs accordingly.
+ (let ((refs (binding-info-refs info))
+ (vars (binding-info-vars info)))
+ (record-case x
+ ((<lexical-ref> gensym)
+ (make-binding-info vars (cons gensym refs)))
+ (else info))))
+
+ (lambda (x info)
+ ;; Going down into X: extend INFO's variable list
+ ;; accordingly.
+ (let ((refs (binding-info-refs info))
+ (vars (binding-info-vars info))
+ (src (tree-il-src x)))
+ (define (extend inner-vars inner-names)
+ (append (map (lambda (var name)
+ (list var name src))
+ inner-vars
+ inner-names)
+ vars))
+ (record-case x
+ ((<lexical-set> gensym)
+ (make-binding-info vars (cons gensym refs)))
+ ((<lambda> vars names)
+ (let ((vars (dotless-list vars))
+ (names (dotless-list names)))
+ (make-binding-info (extend vars names) refs)))
+ ((<let> vars names)
+ (make-binding-info (extend vars names) refs))
+ ((<letrec> vars names)
+ (make-binding-info (extend vars names) refs))
+ ((<let-values> vars names)
+ (make-binding-info (extend vars names) refs))
+ (else info))))
+
+ (lambda (x info)
+ ;; Leaving X's scope: shrink INFO's variable list
+ ;; accordingly and reported unused nested variables.
+ (let ((refs (binding-info-refs info))
+ (vars (binding-info-vars info)))
+ (define (shrink inner-vars refs)
+ (for-each (lambda (var)
+ (let ((gensym (car var)))
+ (if (not (memq gensym refs))
+ (let ((name (cadr var))
+ (loc (location-string (caddr
var))))
+ (format (current-error-port)
+ "~A: variable `~A' never
referenced~%"
+ loc name)))))
+ (filter (lambda (var)
+ (memq (car var) inner-vars))
+ vars))
+ (fold alist-delete vars inner-vars))
+
+ ;; XXX: For simplicity, we leave REFS untouched, i.e.,
+ ;; with names of variables that are now going out of
+ ;; scope. It doesn't hurt as these are unique names, it
+ ;; just makes REFS unnecessarily fat.
+ (record-case x
+ ((<lambda> vars)
+ (let ((vars (dotless-list vars)))
+ (make-binding-info (shrink vars refs) refs)))
+ ((<let> vars)
+ (make-binding-info (shrink vars refs) refs))
+ ((<letrec> vars)
+ (make-binding-info (shrink vars refs) refs))
+ ((<let-values> vars)
+ (make-binding-info (shrink vars refs) refs))
+ (else info))))
+ (make-binding-info '() '())
+ tree)
+ tree)