New warnings: -Wuse-before-definition, -Wnon-idempotent-definition

* module/ice-9/boot-9.scm (%auto-compilation-options): Add
  use-before-definition and non-idempotent-definition.
* module/language/tree-il/analyze.scm (<use-before-def-info>): New
  analysis info.
  (make-use-before-definition-analysis): New function.
  (goops-toplevel-definition): Move down.
  (unbound-variable-analysis, macro-use-before-definition): Remove, as
  they are subsumed by use-before-def.  There are some deprecated
  bindings though.
  (make-analyzer): Rework to allow for use-before-def analysis to handle
  multiple
* module/system/base/message.scm (%warning-types): Add handlers for the
  new warning types.
* test-suite/tests/tree-il.test: Add tests.
* doc/ref/api-evaluation.texi (Compilation): Update.

doc/ref/api-evaluation.texi

@@ -1,7 +1,7 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
 @c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009,
-@c   2010, 2011, 2012, 2013, 2014, 2020 Free Software Foundation, Inc.
+@c   2010, 2011, 2012, 2013, 2014, 2020, 2021 Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
 @node Read/Load/Eval/Compile
@@ -666,13 +666,9 @@ For example, to compile R6RS code, you might want to pass @command{-x
 @item -W @var{warning}
 @itemx --warn=@var{warning}
 @cindex warnings, compiler
-Emit warnings of type @var{warning}; use @code{--warn=help} for a list
+Enable specific warning passes; use @code{-Whelp} for a list of
-of available warnings and their description.  Currently recognized
+available options.  The default is @code{-W1}, which enables a number of
-warnings include @code{unused-variable}, @code{unused-toplevel},
+common warnings.  Pass @code{-W0} to disable all warnings.
-@code{shadowed-toplevel}, @code{unbound-variable},
-@code{macro-use-before-definition},
-@code{arity-mismatch}, @code{format},
-@code{duplicate-case-datum}, and @code{bad-case-datum}.
 
 @item -O @var{opt}
 @itemx --optimize=@var{opt}

module/ice-9/boot-9.scm

@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 
-;;;; Copyright (C) 1995-2014, 2016-2020  Free Software Foundation, Inc.
+;;;; Copyright (C) 1995-2014, 2016-2021  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
@@ -4200,9 +4200,9 @@ but it fails to load."
 
 (define %auto-compilation-options
   ;; Default `compile-file' option when auto-compiling.
-  '(#:warnings (unbound-variable shadowed-toplevel
+  '(#:warnings (shadowed-toplevel use-before-definition arity-mismatch
-                macro-use-before-definition arity-mismatch
+                format duplicate-case-datum bad-case-datum
-                format duplicate-case-datum bad-case-datum)))
+                non-idempotent-definition)))
 
 (define* (load-in-vicinity dir file-name #:optional reader)
   "Load source file FILE-NAME in vicinity of directory DIR.  Use a

module/language/tree-il/analyze.scm

@@ -1,6 +1,6 @@
-;;; TREE-IL -> GLIL compiler
+;;; Diagnostic warnings for Tree-IL
 
-;; Copyright (C) 2001,2008-2014,2016,2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001,2008-2014,2016,2018-2021 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
@@ -34,8 +34,7 @@
             unused-variable-analysis
             unused-toplevel-analysis
             shadowed-toplevel-analysis
-            unbound-variable-analysis
+            make-use-before-definition-analysis
-            macro-use-before-definition-analysis
             arity-analysis
             format-analysis
             make-analyzer))
@@ -368,155 +367,300 @@ given `tree-il' element."
 
 
 ;;;
-;;; Unbound variable analysis.
+;;; Use before definition analysis.
+;;;
+;;; This analysis collects all definitions of top-level variables, and
+;;; references to top-level variables.  As it visits the term, it tries
+;;; to match uses to the definition that corresponds to that program
+;;; point.  For example, in this sample program:
+;;;
+;;;   (define a 42)
+;;;   (define b a)
+;;;
+;;; The analysis will be able to know that the definition of "a"
+;;; referred to when defining "b" is 42.
+;;;
+;;; In many cases this definition is conservative.  For example, in this
+;;; code:
+;;;
+;;;   (define a 42)
+;;;   (define b (lambda () a))
+;;;
+;;; We don't necessarily know that the "a" in the lambda is 42, as a
+;;; further top-level definition could provide a different value.
+;;; However, we do know that "a" is bound, unlike in this code:
+;;;
+;;;   (define b (lambda () a))
+;;;
+;;; Here we should issue a warning if no import provides an "a" binding.
+;;;
+;;; Use-before-def analysis also issues specialized warnings for some
+;;; less common errors.  One relates specifically to macro use before
+;;; definition.  If a compilation unit defines a macro and has some uses
+;;; of the macro, usually the uses will be expanded out by the
+;;; macro-expander.  If there is any reference to a macro as a value,
+;;; that usually indicates a bug in the user's program.  Like in this
+;;; program:
+;;;
+;;;   (define (a) (b))
+;;;   (define-syntax-rule (b) 42)
+;;;
+;;; If this program is expanded one top-level expression at a time,
+;;; which is Guile's default compilation mode, the expander will assume
+;;; that the reference to (b) is a call to a top-level procedure, only
+;;; to find out it's a macro later on.  Use-before-def analysis can warn
+;;; for this case.
+;;;
+;;; Similarly, if a compilation unit uses an imported binding, then
+;;; provides a local definition for the binding, this may cause problems
+;;; if the module is re-loaded.  Consider:
+;;;
+;;;   (define-module (foo))
+;;;   (define a +)
+;;;   (define + -)
+;;;
+;;; In this fragment, we see the intention of the programmer is to
+;;; locally redefine `+', but to preserve the previous definition in
+;;; `a'.
+;;;
+;;; However, if the module is loaded twice, `a' will be bound not to the
+;;; `(guile)' binding of `+', but rather to `-'.  This is because each
+;;; module has a single global instance, and the first definition
+;;; already bound `+' to `-'.  Use-before-def analysis can detect this
+;;; situation as well.
 ;;;
 
-;; <toplevel-info> records are used during tree traversal in search of
+;;; <use-before-def-info> records are used during tree traversal in
-;; possibly unbound variable.  They contain a list of references to
+;;; search of possible uses of values before they are defined.  They
-;; potentially unbound top-level variables, and a list of the top-level
+;;; contain a list of references to top-level variables, and a list of
-;; defines that have been encountered.
+;;; the top-level definitions that have been encountered.  Any definition
-(define-record-type <toplevel-info>
+;;; which is a macro should in theory be expanded out already; if that's
-  (make-toplevel-info refs defs)
+;;; not the case, the program likely has a bug.
-  toplevel-info?
+(define-record-type <use-before-def-info>
-  (refs  toplevel-info-refs)  ;; ((VARIABLE-NAME . LOCATION) ...)
+  (make-use-before-def-info depth uses defs)
-  (defs  toplevel-info-defs)) ;; (VARIABLE-NAME ...)
+  use-before-def-info?
+  ;; LOCAL-DEF := #(MACRO? DEPTH LOCATION)
+  ;; DEF := LOCAL-DEF           ; Defined in compilation unit already at use.
+  ;;      | import              ; Def provided by imported module.
+  ;;      | unknown-module      ; Module at use site not known.
+  ;;      | unknown-declarative ; Defined, but def not within compilation unit.
+  ;;      | unknown-imperative  ; Same as above, but in non-declarative module.
+  ;;      | unbound             ; No top-level definition known at use
+  ;; USE := #(MOD-NAME VAR-NAME DEPTH DEF LOCATION)
+  (depth use-before-def-info-depth) ;; Zero if definitely evaluated
+  (uses  use-before-def-info-uses)  ;; List of USE
+  (defs  use-before-def-info-defs))  ;; Vhash of ((MOD . NAME) . LOCAL-DEF)
 
 (define (goops-toplevel-definition proc args env)
-  ;; If call of PROC to ARGS is a GOOPS top-level definition, return
+  ;; If call of PROC to ARGS is a GOOPS top-level definition, return the
-  ;; the name of the variable being defined; otherwise return #f.  This
+  ;; name of the variable being defined; otherwise return #f.  This
-  ;; assumes knowledge of the current implementation of `define-class' et al.
+  ;; assumes knowledge of the current implementation of `define-class'
-  (define (toplevel-define-arg args)
+  ;; et al.
-    (match args
+  (match (cons proc args)
-      ((($ <const> _ (and (? symbol?) exp)) _)
+    ((($ <module-ref> _ '(oop goops) 'toplevel-define! #f)
-       exp)
+      ($ <const> _ (? symbol? name))
-      (_ #f)))
+      exp)
-
+     ;; We don't know the precise module in which we are defining the
-  (match proc
+     ;; variable :/  Guess that it's in `env'.
-    (($ <module-ref> _ '(oop goops) 'toplevel-define! #f)
+     (vector (module-name env) name exp))
-     (toplevel-define-arg args))
+    ((($ <toplevel-ref> _ '(oop goops) 'toplevel-define!)
-    (($ <toplevel-ref> _ _ 'toplevel-define!)
+      ($ <const> _ (? symbol? name))
-     ;; This may be the result of expanding one of the GOOPS macros within
+      exp)
-     ;; `oop/goops.scm'.
+     (vector '(oop goops) name exp))
-     (and (eq? env (resolve-module '(oop goops)))
-          (toplevel-define-arg args)))
     (_ #f)))
 
-(define unbound-variable-analysis
+(define* (make-use-before-definition-analysis #:key (warning-level 0)
+                                              (enabled-warnings '()))
   ;; Report possibly unbound variables in the given tree.
-  (make-tree-analysis
+  (define (enabled-for-level? level) (<= level warning-level))
-   (lambda (x info env locs)
+  (define-syntax-rule (define-warning enabled
-     ;; Going down into X.
+                        #:level level #:name warning-name)
-     (let* ((refs (toplevel-info-refs info))
+    (define enabled
-            (defs (toplevel-info-defs info))
+      (or (enabled-for-level? level)
-            (src  (tree-il-src x)))
+          (memq 'warning-name enabled-warnings))))
-       (define (bound? name)
+  (define-warning use-before-definition-enabled
-         (or (and (module? env)
+    #:level 1 #:name use-before-definition)
-                  (module-variable env name))
+  (define-warning unbound-variable-enabled
-             (vhash-assq name defs)))
+    #:level 1 #:name unbound-variable)
+  (define-warning macro-use-before-definition-enabled
+    #:level 1 #:name macro-use-before-definition)
+  (define-warning non-idempotent-definition-enabled
+    #:level 1 #:name non-idempotent-definition)
+  (define (resolve mod name defs)
+    (match (vhash-assoc (cons mod name) defs)
+      ((_ . local-def)
+       ;; Top-level def present in this compilation unit, before this
+       ;; use.
+       local-def)
+      (#f
+       (let ((mod (and mod (resolve-module mod #f #:ensure #f))))
+         (cond
+          ((not mod)
+           ;; We don't know the module with respect to which this var
+           ;; is being resolved.
+           'unknown-module)
+          ((module-local-variable mod name)
+           ;; The variable is locally bound in the module, but not by
+           ;; any definition in the compilation unit; perhaps by load
+           ;; or load-extension or something.
+           (if (module-declarative? mod)
+               'unknown-declarative
+               'unknown-imperative))
+          ((module-variable mod name)
+           ;; The variable is an import.  At the time of use, the
+           ;; name is bound to the import.
+           'import)
+          (else
+           ;; Variable unbound in the module.
+           'unbound))))))
 
-       (record-case x
+  (and
-         ((<toplevel-ref> name src)
+   (or use-before-definition-enabled
-          (if (bound? name)
+       unbound-variable-enabled
-              info
+       macro-use-before-definition-enabled
-              (let ((src (or src (find pair? locs))))
+       non-idempotent-definition-enabled)
-                (make-toplevel-info (vhash-consq name src refs)
+   (make-tree-analysis
-                                    defs))))
+    (lambda (x info env locs)
-         ((<toplevel-set> name src)
+      ;; Going down into X.
-          (if (bound? name)
+      (define (make-use mod name depth def src)
-              (make-toplevel-info refs defs)
+        (vector mod name depth def src))
-              (let ((src (find pair? locs)))
+      (define (make-def is-macro? depth src)
-                (make-toplevel-info (vhash-consq name src refs)
+        (vector is-macro? depth src))
-                                    defs))))
+      (define (nearest-loc src)
-         ((<toplevel-define> name)
+        (or src (find pair? locs)))
-          (make-toplevel-info (vhash-delq name refs)
+      (define (add-use mod name src)
-                              (vhash-consq name #t defs)))
+        (match info
+          (($ <use-before-def-info> depth uses defs)
+           (let* ((def (resolve mod name defs))
+                  (use (make-use mod name depth def src)))
+             (make-use-before-def-info depth (cons use uses) defs)))))
+      (define (add-def mod name src is-macro?)
+        (match info
+          (($ <use-before-def-info> depth uses defs)
+           (let ((def (make-def is-macro? depth src)))
+             (make-use-before-def-info depth uses
+                                       (vhash-cons (cons mod name) def
+                                                   defs))))))
+      (define (macro? x)
+        (match x
+          (($ <primcall> _ 'make-syntax-transformer) #t)
+          (_ #f)))
+      (match x
+        (($ <toplevel-ref> src mod name)
+         (add-use mod name (nearest-loc src)))
+        (($ <toplevel-set> src mod name)
+         (add-use mod name (nearest-loc src)))
+        (($ <toplevel-define> src mod name exp)
+         (add-def mod name (nearest-loc src) (macro? exp)))
+        (($ <call> src proc args)
+         ;; Check for a dynamic top-level definition, as is
+         ;; done by code expanded from GOOPS macros.
+         (match (goops-toplevel-definition proc args env)
+           (#f info)
+           (#(mod name exp) (add-def mod name (nearest-loc src) (macro? exp)))))
+        ((or ($ <lambda>) ($ <conditional>))
+         (match info
+           (($ <use-before-def-info> depth uses defs)
+            (make-use-before-def-info (1+ depth) uses defs))))
+        (_ info)))
 
-         ((<call> proc args)
+    (lambda (x info env locs)
-          ;; Check for a dynamic top-level definition, as is
+      ;; Leaving X's scope.
-          ;; done by code expanded from GOOPS macros.
+      (match x
-          (let ((name (goops-toplevel-definition proc args
+        ((or ($ <lambda>) ($ <conditional>))
-                                                 env)))
+         (match info
-            (if (symbol? name)
+           (($ <use-before-def-info> depth uses defs)
-                (make-toplevel-info (vhash-delq name refs)
+            (make-use-before-def-info (1- depth) uses defs))))
-                                    (vhash-consq name #t defs))
+        (_ info)))
-                (make-toplevel-info refs defs))))
-         (else
-          (make-toplevel-info refs defs)))))
 
-   (lambda (x info env locs)
+    (lambda (info env)
-     ;; Leaving X's scope.
+      (define (compute-macros defs)
-     info)
+        (let ((macros (make-hash-table)))
+          (vlist-for-each (match-lambda
+                           ((mod+name . #(is-macro? depth src))
+                            (when is-macro?
+                              (hash-set! macros mod+name src))))
+                          defs)
+          macros))
+      ;; Post-process the result.
+      ;; FIXME: What to do with defs at nonzero depth?
+      (match info
+        (($ <use-before-def-info> 0 uses defs)
+         ;; The way the traversal works is that we only add entries to
+         ;; `defs' as we go, corresponding to local bindings.
+         ;; Therefore the result of `resolve' can only go from being an
+         ;; import, unbound, or top-level definition to being a
+         ;; definition within the compilation unit.  It can't go from
+         ;; e.g. being an import to being a top-level definition, for
+         ;; the purposes of our analysis, without the definition being
+         ;; local to the compilation unit.
+         (let ((macros (compute-macros defs))
+               (issued-unbound-warnings (make-hash-table)))
+           (for-each
+            (match-lambda
+             (#(mod name use-depth def-at-use use-loc)
+              (cond
+               ((and (hash-ref macros (cons mod name))
+                     macro-use-before-definition-enabled)
+                ;; Something bound to this name is a macro, probably
+                ;; later in the compilation unit.  Probably the author
+                ;; made a mistake somewhere!
+                (warning 'macro-use-before-definition use-loc name))
+               (else
+                (let ((def-at-end (resolve mod name defs)))
+                  (match (cons def-at-use def-at-end)
+                    (('import . 'import) #t)
+                    (('import . #(is-macro? def-depth def-loc))
+                     ;; At use, the binding was an import, but later
+                     ;; had a local definition.  Warn as this could
+                     ;; pose a hazard when reloading the module, as the
+                     ;; initial binding wouldn't come from the import.
+                     ;; If depth nonzero though, use might happen later
+                     ;; as it might be in a lambda, so no warning in
+                     ;; that case.
+                     (when (and non-idempotent-definition-enabled
+                                (zero? use-depth) (zero? def-depth))
+                       (warning 'non-idempotent-definition use-loc name)))
+                    (('unbound . 'unbound)
+                     ;; No binding at all; probably an error at
+                     ;; run-time, but we just warn at compile-time.
+                     (when unbound-variable-enabled
+                       (unless (hash-ref issued-unbound-warnings
+                                         (cons mod name))
+                         (hash-set! issued-unbound-warnings (cons mod name) #t)
+                         (warning 'unbound-variable use-loc name))))
+                    (('unbound . _)
+                     ;; If the depth at the use is 0, then the use
+                     ;; definitely occurs before the definition.
+                     (when (and use-before-definition-enabled
+                                (zero? use-depth))
+                       (warning 'use-before-definition use-loc name)))
+                    (('unknown-module . _)
+                     ;; Could issue a warning here that for whatever
+                     ;; reason, we weren't able to reason about what
+                     ;; module was current!
+                     #t)
+                    (('unknown-declarative . 'unknown-declarative)
+                     ;; FIXME: Probably we should emit a warning as in
+                     ;; a declarative module perhaps this should not
+                     ;; happen.
+                     #t)
+                    (('unknown-declarative . _)
+                     ;; Def later in compilation unit than use; no
+                     ;; problem.  Can occur when reloading declarative
+                     ;; modules.
+                     #t)
+                    (('unknown-imperative . _)
+                     ;; Def present and although not visible at the
+                     ;; use, don't warn as use module is
+                     ;; non-declarative.
+                     #t)
+                    (((? vector) . (? vector?))
+                     ;; Def locally bound at use; no problem.
+                     #t)))))))
+            (reverse uses))))))
 
-   (lambda (toplevel env)
+    (make-use-before-def-info 0 '() vlist-null))))
-     ;; Post-process the result.
-     (vlist-for-each (match-lambda
-                       ((name . loc)
-                        (warning 'unbound-variable loc name)))
-                     (vlist-reverse (toplevel-info-refs toplevel))))
-
-   (make-toplevel-info vlist-null vlist-null)))
-
-
-;;;
-;;; Macro use-before-definition analysis.
-;;;
-
-;; <macro-use-info> records are used during tree traversal in search of
-;; possibly uses of macros before they are defined.  They contain a list
-;; of references to top-level variables, and a list of the top-level
-;; macro definitions that have been encountered.  Any definition which
-;; is a macro should in theory be expanded out already; if that's not
-;; the case, the program likely has a bug.
-(define-record-type <macro-use-info>
-  (make-macro-use-info uses defs)
-  macro-use-info?
-  (uses  macro-use-info-uses)  ;; ((VARIABLE-NAME . LOCATION) ...)
-  (defs  macro-use-info-defs))  ;; ((VARIABLE-NAME . LOCATION) ...)
-
-(define macro-use-before-definition-analysis
-  ;; Report possibly unbound variables in the given tree.
-  (make-tree-analysis
-   (lambda (x info env locs)
-     ;; Going down into X.
-     (define (nearest-loc src)
-       (or src (find pair? locs)))
-     (define (add-use name src)
-       (match info
-         (($ <macro-use-info> uses defs)
-          (make-macro-use-info (vhash-consq name src uses) defs))))
-     (define (add-def name src)
-       (match info
-         (($ <macro-use-info> uses defs)
-          (make-macro-use-info uses (vhash-consq name src defs)))))
-     (define (macro? x)
-       (match x
-         (($ <primcall> _ 'make-syntax-transformer) #t)
-         (_ #f)))
-     (match x
-       (($ <toplevel-ref> src mod name)
-        (add-use name (nearest-loc src)))
-       (($ <toplevel-set> src mod name)
-        (add-use name (nearest-loc src)))
-       (($ <toplevel-define> src mod name (? macro?))
-        (add-def name (nearest-loc src)))
-       (_ info)))
-
-   (lambda (x info env locs)
-     ;; Leaving X's scope.
-     info)
-
-   (lambda (info env)
-     ;; Post-process the result.
-     (match info
-       (($ <macro-use-info> uses defs)
-        (vlist-for-each
-         (match-lambda
-           ((name . use-loc)
-            (when (vhash-assq name defs)
-              (warning 'macro-use-before-definition use-loc name))))
-         (vlist-reverse (macro-use-info-uses info))))))
-
-   (make-macro-use-info vlist-null vlist-null)))
 
 
 ;;;
@@ -1088,22 +1232,59 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME."
 
    #t))
 
-(define %warning-passes
+(begin-deprecated
-  `(#(unused-variable             3 ,unused-variable-analysis)
+ (define-syntax unbound-variable-analysis
-    #(unused-toplevel             2 ,unused-toplevel-analysis)
+   (identifier-syntax
-    #(shadowed-toplevel           2 ,shadowed-toplevel-analysis)
+    (begin
-    #(unbound-variable            1 ,unbound-variable-analysis)
+      (issue-deprecation-warning
-    #(macro-use-before-definition 1 ,macro-use-before-definition-analysis)
+       "`unbound-variable-analysis' is deprecated.  "
-    #(arity-mismatch              1 ,arity-analysis)
+       "Use `make-use-before-definition-analysis' instead.")
-    #(format                      1 ,format-analysis)))
+      (make-use-before-definition-analysis
+       #:enabled-warnings '(unbound-variable)))))
+ (define-syntax macro-use-before-definition-analysis
+   (identifier-syntax
+    (begin
+      (issue-deprecation-warning
+       "`macro-use-before-definition-analysis' is deprecated.  "
+       "Use `make-use-before-definition-analysis' instead.")
+      (make-use-before-definition-analysis
+       #:enabled-warnings '(macro-use-before-definition)))))
+ (export unbound-variable-analysis
+         macro-use-before-definition-analysis))
+
+(define-syntax-rule (define-analysis make-analysis
+                      #:level level #:kind kind #:analysis analysis)
+  (define* (make-analysis #:key (warning-level 0) (enabled-warnings '()))
+    (and (or (<= level warning-level)
+             (memq 'kind enabled-warnings))
+         analysis)))
+
+(define-analysis make-unused-variable-analysis
+  #: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-shadowed-toplevel-analysis
+  #:level 2 #:kind shadowed-toplevel #:analysis shadowed-toplevel-analysis)
+(define-analysis make-arity-analysis
+  #:level 1 #:kind arity-mismatch #:analysis arity-analysis)
+(define-analysis make-format-analysis
+  #:level 1 #:kind format #:analysis format-analysis)
 
 (define (make-analyzer warning-level warnings)
-  (define (enabled-for-level? level) (<= level warning-level))
+  (define-syntax compute-analyses
-  (let ((analyses (filter-map (match-lambda
+    (syntax-rules ()
-                               (#(kind level analysis)
+      ((_) '())
-                                (and (or (enabled-for-level? level)
+      ((_ make-analysis . make-analysis*)
-                                         (memq kind warnings))
+       (let ((tail (compute-analyses . make-analysis*)))
-                                     analysis)))
+         (match (make-analysis #:warning-level warning-level
-                              %warning-passes)))
+                               #:enabled-warnings warnings)
+           (#f tail)
+           (analysis (cons analysis tail)))))))
+  (let ((analyses (compute-analyses make-unused-variable-analysis
+                                    make-unused-toplevel-analysis
+                                    make-shadowed-toplevel-analysis
+                                    make-arity-analysis
+                                    make-format-analysis
+                                    make-use-before-definition-analysis)))
     (lambda (exp env)
       (analyze-tree analyses exp env))))

module/system/base/message.scm

@@ -1,6 +1,6 @@
 ;;; User interface messages
 
-;; Copyright (C) 2009-2012,2016,2018,2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012,2016,2018,2020-2021 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
@@ -127,6 +127,18 @@
                (emit port "~A: warning: macro `~A' used before definition~%"
                      loc name)))
 
+           (use-before-definition
+            "report uses of top-levels before they are defined"
+            ,(lambda (port loc name)
+               (emit port "~A: warning: `~A' used before definition~%"
+                     loc name)))
+
+           (non-idempotent-definition
+            "report names that can refer to imports on first load, but module definitions on second load"
+            ,(lambda (port loc name)
+               (emit port "~A: warning: non-idempotent binding for `~A'.  When first loaded, value for `~A` comes from imported binding, but later module-local definition overrides it; any module reload would capture module-local binding rather than import.~%"
+                     loc name name)))
+
            (arity-mismatch
             "report procedure arity mismatches (wrong number of arguments)"
             ,(lambda (port loc name certain?)

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-2020 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2014,2018-2021 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
@@ -202,6 +202,12 @@
 (define %opts-w-unbound
   '(#:warnings (unbound-variable)))
 
+(define %opts-w-use-before-definition
+  '(#:warnings (use-before-definition)))
+
+(define %opts-w-non-idempotent-definition
+  '(#:warnings (non-idempotent-definition)))
+
 (define %opts-w-arity
   '(#:warnings (arity-mismatch)))
 
@@ -551,6 +557,58 @@
                                         #:env m
                                         #:opts %opts-w-unbound))))))))
 
+   (with-test-prefix "use-before-definition"
+     (define-syntax-rule (pass-if-warnings expr pat test)
+       (pass-if 'expr
+         (match (call-with-warnings
+                 (lambda ()
+                   (compile 'expr #:to 'cps
+                            #:opts %opts-w-use-before-definition)))
+           (pat test)
+           (_ #f))))
+
+     (define-syntax-rule (pass-if-no-warnings expr)
+       (pass-if-warnings expr () #t))
+
+     (pass-if-no-warnings
+      (begin (define x +) x))
+     (pass-if-warnings
+      (begin x (define x +))
+      (w) (number? (string-contains w "`x' used before definition")))
+     (pass-if-warnings
+      (begin (set! x 1) (define x +))
+      (w) (number? (string-contains w "`x' used before definition")))
+     (pass-if-no-warnings
+      (begin (lambda () x) (define x +)))
+     (pass-if-no-warnings
+      (begin (if (defined? 'x) x) (define x +))))
+
+   (with-test-prefix "non-idempotent-definition"
+     (define-syntax-rule (pass-if-warnings expr pat test)
+       (pass-if 'expr
+         (match (call-with-warnings
+                 (lambda ()
+                   (compile 'expr #:to 'cps
+                            #:opts %opts-w-non-idempotent-definition)))
+           (pat test)
+           (_ #f))))
+
+     (define-syntax-rule (pass-if-no-warnings expr)
+       (pass-if-warnings expr () #t))
+
+     (pass-if-no-warnings
+      (begin (define - +) (define y -)))
+     (pass-if-warnings
+      (begin - (define - +))
+      (w) (number? (string-contains w "non-idempotent binding for `-'")))
+     (pass-if-warnings
+      (begin (define y -) (define - +))
+      (w) (number? (string-contains w "non-idempotent binding for `-'")))
+     (pass-if-no-warnings
+      (begin (lambda () -) (define - +)))
+     (pass-if-no-warnings
+      (begin (if (defined? '-) -) (define - +))))
+
    (with-test-prefix "arity mismatch"
 
      (pass-if "quiet"