[PATCH 1/3] Add -Wunused-module.

["Ludovic Courtès" <ludo@gnu.org>]

* module/language/tree-il/analyze.scm (<module-info>): 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 | 138 ++++++++++++++++++++++++++-
 module/system/base/message.scm      |  11 ++-
 test-suite/tests/tree-il.test       | 141 +++++++++++++++++++++++++++-
 4 files changed, 304 insertions(+), 3 deletions(-)

diff --git a/NEWS b/NEWS
index 4313880c7..a0009406f 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,23 @@ See the end for copying conditions.
 
 Please send Guile bug reports to bug-guile@gnu.org.
 
+\f
+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".
+
 \f
 Changes in 3.0.9 (since 3.0.8)
 
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 7918b9ddd..ef68e2b9b 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
@@ -334,6 +334,139 @@ given `tree-il' element."
 
      (make-reference-graph vlist-null vlist-null #f))))
 
+\f
+;;;
+;;; Unused module analysis.
+;;;
+
+;; Module uses and references to bindings of imported modules.
+(define-record-type <module-info>
+  (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 ($ <module-ref> loc module name)
+            ($ <module-set> 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 ($ <toplevel-ref> loc module name)
+            ($ <toplevel-set> 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)))))
+       (($ <toplevel-define> 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.
+       (($ <call> loc ($ <module-ref> _ '(guile) 'define-module*))
+        (module-info loc
+                     (module-info-qualified-references info)
+                     (module-info-toplevel-references info)
+                     (module-info-toplevel-definitions info)))
+       (($ <call> loc ($ <module-ref> _ '(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
+       ;; <toplevel-ref> or <toplevel-set>, 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-exports-macros? module)
+       ;; Return #t if MODULE exports one or more macros.
+       (let ((tag (make-prompt-tag "return")))
+         (call-with-prompt tag
+           (lambda ()
+             (module-for-each (lambda (symbol variable)
+                                (when (and (variable-bound? variable)
+                                           (macro?
+                                            (variable-ref variable)))
+                                  (abort-to-prompt tag #t)))
+                              module)
+             #f)
+           (lambda (k exports-macros?)
+             exports-macros?))))
+
+     (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, which
+       ;; is the list of modules actually referenced.
+       (for-each (lambda (module)
+                   (unless (vhash-assoc (module-name module) used-modules)
+                     ;; If MODULE exports macros, and if the expansion
+                     ;; of those macros doesn't contain <module-ref>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)))
+
 \f
 ;;;
 ;;; Shadowed top-level definition analysis.
@@ -1268,6 +1401,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 +1422,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..b64d6fcfc 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 <wingo@pobox.com> --- 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,142 @@
                            #: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 "(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"
-- 
2.39.1