diff options
author | Ludovic Courtès <ludo@gnu.org> | 2010-01-11 01:19:16 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2010-01-11 01:21:13 +0100 |
commit | bcae9a98b0dd82b7be93e90134a01a03b44b4af7 (patch) | |
tree | e6c0f8fccf1f059b586d3313dde0ff9fb1ce510a /module | |
parent | 7cd554943b455248f8488f7b70b6dc31fc4cc67c (diff) | |
download | guile-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.
Diffstat (limited to 'module')
-rw-r--r-- | module/language/tree-il/analyze.scm | 150 | ||||
-rw-r--r-- | module/language/tree-il/compile-glil.scm | 1 | ||||
-rw-r--r-- | module/system/base/message.scm | 8 |
3 files changed, 153 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) |