From 89c3bae3cf68fac9b6bf10fd377cd11de040be71 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 11 Feb 2023 23:33:37 +0100 Subject: Add -Wunused-module. * module/language/tree-il/analyze.scm (): New record type. (unused-module-analysis): New variable. (make-unused-module-analysis): New analysis. (make-analyzer): Add it. * module/system/base/message.scm (%warning-types): Add 'unused-module'. * test-suite/tests/tree-il.test (%opts-w-unused-module): New variable. ("warnings")["unused-module"]: New test prefix. * NEWS: Update. --- NEWS | 17 ++++ module/language/tree-il/analyze.scm | 154 ++++++++++++++++++++++++++++++++++- module/system/base/message.scm | 11 ++- test-suite/tests/tree-il.test | 157 +++++++++++++++++++++++++++++++++++- 4 files changed, 336 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index 4313880c7..a0009406f 100644 --- a/NEWS +++ b/NEWS @@ -5,6 +5,23 @@ See the end for copying conditions. Please send Guile bug reports to bug-guile@gnu.org. +Changes in 3.0.10 (since 3.0.9) + +* New interfaces and functionality + +** New warning: unused-module + +This analysis, enabled at `-W2', issues warnings for modules that appear +in a `use-modules' form or as a #:use-module clause of `define-module', +and whose bindings are unused. This is useful to trim the list of +imports of a module. + +In some cases, the compiler cannot conclude whether a module is +definitely unused---this is notably the case for modules that are only +used at macro-expansion time, such as (srfi srfi-26). In those cases, +the compiler reports it as "possibly unused". + + Changes in 3.0.9 (since 3.0.8) * Notable changes diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm index 7918b9ddd..c259b27ae 100644 --- a/module/language/tree-il/analyze.scm +++ b/module/language/tree-il/analyze.scm @@ -1,6 +1,6 @@ ;;; Diagnostic warnings for Tree-IL -;; Copyright (C) 2001,2008-2014,2016,2018-2022 Free Software Foundation, Inc. +;; Copyright (C) 2001,2008-2014,2016,2018-2023 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 @@ -335,6 +335,155 @@ given `tree-il' element." (make-reference-graph vlist-null vlist-null #f)))) +;;; +;;; Unused module analysis. +;;; + +;; Module uses and references to bindings of imported modules. +(define-record-type + (module-info location qualified-references + toplevel-references toplevel-definitions) + module-info? + (location module-info-location) ;location vector | #f + (qualified-references module-info-qualified-references) ;module name vhash + (toplevel-references module-info-toplevel-references) ;list of symbols + (toplevel-definitions module-info-toplevel-definitions)) ;symbol vhash + +(define unused-module-analysis + ;; Report unused modules in the given tree. + (make-tree-analysis + (lambda (x info env locs) + ;; Going down into X: extend INFO accordingly. + (match x + ((or ($ loc module name) + ($ loc module name)) + (let ((references (module-info-qualified-references info))) + (if (vhash-assoc module references) + info + (module-info (module-info-location info) + (vhash-cons module #t references) + (module-info-toplevel-references info) + (module-info-toplevel-definitions info))))) + ((or ($ loc module name) + ($ loc module name)) + (if (equal? module (module-name env)) + (let ((references (module-info-toplevel-references info))) + (module-info (module-info-location info) + (module-info-qualified-references info) + (cons x references) + (module-info-toplevel-definitions info))) + (let ((references (module-info-qualified-references info))) + (module-info (module-info-location info) + (vhash-cons module #t references) + (module-info-toplevel-references info) + (module-info-toplevel-definitions info))))) + (($ loc module name) + (module-info (module-info-location info) + (module-info-qualified-references info) + (module-info-toplevel-references info) + (vhash-consq name x + (module-info-toplevel-definitions info)))) + + ;; Record the approximate location of the module import. We + ;; could parse the #:imports arguments to determine the location + ;; of each #:use-module but we'll leave that as an exercise for + ;; the reader. + (($ loc ($ _ '(guile) 'define-module*)) + (module-info loc + (module-info-qualified-references info) + (module-info-toplevel-references info) + (module-info-toplevel-definitions info))) + (($ loc ($ _ '(guile) 'process-use-modules)) + (module-info loc + (module-info-qualified-references info) + (module-info-toplevel-references info) + (module-info-toplevel-definitions info))) + + (_ + info))) + + (lambda (x info env locs) ;leaving X's scope + info) + + (lambda (info env) ;finishing + (define (defining-module ref env) + ;; Return the name of the module that defines REF, a + ;; or , in ENV. + (let ((name (if (toplevel-ref? ref) + (toplevel-ref-name ref) + (toplevel-set-name ref)))) + (match (vhash-assq name (module-info-toplevel-definitions info)) + (#f + ;; NAME is not among the top-level definitions of this + ;; compilation unit, so check which module provides it. + (and=> (module-variable env name) + (lambda (variable) + (and=> (find (lambda (module) + (module-reverse-lookup module variable)) + (module-uses env)) + module-name)))) + (_ + (if (toplevel-ref? ref) + (toplevel-ref-mod ref) + (toplevel-set-mod ref)))))) + + (define (module-bindings-reexported? module env) + ;; Return true if ENV reexports one or more bindings from MODULE. + (let ((module (resolve-interface module)) + (tag (make-prompt-tag))) + (call-with-prompt tag + (lambda () + (module-for-each (lambda (symbol variable) + (when (module-reverse-lookup module variable) + (abort-to-prompt tag))) + (module-public-interface env)) + #f) + (const #t)))) + + (define (module-exports-macros? module) + ;; Return #t if MODULE exports one or more macros. + (let ((tag (make-prompt-tag))) + (call-with-prompt tag + (lambda () + (module-for-each (lambda (symbol variable) + (when (and (variable-bound? variable) + (macro? + (variable-ref variable))) + (abort-to-prompt tag))) + module) + #f) + (const #t)))) + + (let ((used-modules ;list of modules actually used + (fold (lambda (reference modules) + (let ((module (defining-module reference env))) + (if (or (not module) (vhash-assoc module modules)) + modules + (vhash-cons module #t modules)))) + (module-info-qualified-references info) + (module-info-toplevel-references info)))) + + ;; Compare the modules imported by ENV with USED-MODULES, the + ;; list of modules actually referenced. When a module is not in + ;; USED-MODULES, check whether ENV reexports bindings from it. + (for-each (lambda (module) + (unless (or (vhash-assoc (module-name module) + used-modules) + (module-bindings-reexported? + (module-name module) env)) + ;; If MODULE exports macros, and if the expansion + ;; of those macros doesn't contain s + ;; inside MODULE, then we cannot conclude whether + ;; or not MODULE is used. + (warning 'unused-module + (module-info-location info) + (module-name module) + (not (module-exports-macros? module))))) + (module-uses env)))) + + (module-info #f vlist-null '() vlist-null))) + + ;;; ;;; Shadowed top-level definition analysis. ;;; @@ -1268,6 +1417,8 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME." #:level 3 #:kind unused-variable #:analysis unused-variable-analysis) (define-analysis make-unused-toplevel-analysis #:level 2 #:kind unused-toplevel #:analysis unused-toplevel-analysis) +(define-analysis make-unused-module-analysis + #:level 2 #:kind unused-module #:analysis unused-module-analysis) (define-analysis make-shadowed-toplevel-analysis #:level 2 #:kind shadowed-toplevel #:analysis shadowed-toplevel-analysis) (define-analysis make-arity-analysis @@ -1287,6 +1438,7 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME." (analysis (cons analysis tail))))))) (let ((analyses (compute-analyses make-unused-variable-analysis make-unused-toplevel-analysis + make-unused-module-analysis make-shadowed-toplevel-analysis make-arity-analysis make-format-analysis diff --git a/module/system/base/message.scm b/module/system/base/message.scm index 869afa783..92ec0389d 100644 --- a/module/system/base/message.scm +++ b/module/system/base/message.scm @@ -1,6 +1,6 @@ ;;; User interface messages -;; Copyright (C) 2009-2012,2016,2018,2020-2021 Free Software Foundation, Inc. +;; Copyright (C) 2009-2012,2016,2018,2020-2021,2023 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 License as published by @@ -115,6 +115,15 @@ (emit port "~A: warning: possibly unused local top-level variable `~A'~%" loc name))) + (unused-module + "report unused modules" + ,(lambda (port loc name definitely-unused?) + (if definitely-unused? + (emit port "~A: warning: unused module ~a~%" + loc name) + (emit port "~A: warning: possibly unused module ~a~%" + loc name)))) + (shadowed-toplevel "report shadowed top-level variables" ,(lambda (port loc name previous-loc) diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test index b296be336..dd2e707b2 100644 --- a/test-suite/tests/tree-il.test +++ b/test-suite/tests/tree-il.test @@ -1,7 +1,7 @@ ;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*- ;;;; Andy Wingo --- May 2009 ;;;; -;;;; Copyright (C) 2009-2014,2018-2021 Free Software Foundation, Inc. +;;;; Copyright (C) 2009-2014,2018-2021,2023 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 @@ -217,6 +217,9 @@ (define %opts-w-unused-toplevel '(#:warnings (unused-toplevel))) +(define %opts-w-unused-module + '(#:warnings (unused-module))) + (define %opts-w-shadowed-toplevel '(#:warnings (shadowed-toplevel))) @@ -414,6 +417,158 @@ #:to 'cps #:opts %opts-w-unused-toplevel)))))) + (with-test-prefix "unused-module" + + (pass-if-equal "quiet" + '() + (call-with-warnings + (lambda () + (compile '(begin + (use-modules (ice-9 popen)) + (define (proc cmd) + (open-input-pipe cmd))) + #:env (make-fresh-user-module) + #:opts %opts-w-unused-module)))) + + (pass-if-equal "quiet, renamer" + '() + (call-with-warnings + (lambda () + (compile '(begin + (use-modules ((ice-9 popen) #:prefix p-)) + (define (proc cmd) + (p-open-input-pipe cmd))) + #:env (make-fresh-user-module) + #:opts %opts-w-unused-module)))) + + (pass-if "definitely unused" + (let* ((defmod '(define-module (foo) + #:use-module (ice-9 vlist) + #:use-module (ice-9 popen) + #:export (proc))) + (w (call-with-warnings + (lambda () + (set-source-properties! defmod + '((filename . "foo.scm") + (line . 0) + (column . 0))) + (compile `(begin + ,defmod + (define (frob x) + (vlist-cons x vlist-null))) + #:env (make-fresh-user-module) + #:opts %opts-w-unused-module))))) + (and (= (length w) 1) + (string-prefix? "foo.scm:1:0" (car w)) + (number? (string-contains (car w) + "unused module (ice-9 popen)"))))) + + (pass-if "definitely unused, use-modules" + (let* ((usemod '(use-modules (rnrs bytevectors) + (ice-9 q))) + (w (call-with-warnings + (lambda () + (set-source-properties! usemod + '((filename . "bar.scm") + (line . 5) + (column . 0))) + (compile `(begin + ,usemod + (define (square x) + (* x x))) + #:env (make-fresh-user-module) + #:opts %opts-w-unused-module))))) + (and (= (length w) 2) + (string-prefix? "bar.scm:6:0" (car w)) + (number? (string-contains (car w) + "unused module (rnrs bytevectors)")) + (number? (string-contains (cadr w) + "unused module (ice-9 q)"))))) + + (pass-if "definitely unused, local binding shadows imported one" + (let ((w (call-with-warnings + (lambda () + (compile `(begin + (define-module (whatever x y z) + #:use-module (ice-9 popen) + #:export (frob)) + + (define (open-input-pipe x) + ;; Shadows the one from (ice-9 popen). + x) + (define (frob y) + (close-port (open-input-pipe y)))) + #:env (make-fresh-user-module) + #:opts %opts-w-unused-module))))) + (and (= (length w) 1) + (number? (string-contains (car w) + "unused module (ice-9 popen)"))))) + + (pass-if-equal "(ice-9 match) is actually used" + '() + ;; (ice-9 match) is used and the macro expansion of the 'match' + ;; form refers to (@@ (ice-9 match) car) and the likes. + (call-with-warnings + (lambda () + (compile '(begin + (use-modules (ice-9 match)) + (define (proc lst) + (match lst + ((a b c) (+ a (* b c)))))) + #:env (make-fresh-user-module) + #:opts %opts-w-unused-module)))) + + (pass-if-equal "re-exporting is using" + '() + ;; This module re-exports a binding from (ice-9 q), so (ice-9 q) + ;; should be considered as used. + (call-with-warnings + (lambda () + (compile '(begin + (define-module (this is an ice-9 q user) + #:use-module (ice-9 q) + #:re-export (make-q) + #:export (proc)) + (define (proc a b) + (* a b))) + #:env (make-fresh-user-module) + #:opts %opts-w-unused-module)))) + + (pass-if "(srfi srfi-26) might be unused" + ;; At the tree-il level, it is impossible to know whether (srfi + ;; srfi-26) is actually use, because all we see is the output of + ;; macro expansion, and in this case it doesn't capture any + ;; binding from (srfi srfi-26). + (let* ((w (call-with-warnings + (lambda () + (compile `(begin + (define-module (whatever) + #:use-module (srfi srfi-26) + #:export (square)) + (define double + (cut * 2 <>))) + #:env (make-fresh-user-module) + #:opts %opts-w-unused-module))))) + (and (= (length w) 1) + (number? (string-contains (car w) + "possibly unused module (srfi srfi-26)"))))) + + (pass-if-equal "(ice-9 format) is actually used" + '() + ;; The 'format' binding of (ice-9 format) takes precedence over + ;; (@@ (guile) format), so (ice-9 format) must not be reported as + ;; unused. + (call-with-warnings + (lambda () + (compile '(begin + (define-module (whatever-else) + #:use-module (ice-9 format) + #:export (proc)) + (define (proc lst) + (format #f "~{~a ~}~%" lst))) + #:env (make-fresh-user-module) + #:opts %opts-w-unused-module))))) + (with-test-prefix "shadowed-toplevel" (pass-if "quiet" -- cgit v1.2.1