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