Reporting unused local variables

Reporting unused local variables

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1117 bytes --]

Hello,

The attached patch is an attempt to add unused variable reporting to the
compiler, at the GLIL->assembly step.  It was quite simple to implement
here, and it should work with all front-ends (Scheme, ECMAScript, etc.),
which is nice.

Example:

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (lambda () (let ((x 2)) x))
$1 = #<program 7ffae3f42b40 at <unknown port>:1:0 ()>
scheme@(guile-user)> (lambda () (let ((x 2)) 'something-else))
<stdin>:3:11: variable `x' never referenced
$2 = #<program 7ffae3f36560 at <unknown port>:2:0 ()>
--8<---------------cut here---------------end--------------->8---

It works as well on actual programs such as the compiler itself, but
leads to a stack overflow on files with lots of unused variables, such
as `language/tree-il/compile-glil.scm', although `analyze-program' is
tail-recursive AFAICS (ideas welcome).

Also, it's annoying because it reports unused bindings introduced by
`record-case', and there are lots of them in the compiler.

Is this the right place and the right way to do such things?  Comments?

Thanks,
Ludo'.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The patch. --]
[-- Type: text/x-patch, Size: 3173 bytes --]

diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index 0b92a4e..5d3d400 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -26,7 +26,7 @@
   #:use-module (system vm instruction)
   #:use-module ((system vm program) #:select (make-binding))
   #:use-module (ice-9 receive)
-  #:use-module ((srfi srfi-1) #:select (fold))
+  #:use-module (srfi srfi-1)
   #:use-module (rnrs bytevector)
   #:export (compile-assembly))
 
@@ -134,6 +134,54 @@
   (and (not (null? objects))
        (list->vector (cons #f objects))))
 
+(define (analyze-program program)
+  (let loop ((glil       (glil-program-body program))
+             (locals     '())
+             (local-refs '())
+             (location   #f))
+    (if (null? glil)
+        program
+        (record-case (car glil)
+          ((<glil-bind> vars)
+           (loop (cdr glil)
+                 (append (filter-map (lambda (name+type+index)
+                                       (and (eq? (cadr name+type+index)
+                                                 'local)
+                                            (cons (caddr name+type+index)
+                                                  (car name+type+index))))
+                                     vars)
+                         locals)
+                 local-refs
+                 location))
+          ((<glil-local> op index)
+           (loop (cdr glil)
+                 locals
+                 (if (eq? op 'ref)
+                     (cons index local-refs)
+                     local-refs)
+                 location))
+          ((<glil-unbind>)
+           (let ((unused   (lset-difference = (map car locals)
+                                            local-refs))
+                 (location (if (pair? location)
+                               (format #f "~a:~a:~a"
+                                       (or (assoc-ref location 'filename)
+                                           "<stdin>")
+                                       (1+ (assoc-ref location 'line))
+                                       (assoc-ref location 'column))
+                               "<unknown-location>")))
+             (for-each (lambda (var)
+                         (format (current-error-port)
+                                 "~A: variable `~A' never referenced~%"
+                                 location
+                                 (assoc-ref locals var)))
+                       unused)
+             (loop (cdr glil) '() '() location)))
+          ((<glil-source> props)
+           (loop (cdr glil) locals local-refs props))
+          (else
+           (loop (cdr glil) locals local-refs location))))))
+
 (define (glil->assembly glil nexts-stack bindings
                         source-alist label-alist object-alist addr)
   (define (emit-code x)
@@ -143,6 +191,7 @@
 
   (record-case glil
     ((<glil-program> nargs nrest nlocs nexts meta body closure-level)
+     (analyze-program glil)
      (let ((toplevel? (null? nexts-stack)))
        (define (process-body)
          (let ((nexts-stack (cons nexts nexts-stack)))

Re: Reporting unused local variables

[Neil Jerram]

ludo@gnu.org (Ludovic Courtès) writes:

> Is this the right place and the right way to do such things?  Comments?

Looks great to me - but I'm still a bit of a newbie at this compiler
malarkey.

    Neil

Re: Reporting unused local variables

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 704 bytes --]

Hello,

ludo@gnu.org (Ludovic Courtès) writes:

> The attached patch is an attempt to add unused variable reporting to the
> compiler, at the GLIL->assembly step.  It was quite simple to implement
> here, and it should work with all front-ends (Scheme, ECMAScript, etc.),
> which is nice.

Following Andy's suggestion on IRC, I tried to integrate this feature in
the `analyze-lexicals' procedure of Tree-IL, this time (and with an
imperative style not quite to my taste.)

Unfortunately, source location information appears to be unavailable (or
just difficult to obtain?) at this level for code generated by macros
such as `record-case'.  Well, I probably just need some guidance.  ;-)

Voilà!

Ludo'.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 4551 bytes --]

diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 9768077..d8bdaef 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -64,6 +64,9 @@
   ;;  allows us to heapify vars in an O(1) fashion
   ;; refcounts: sym -> count
   ;;  allows us to detect the or-expansion an O(1) time
+  ;; variable-origins: gensym -> ((name . SYM) (filename . F) (column . C) ...)
+  ;;  associates the gensym variable symbol with an alist containing its
+  ;;  original name and source location information
 
   (define (find-heap sym parent)
     ;; fixme: check displaced lexicals here?
@@ -71,6 +74,16 @@
         parent
         (find-heap sym (hashq-ref parents parent))))
 
+  (define (tree-il? x)
+    (record? x))
+
+  (define (find-src x parent)
+    ;; Find the closest source location alist available.
+    (if (tree-il? x)
+        (or (tree-il-src x)
+            (find-src parent #f))
+        '()))
+
   (define (analyze! x parent level)
     (define (step y) (analyze! y parent level))
     (define (recur x parent) (analyze! x parent (1+ level)))
@@ -104,7 +117,13 @@
       ((<sequence> exps)
        (for-each step exps))
       
-      ((<lambda> vars meta body)
+      ((<lambda> names vars meta body)
+       ;; FIXME: Handle the case where NAMES and VARS are dotted lists.
+       (if (list? vars)
+           (for-each (lambda (name var)
+                       (hashq-set! variable-origins var
+                                   (cons `(name . ,name) (find-src x parent))))
+                     names vars))
        (hashq-set! parents x parent)
        (hashq-set! bindings x
                    (let rev* ((vars vars) (out '()))
@@ -115,19 +134,31 @@
        (recur body x)
        (hashq-set! bindings x (reverse! (hashq-ref bindings x))))
 
-      ((<let> vars vals body)
+      ((<let> names vars vals body)
+       (for-each (lambda (name var)
+                   (hashq-set! variable-origins var
+                               (cons `(name . ,name) (find-src x parent))))
+                 names vars)
        (for-each step vals)
        (hashq-set! bindings parent
                    (append (reverse vars) (hashq-ref bindings parent)))
        (step body))
       
-      ((<letrec> vars vals body)
+      ((<letrec> names vars vals body)
+       (for-each (lambda (name var)
+                   (hashq-set! variable-origins var
+                               (cons `(name . ,name) (find-src x parent))))
+                 names vars)
        (hashq-set! bindings parent
                    (append (reverse vars) (hashq-ref bindings parent)))
        (for-each step vals)
        (step body))
 
-      ((<let-values> vars exp body)
+      ((<let-values> names vars exp body)
+       (for-each (lambda (name var)
+                   (hashq-set! variable-names var
+                               (cons `(name . ,name) (find-src x parent))))
+                 names vars)
        (hashq-set! bindings parent
                    (let lp ((out (hashq-ref bindings parent)) (in vars))
                      (if (pair? in)
@@ -251,8 +282,30 @@
   (define refcounts (make-hash-table))
   (define allocation (make-hash-table))
   (define heap-indexes (make-hash-table))
+  (define variable-origins (make-hash-table))
 
   (analyze! x #f -1)
   (allocate! x -1 0)
 
+  (hash-for-each (lambda (gensym value)
+                   (if (symbol? gensym)
+                       (let* ((refcount (hashq-ref refcounts gensym 0))
+                              (origins  (hashq-ref variable-origins gensym
+                                                   '()))
+                              (name     (assoc-ref origins 'name))
+                              (location
+                               (if (assoc-ref origins 'line)
+                                   (format #f "~a:~a:~a"
+                                           (or (assoc-ref origins 'filename)
+                                               "<stdin>")
+                                           (1+ (assoc-ref origins 'line))
+                                           (assoc-ref origins 'column))
+                                   "<unknown-location>")))
+                         (if (zero? refcount)
+                             (format (current-error-port)
+                                     "~A: variable `~A' never used~%"
+                                     location
+                                     (or name gensym))))))
+                 allocation)
+
   allocation)

Re: Reporting unused local variables

[Andy Wingo]

Hi Ludovic,

This isn't a review really, because I changed the code in question... I
hope you find the new analyze-lexicals procedure easier to understand.
It's certainly better documented :)

On Thu 02 Jul 2009 19:35, ludo@gnu.org (Ludovic Courtès) writes:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> The attached patch is an attempt to add unused variable reporting to the
>> compiler, at the GLIL->assembly step.  It was quite simple to implement
>> here, and it should work with all front-ends (Scheme, ECMAScript, etc.),
>> which is nice.
>
> Following Andy's suggestion on IRC, I tried to integrate this feature in
> the `analyze-lexicals' procedure of Tree-IL, this time (and with an
> imperative style not quite to my taste.)

We could do this with multiple values, but we'd need decent functional
map data structures. However the new algorithm is more functional than
the last.

> Unfortunately, source location information appears to be unavailable (or
> just difficult to obtain?) at this level for code generated by macros
> such as `record-case'.  Well, I probably just need some guidance.  ;-)

You won't get source location information out of defmacros. 

OK, here's another idea. Why don't we keep this as a separate pass --
enabled if you pass a compilation option. That way it can be more
functional, and you can keep approximate source information. At each
node you have a set of identifiers that are bound but not referenced. If
the node is a reference, you remove that identifier from the set. If it
is a binding, you add the bindings, traverse subexpressions, then do a
set difference between your bindings and the return value from
subexpression traversal -- that's your unused bindings.

What do you think?

A
-- 
http://wingolog.org/

Re: Reporting unused local variables

[Ludovic Courtès]

¡Hola!

Andy Wingo <wingo@pobox.com> writes:

> OK, here's another idea. Why don't we keep this as a separate pass --
> enabled if you pass a compilation option. That way it can be more
> functional, and you can keep approximate source information.

By "pass", you mean a new "language" in the tower?  As in
`lookup-compilation-order'?

> At each node you have a set of identifiers that are bound but not
> referenced. If the node is a reference, you remove that identifier
> from the set. If it is a binding, you add the bindings, traverse
> subexpressions, then do a set difference between your bindings and the
> return value from subexpression traversal -- that's your unused
> bindings.

Yes, this is roughly what I initially did[*], so that sounds reasonable.

Thanks!

Ludo'.

[*] http://thread.gmane.org/gmane.lisp.guile.devel/8795

Re: Reporting unused local variables

[Andy Wingo]

On Thu 23 Jul 2009 23:21, ludo@gnu.org (Ludovic Courtès) writes:

> ¡Hola!
>
> Andy Wingo <wingo@pobox.com> writes:
>
>> OK, here's another idea. Why don't we keep this as a separate pass --
>> enabled if you pass a compilation option. That way it can be more
>> functional, and you can keep approximate source information.
>
> By "pass", you mean a new "language" in the tower?  As in
> `lookup-compilation-order'?

No, just a procedure to run on the tree-il, after tree-il optimization
but before tree-il->glil compilation

>> At each node you have a set of identifiers that are bound but not
>> referenced. If the node is a reference, you remove that identifier
>> from the set. If it is a binding, you add the bindings, traverse
>> subexpressions, then do a set difference between your bindings and the
>> return value from subexpression traversal -- that's your unused
>> bindings.
>
> Yes, this is roughly what I initially did[*], so that sounds reasonable.
> [*] http://thread.gmane.org/gmane.lisp.guile.devel/8795

Apologies for being MIA, then ;-)

Cheers,

Andy
-- 
http://wingolog.org/

Re: Reporting unused local variables

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 738 bytes --]

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.)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: the patch --]
[-- Type: text/x-patch, Size: 7030 bytes --]

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)

Re: Reporting unused local variables

[Ludovic Courtès]

Hello!

I just committed the changes summarized below that add
`-W unused-variable' to "guile-tools compile".

It appears to work well, but only has approximate source location info
for `define-macro' expansions, for instance (but that's another story).

Daniel: could you try it with the Elisp front-end and report back?

I'm planning to add warnings for possibly unbound variables, and global
bindings unused in the current module and not exported (and eventually
anything Guile-Lint supported).

Thanks,
Ludo'.

  commit 4b856371b3e85cd82f6d637f72bc610d0158b5de
  Author: Ludovic Courtès <ludo@gnu.org>
  Date:   Fri Jul 31 00:42:58 2009 +0200

      Add unused variable analysis in the tree-il->glil compiler.

      * module/language/tree-il/analyze.scm (<binding-info>): New record type.
        (report-unused-variables): New procedure.

      * module/language/tree-il/compile-glil.scm (%warning-passes): New
        variable.
        (compile-glil): Honor `#:warnings' from OPTS.

      * test-suite/tests/tree-il.test (call-with-warnings): New procedure.
        (%opts-w-unused): New variable.
        ("warnings"): New test prefix.

  commit 2e4c3227ce1374dd53abd3c7c5797cc64329de91
  Author: Ludovic Courtès <ludo@gnu.org>
  Date:   Fri Jul 31 00:06:59 2009 +0200

      Add `(system base message)', a simple warning framework.

      * module/Makefile.am (SOURCES): Add `system/base/message.scm'.

      * module/scripts/compile.scm (%options): Add `--warn'.
        (parse-args): Update default value for `warnings'.
        (show-warning-help): New procedure.
        (compile)[compile-opts]: Add `#:warnings'.
        Update help message.

      * module/system/base/compile.scm (compile): Sanity-check the requested
        warnings.

      * module/system/base/message.scm: New file.

  commit f4aa0f104b3347c21093b837046022fb7bb6a2ff
  Author: Ludovic Courtès <ludo@gnu.org>
  Date:   Thu Jul 30 00:48:04 2009 +0200

      Add `tree-il-fold', a purely functional iterator on `tree-il'.

      * module/language/tree-il.scm (tree-il-fold): New procedure.

      * test-suite/tests/tree-il.test ("tree-il-fold"): New test prefix.