summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-01-11 01:19:16 +0100
committerLudovic Courtès <ludo@gnu.org>2010-01-11 01:21:13 +0100
commitbcae9a98b0dd82b7be93e90134a01a03b44b4af7 (patch)
treee6c0f8fccf1f059b586d3313dde0ff9fb1ce510a
parent7cd554943b455248f8488f7b70b6dc31fc4cc67c (diff)
downloadguile-bcae9a98b0dd82b7be93e90134a01a03b44b4af7.tar.gz
Add `-Wunused-toplevel' compiler warning.
* module/language/tree-il/analyze.scm (<reference-dag>): New record type. (dag-reachable-nodes, dag-reachable-nodes*, unused-variable-analysis): New variables. (unbound-variable-analysis): Slightly simplify the `up' procedure. * module/language/tree-il/compile-glil.scm (%warning-passes): Add `unused-toplevel'. * module/system/base/message.scm (%warning-types): Likewise. * test-suite/tests/tree-il.test (%opts-w-unused-toplevel): New variable. ("warnings")["unused-toplevel"]: New test prefix.
-rw-r--r--module/language/tree-il/analyze.scm150
-rw-r--r--module/language/tree-il/compile-glil.scm1
-rw-r--r--module/system/base/message.scm8
-rw-r--r--test-suite/tests/tree-il.test108
4 files changed, 261 insertions, 6 deletions
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index abda76075..f9e5b2f36 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -6,12 +6,12 @@
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
-;;;;
+;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
@@ -21,6 +21,7 @@
(define-module (language tree-il analyze)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-11)
#:use-module (system base syntax)
#:use-module (system base message)
#:use-module (system vm program)
@@ -29,6 +30,7 @@
#:export (analyze-lexicals
analyze-tree
unused-variable-analysis
+ unused-toplevel-analysis
unbound-variable-analysis
arity-analysis))
@@ -637,6 +639,146 @@ accurate information is missing from a given `tree-il' element."
;;;
+;;; Unused top-level variable analysis.
+;;;
+
+;; <reference-dag> record top-level definitions that are made, references to
+;; top-level definitions and their context (the top-level definition in which
+;; the reference appears), as well as the current context (the top-level
+;; definition we're currently in). The second part (`refs' below) is
+;; effectively a DAG from which we can determine unused top-level definitions.
+(define-record-type <reference-dag>
+ (make-reference-dag refs defs toplevel-context)
+ reference-dag?
+ (defs reference-dag-defs) ;; ((NAME . LOC) ...)
+ (refs reference-dag-refs) ;; ((REF-CONTEXT REF ...) ...)
+ (toplevel-context reference-dag-toplevel-context)) ;; NAME | #f
+
+(define (dag-reachable-nodes root refs)
+ ;; Return the list of nodes reachable from ROOT in DAG REFS. REFS is an alist
+ ;; representing edges: ((A B C) (B A) (C)) corresponds to
+ ;;
+ ;; ,-------.
+ ;; v |
+ ;; A ----> B
+ ;; |
+ ;; v
+ ;; C
+
+ (let loop ((root root)
+ (path '())
+ (result '()))
+ (if (or (memq root path)
+ (memq root result))
+ result
+ (let ((children (assoc-ref refs root)))
+ (if (not children)
+ result
+ (let ((path (cons root path)))
+ (append children
+ (fold (lambda (child result)
+ (loop child path result))
+ result
+ children))))))))
+
+(define (dag-reachable-nodes* roots refs)
+ ;; Return the list of nodes in REFS reachable from the nodes listed in ROOTS.
+ ;; FIXME: Choose a more efficient algorithm.
+ (apply lset-union eq?
+ (map (lambda (node)
+ (cons node (dag-reachable-nodes node refs)))
+ roots)))
+
+(define unused-toplevel-analysis
+ ;; Report unused top-level definitions that are not exported.
+ (let ((add-ref-from-context
+ (lambda (dag name)
+ ;; Add an edge CTX -> NAME in DAG.
+ (let* ((refs (reference-dag-refs dag))
+ (defs (reference-dag-defs dag))
+ (ctx (reference-dag-toplevel-context dag))
+ (ctx-refs (or (assoc-ref refs ctx) '())))
+ (make-reference-dag (alist-cons ctx (cons name ctx-refs)
+ (alist-delete ctx refs eq?))
+ defs ctx)))))
+ (define (macro-variable? name env)
+ (and (module? env)
+ (let ((var (module-variable env name)))
+ (and var (variable-bound? var)
+ (macro? (variable-ref var))))))
+
+ (make-tree-analysis
+ (lambda (x dag env locs)
+ ;; X is a leaf.
+ (let ((ctx (reference-dag-toplevel-context dag)))
+ (record-case x
+ ((<toplevel-ref> name src)
+ (add-ref-from-context dag name))
+ (else dag))))
+
+ (lambda (x dag env locs)
+ ;; Going down into X.
+ (let ((ctx (reference-dag-toplevel-context dag))
+ (refs (reference-dag-refs dag))
+ (defs (reference-dag-defs dag)))
+ (record-case x
+ ((<toplevel-define> name src)
+ (let ((refs refs)
+ (defs (alist-cons name (or src (find pair? locs))
+ defs)))
+ (make-reference-dag refs defs name)))
+ ((<toplevel-set> name src)
+ (add-ref-from-context dag name))
+ (else dag))))
+
+ (lambda (x dag env locs)
+ ;; Leaving X's scope.
+ (record-case x
+ ((<toplevel-define>)
+ (let ((refs (reference-dag-refs dag))
+ (defs (reference-dag-defs dag)))
+ (make-reference-dag refs defs #f)))
+ (else dag)))
+
+ (lambda (dag env)
+ ;; Process the resulting reference DAG: determine all private definitions
+ ;; not reachable from any public definition. Macros
+ ;; (syntax-transformers), which are globally bound, never considered
+ ;; unused since we can't tell whether a macro is actually used; in
+ ;; addition, macros are considered roots of the DAG since they may use
+ ;; private bindings. FIXME: The `make-syntax-transformer' calls don't
+ ;; contain any literal `toplevel-ref' of the global bindings they use so
+ ;; this strategy fails.
+ (define (exported? name)
+ (if (module? env)
+ (module-variable (module-public-interface env) name)
+ #t))
+
+ (let-values (((public-defs private-defs)
+ (partition (lambda (name+src)
+ (let ((name (car name+src)))
+ (or (exported? name)
+ (macro-variable? name env))))
+ (reference-dag-defs dag))))
+ (let* ((roots (cons #f (map car public-defs)))
+ (refs (reference-dag-refs dag))
+ (reachable (dag-reachable-nodes* roots refs))
+ (unused (filter (lambda (name+src)
+ ;; FIXME: This is inefficient when
+ ;; REACHABLE is large (e.g., boot-9.scm);
+ ;; use a vhash or equivalent.
+ (not (memq (car name+src) reachable)))
+ private-defs)))
+ (for-each (lambda (name+loc)
+ (let ((name (car name+loc))
+ (loc (cdr name+loc)))
+ (warning 'unused-toplevel loc name)))
+ (reverse unused)))))
+
+ (make-reference-dag '() '() #f))))
+
+
+;;;
;;; Unbound variable analysis.
;;;
@@ -732,9 +874,7 @@ accurate information is missing from a given `tree-il' element."
(lambda (x info env locs)
;; Leaving X's scope.
- (let ((refs (toplevel-info-refs info))
- (defs (toplevel-info-defs info)))
- (make-toplevel-info refs defs)))
+ info)
(lambda (toplevel env)
;; Post-process the result.
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index a2102c902..bfa57a19c 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -45,6 +45,7 @@
(define %warning-passes
`((unused-variable . ,unused-variable-analysis)
+ (unused-toplevel . ,unused-toplevel-analysis)
(unbound-variable . ,unbound-variable-analysis)
(arity-mismatch . ,arity-analysis)))
diff --git a/module/system/base/message.scm b/module/system/base/message.scm
index bacf0415b..98bf5cf25 100644
--- a/module/system/base/message.scm
+++ b/module/system/base/message.scm
@@ -1,6 +1,6 @@
;;; User interface messages
-;; Copyright (C) 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -81,6 +81,12 @@
(format port "~A: warning: unused variable `~A'~%"
loc name)))
+ (unused-toplevel
+ "report unused local top-level variables"
+ ,(lambda (port loc name)
+ (format port "~A: warning: possibly unused local top-level variable `~A'~%"
+ loc name)))
+
(unbound-variable
"report possibly unbound variables"
,(lambda (port loc name)
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index f5f85d0ae..fb875ccd2 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -554,6 +554,9 @@
(define %opts-w-unused
'(#:warnings (unused-variable)))
+(define %opts-w-unused-toplevel
+ '(#:warnings (unused-toplevel)))
+
(define %opts-w-unbound
'(#:warnings (unbound-variable)))
@@ -615,6 +618,111 @@
(compile '(lambda (x y z) #t)
#:opts %opts-w-unused))))))
+ (with-test-prefix "unused-toplevel"
+
+ (pass-if "used after definition"
+ (null? (call-with-warnings
+ (lambda ()
+ (let ((in (open-input-string
+ "(define foo 2) foo")))
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "used before definition"
+ (null? (call-with-warnings
+ (lambda ()
+ (let ((in (open-input-string
+ "(define (bar) foo) (define foo 2) (bar)")))
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused but public"
+ (let ((in (open-input-string
+ "(define-module (test-suite tree-il x) #:export (bar))
+ (define (bar) #t)")))
+ (null? (call-with-warnings
+ (lambda ()
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused but public (more)"
+ (let ((in (open-input-string
+ "(define-module (test-suite tree-il x) #:export (bar))
+ (define (bar) (baz))
+ (define (baz) (foo))
+ (define (foo) #t)")))
+ (null? (call-with-warnings
+ (lambda ()
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused but define-public"
+ ;; FIXME: We don't handle this case for now because `define-public'
+ ;; expands to a relatively complex statement that's hard to match.
+ (throw 'unresolved)
+
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(define-public foo 2)
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+
+ (pass-if "used by macro"
+ ;; FIXME: See comment about macros at `unused-toplevel-analysis'.
+ (throw 'unresolved)
+
+ (null? (call-with-warnings
+ (lambda ()
+ (let ((in (open-input-string
+ "(define (bar) 'foo)
+ (define-syntax baz
+ (syntax-rules () ((_) (bar))))")))
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '(define foo 2)
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ (format #f "top-level variable `~A'"
+ 'foo))))))
+
+ (pass-if "unused recursive"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '(define (foo) (foo))
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ (format #f "top-level variable `~A'"
+ 'foo))))))
+
+ (pass-if "unused mutually recursive"
+ (let* ((in (open-input-string
+ "(define (foo) (bar)) (define (bar) (foo))"))
+ (w (call-with-warnings
+ (lambda ()
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+ (and (= (length w) 2)
+ (number? (string-contains (car w)
+ (format #f "top-level variable `~A'"
+ 'foo)))
+ (number? (string-contains (cadr w)
+ (format #f "top-level variable `~A'"
+ 'bar)))))))
+
(with-test-prefix "unbound variable"
(pass-if "quiet"