Reporting unused local variables

[Ludovic Courtès]

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

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