driver: split -fwarn-unused-binds into 3 flags (fixes #17)

Summary: New flags:

 -fwarn-unused-top-binds
 -fwarn-unused-local-binds
 -fwarn-unused-pattern-binds

Test Plan: `tests/rename/should_compile/T17` tests

Correct other tests

Reviewers: austin, rwbarton

Reviewed By: austin, rwbarton

Subscribers: rwbarton, carter, thomie

Differential Revision: https://phabricator.haskell.org/D591

GHC Trac Issues: #17

18 files changed, 218 insertions, 31 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index de768c0315..6d6670cb32 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -488,7 +488,9 @@ data WarningFlag =
    | Opt_WarnOverlappingPatterns
    | Opt_WarnTypeDefaults
    | Opt_WarnMonomorphism
-   | Opt_WarnUnusedBinds
+   | Opt_WarnUnusedTopBinds
+   | Opt_WarnUnusedLocalBinds
+   | Opt_WarnUnusedPatternBinds
    | Opt_WarnUnusedImports
    | Opt_WarnUnusedMatches
    | Opt_WarnContextQuantification
@@ -2676,6 +2678,8 @@ dynamic_flags = [
   , defFlag "fno-glasgow-exts"
       (NoArg (do disableGlasgowExts
                  deprecate "Use individual extensions instead"))
+  , defFlag "fwarn-unused-binds" (NoArg enableUnusedBinds)
+  , defFlag "fno-warn-unused-binds" (NoArg disableUnusedBinds)
 
         ------ Safe Haskell flags -------------------------------------------
   , defFlag "fpackage-trust"   (NoArg setPackageTrust)
@@ -2883,10 +2887,12 @@ fWarningFlags = [
   flagSpec "warn-unsupported-llvm-version"    Opt_WarnUnsupportedLlvmVersion,
   flagSpec "warn-unticked-promoted-constructors"
                                          Opt_WarnUntickedPromotedConstructors,
-  flagSpec "warn-unused-binds"                Opt_WarnUnusedBinds,
   flagSpec "warn-unused-do-bind"              Opt_WarnUnusedDoBind,
   flagSpec "warn-unused-imports"              Opt_WarnUnusedImports,
+  flagSpec "warn-unused-local-binds"          Opt_WarnUnusedLocalBinds,
   flagSpec "warn-unused-matches"              Opt_WarnUnusedMatches,
+  flagSpec "warn-unused-pattern-binds"        Opt_WarnUnusedPatternBinds,
+  flagSpec "warn-unused-top-binds"            Opt_WarnUnusedTopBinds,
   flagSpec "warn-warnings-deprecations"       Opt_WarnWarningsDeprecations,
   flagSpec "warn-wrong-do-bind"               Opt_WarnWrongDoBind]
 
@@ -3359,7 +3365,9 @@ minusWOpts :: [WarningFlag]
 -- Things you get with -W
 minusWOpts
     = standardWarnings ++
-      [ Opt_WarnUnusedBinds,
+      [ Opt_WarnUnusedTopBinds,
+        Opt_WarnUnusedLocalBinds,
+        Opt_WarnUnusedPatternBinds,
         Opt_WarnUnusedMatches,
         Opt_WarnUnusedImports,
         Opt_WarnIncompletePatterns,
@@ -3381,6 +3389,19 @@ minusWallOpts
         Opt_WarnUntickedPromotedConstructors
       ]
 
+enableUnusedBinds :: DynP ()
+enableUnusedBinds = mapM_ setWarningFlag unusedBindsFlags
+
+disableUnusedBinds :: DynP ()
+disableUnusedBinds = mapM_ unSetWarningFlag unusedBindsFlags
+
+-- Things you get with -fwarn-unused-binds
+unusedBindsFlags :: [WarningFlag]
+unusedBindsFlags = [ Opt_WarnUnusedTopBinds
+                   , Opt_WarnUnusedLocalBinds
+                   , Opt_WarnUnusedPatternBinds
+                   ]
+
 enableGlasgowExts :: DynP ()
 enableGlasgowExts = do setGeneralFlag Opt_PrintExplicitForalls
                        mapM_ setExtensionFlag glasgowExtsFlags
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 70c61f2215..ff588e1276 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -168,10 +168,10 @@ runStmtWithLocation source linenumber expr step =
     breakMVar  <- liftIO $ newEmptyMVar  -- wait on this when we hit a breakpoint
     statusMVar <- liftIO $ newEmptyMVar  -- wait on this when a computation is running
 
-    -- Turn off -fwarn-unused-bindings when running a statement, to hide
+    -- Turn off -fwarn-unused-local-binds when running a statement, to hide
     -- warnings about the implicit bindings we introduce.
     let ic       = hsc_IC hsc_env -- use the interactive dflags
-        idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedBinds
+        idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedLocalBinds
         hsc_env' = hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } }
 
     -- compile to value (IO [HValue]), don't run
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index 89f8a14e6e..beda054423 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -497,7 +497,7 @@ rnBind _ bind@(PatBind { pat_lhs = pat
         -- which (a) is not that different from  _v = rhs
         --       (b) is sometimes used to give a type sig for,
         --           or an occurrence of, a variable on the RHS
-        ; whenWOptM Opt_WarnUnusedBinds $
+        ; whenWOptM Opt_WarnUnusedPatternBinds $
           when (null bndrs && not is_wild_pat) $
           addWarn $ unusedPatBindWarn bind'
 
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 580f0b9d3d..d9d471ace3 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -1734,7 +1734,7 @@ mapFvRnCPS f (x:xs) cont = f x             $ \ x' ->
 
 warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
 warnUnusedTopBinds gres
-    = whenWOptM Opt_WarnUnusedBinds
+    = whenWOptM Opt_WarnUnusedTopBinds
     $ do env <- getGblEnv
          let isBoot = tcg_src env == HsBootFile
          let noParent gre = case gre_par gre of
@@ -1751,7 +1751,7 @@ warnUnusedTopBinds gres
          warnUnusedGREs gres'
 
 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> FreeVars -> RnM ()
-warnUnusedLocalBinds = check_unused Opt_WarnUnusedBinds
+warnUnusedLocalBinds = check_unused Opt_WarnUnusedLocalBinds
 warnUnusedMatches    = check_unused Opt_WarnUnusedMatches
 
 check_unused :: WarningFlag -> [Name] -> FreeVars -> RnM ()
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 98c09bf322..3d90479adf 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -1578,12 +1578,36 @@
 
           <row>
             <entry><option>-fwarn-unused-binds</option></entry>
-            <entry>warn about bindings that are unused</entry>
+            <entry>warn about bindings that are unused.
+               Alias for <option>-fwarn-unused-top-binds</option>,
+               <option>-fwarn-unused-local-binds</option> and
+               <option>-fwarn-unused-pattern-binds</option></entry>
             <entry>dynamic</entry>
             <entry><option>-fno-warn-unused-binds</option></entry>
           </row>
 
           <row>
+            <entry><option>-fwarn-unused-top-binds</option></entry>
+            <entry>warn about top-level bindings that are unused</entry>
+            <entry>dynamic</entry>
+            <entry><option>-fno-warn-unused-top-binds</option></entry>
+          </row>
+
+          <row>
+            <entry><option>-fwarn-unused-local-binds</option></entry>
+            <entry>warn about local bindings that are unused</entry>
+            <entry>dynamic</entry>
+            <entry><option>-fno-warn-unused-local-binds</option></entry>
+          </row>
+
+          <row>
+            <entry><option>-fwarn-unused-pattern-binds</option></entry>
+            <entry>warn about pattern match bindings that are unused</entry>
+            <entry>dynamic</entry>
+            <entry><option>-fno-warn-unused-pattern-binds</option></entry>
+          </row>
+
+          <row>
             <entry><option>-fwarn-unused-imports</option></entry>
             <entry>warn about unnecessary imports</entry>
             <entry>dynamic</entry>
diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml
index 1940e7abc4..19839cf6fb 100644
--- a/docs/users_guide/using.xml
+++ b/docs/users_guide/using.xml
@@ -1872,33 +1872,71 @@ data Vec n s where
           <indexterm><primary><option>-fwarn-unused-binds</option></primary></indexterm>
           <indexterm><primary>unused binds, warning</primary></indexterm>
           <indexterm><primary>binds, unused</primary></indexterm>
-          <para>Report any function definitions (and local bindings)
-          which are unused.  More precisely:
+          <para>Report any function definitions (and local bindings) which are unused. An alias for
+            <itemizedlist>
+              <listitem><option>-fwarn-unused-top-binds</option></listitem>
+              <listitem><option>-fwarn-unused-local-binds</option></listitem>
+              <listitem><option>-fwarn-unused-pattern-binds</option></listitem>
+            </itemizedlist>
+          </para>
+        </listitem>
+      </varlistentry>
 
-          <itemizedlist>
-          <listitem><para>Warn if a binding brings into scope a variable that is not used,
+      <varlistentry>
+        <term><option>-fwarn-unused-top-binds</option>:</term>
+        <listitem>
+          <indexterm><primary><option>-fwarn-unused-top-binds</option></primary></indexterm>
+          <indexterm><primary>unused binds, warning</primary></indexterm>
+          <indexterm><primary>binds, unused</primary></indexterm>
+          <para>Report any function definitions which are unused.</para>
+
+          <para>More precisely, warn if a binding brings into scope a variable that is not used,
           except if the variable's name starts with an underscore.  The "starts-with-underscore"
           condition provides a way to selectively disable the warning.
-        </para>
+          </para>
           <para>
-          A variable is regarded as "used" if 
+          A variable is regarded as "used" if
           <itemizedlist>
           <listitem><para>It is exported, or</para></listitem>
-          <listitem><para>It appears in the right hand side of a binding that binds at 
+          <listitem><para>It appears in the right hand side of a binding that binds at
                            least one used variable that is used</para></listitem>
           </itemizedlist>
           For example
             <programlisting>
 module A (f) where
-f = let (p,q) = rhs1 in t p  -- Warning about unused q
+f = let (p,q) = rhs1 in t p  -- No warning: q is unused, but is locally bound
 t = rhs3                     -- No warning: f is used, and hence so is t
 g = h x                      -- Warning: g unused
 h = rhs2                     -- Warning: h is only used in the right-hand side of another unused binding
 _w = True                    -- No warning: _w starts with an underscore
             </programlisting>
-          </para></listitem>
+          </para>
+        </listitem>
+      </varlistentry>
 
-          <listitem><para>
+      <varlistentry>
+        <term><option>-fwarn-unused-local-binds</option>:</term>
+        <listitem>
+          <indexterm><primary><option>-fwarn-unused-local-binds</option></primary></indexterm>
+          <indexterm><primary>unused binds, warning</primary></indexterm>
+          <indexterm><primary>binds, unused</primary></indexterm>
+          <para>Report any local definitions which are unused. For example
+            <programlisting>
+module A (f) where
+f = let (p,q) = rhs1 in t p  -- Warning: q is unused
+g = h x                      -- No warning: g is unused, but is a top-level binding
+            </programlisting>
+          </para>
+        </listitem>
+      </varlistentry>
+
+      <varlistentry>
+        <term><option>-fwarn-unused-pattern-binds</option>:</term>
+        <listitem>
+          <indexterm><primary><option>-fwarn-unused-pattern-binds</option></primary></indexterm>
+          <indexterm><primary>unused binds, warning</primary></indexterm>
+          <indexterm><primary>binds, unused</primary></indexterm>
+          <para>
           Warn if a pattern binding binds no variables at all, unless it is a lone, possibly-banged, wild-card pattern.
           For example:
             <programlisting>
@@ -1911,13 +1949,10 @@ _  = rhs3        -- No warning: lone wild-card pattern
           are not very different from <literal>_v = rhs3</literal>,
           which elicits no warning; and they can be useful to add a type
           constraint, e.g. <literal>_ = x::Int</literal>. A lone
-          banged wild-card pattern is is useful as an alternative 
+          banged wild-card pattern is useful as an alternative
           (to <literal>seq</literal>) way to force evaluation.
         </para>
         </listitem>
-          </itemizedlist>
-          </para>
-        </listitem>
       </varlistentry>
 
       <varlistentry>
diff --git a/testsuite/tests/rename/should_compile/T17a.hs b/testsuite/tests/rename/should_compile/T17a.hs
new file mode 100644
index 0000000000..a58a766340
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17a.hs
@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -fwarn-unused-top-binds #-}
+
+-- Trac #17
+
+module Temp (foo, bar, quux) where
+
+top :: Int
+top = 1
+
+foo :: ()
+foo = let True = True in ()
+
+bar :: Int -> Int
+bar match = 1
+
+quux :: Int
+quux = let local = True
+       in 2
diff --git a/testsuite/tests/rename/should_compile/T17a.stderr b/testsuite/tests/rename/should_compile/T17a.stderr
new file mode 100644
index 0000000000..308cabe23c
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17a.stderr
@@ -0,0 +1 @@
+ T17a.hs:8:1: Warning: Defined but not used: ‘top’ 
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T17b.hs b/testsuite/tests/rename/should_compile/T17b.hs
new file mode 100644
index 0000000000..7946f16deb
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17b.hs
@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -fwarn-unused-local-binds #-}
+
+-- Trac #17
+
+module Temp (foo, bar, quux) where
+
+top :: Int
+top = 1
+
+foo :: ()
+foo = let True = True in ()
+
+bar :: Int -> Int
+bar match = 1
+
+quux :: Int
+quux = let local = True
+       in 2
diff --git a/testsuite/tests/rename/should_compile/T17b.stderr b/testsuite/tests/rename/should_compile/T17b.stderr
new file mode 100644
index 0000000000..3291264463
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17b.stderr
@@ -0,0 +1 @@
+ T17b.hs:17:12: Warning: Defined but not used: ‘local’ 
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T17c.hs b/testsuite/tests/rename/should_compile/T17c.hs
new file mode 100644
index 0000000000..091524c95a
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17c.hs
@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -fwarn-unused-pattern-binds #-}
+
+-- Trac #17
+
+module Temp (foo, bar, quux) where
+
+top :: Int
+top = 1
+
+foo :: ()
+foo = let True = True in ()
+
+bar :: Int -> Int
+bar match = 1
+
+quux :: Int
+quux = let local = True
+       in 2
diff --git a/testsuite/tests/rename/should_compile/T17c.stderr b/testsuite/tests/rename/should_compile/T17c.stderr
new file mode 100644
index 0000000000..bfab9f83da
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17c.stderr
@@ -0,0 +1 @@
+ T17c.hs:11:11: Warning: This pattern-binding binds no variables: True = True 
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T17d.hs b/testsuite/tests/rename/should_compile/T17d.hs
new file mode 100644
index 0000000000..1a4b44d717
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17d.hs
@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -fwarn-unused-matches #-}
+
+-- Trac #17
+
+module Temp (foo, bar, quux) where
+
+top :: Int
+top = 1
+
+foo :: ()
+foo = let True = True in ()
+
+bar :: Int -> Int
+bar match = 1
+
+quux :: Int
+quux = let local = True
+       in 2
diff --git a/testsuite/tests/rename/should_compile/T17d.stderr b/testsuite/tests/rename/should_compile/T17d.stderr
new file mode 100644
index 0000000000..babe6b780e
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17d.stderr
@@ -0,0 +1 @@
+ T17d.hs:14:5: Warning: Defined but not used: ‘match’ 
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T17e.hs b/testsuite/tests/rename/should_compile/T17e.hs
new file mode 100644
index 0000000000..93ed1f7344
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17e.hs
@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -fwarn-unused-binds #-}
+
+-- Trac #17
+
+module Temp (foo, bar, quux) where
+
+top :: Int
+top = 1
+
+foo :: ()
+foo = let True = True in ()
+
+bar :: Int -> Int
+bar match = 1
+
+quux :: Int
+quux = let local = True
+       in 2
diff --git a/testsuite/tests/rename/should_compile/T17e.stderr b/testsuite/tests/rename/should_compile/T17e.stderr
new file mode 100644
index 0000000000..48f28b8db4
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17e.stderr
@@ -0,0 +1,7 @@
+
+T17e.hs:8:1: Warning: Defined but not used: ‘top’
+
+T17e.hs:11:11: Warning:
+    This pattern-binding binds no variables: True = True
+
+T17e.hs:17:12: Warning: Defined but not used: ‘local’
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 9265f18a61..0747f98ced 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -112,6 +112,12 @@ test('rn067',
 
 test('rn068', normal, compile, [''])
 
+test('T17a', normal, compile, [''])
+test('T17b', normal, compile, [''])
+test('T17c', normal, compile, [''])
+test('T17d', normal, compile, [''])
+test('T17e', normal, compile, [''])
+
 test('T1972', normal, compile, [''])
 test('T2205', normal, compile, [''])
 
diff --git a/testsuite/tests/rename/should_compile/rn040.hs b/testsuite/tests/rename/should_compile/rn040.hs
index 3b418f5c2f..3a74abe3fd 100644
--- a/testsuite/tests/rename/should_compile/rn040.hs
+++ b/testsuite/tests/rename/should_compile/rn040.hs
@@ -1,8 +1,8 @@
-{-# OPTIONS -fwarn-unused-binds #-}

-module ShouldCompile where

-

--- !!! should produce warnings about unused identifers

-x :: [()]

-x = [ () | y <- [] ]

-

-z = do w <- getContents; return ()

+{-# OPTIONS -fwarn-unused-binds #-}
+module ShouldCompile where
+
+-- !!! should produce warnings about unused identifers
+x :: [()]
+x = [ () | y <- [] ]
+
+z = do w <- getContents; return ()