Don't warn about variable-free strict pattern bindings

See Trac #13646 and the new
Note [Pattern bindings that bind no variables]

5 files changed, 59 insertions, 20 deletions

diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index d78ed93d2e..0b4cbeb276 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -456,21 +456,22 @@ rnBind _ bind@(PatBind { pat_lhs = pat
                 -- As well as dependency analysis, we need these for the
                 -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
               bndrs = collectPatBinders pat
-              bind' = bind { pat_rhs  = grhss',
-                             pat_rhs_ty = placeHolderType, bind_fvs = fvs' }
-              is_wild_pat = case pat of
-                              L _ (WildPat {})                 -> True
-                              L _ (BangPat (L _ (WildPat {}))) -> True -- #9127
-                              _                                -> False
-
-        -- Warn if the pattern binds no variables, except for the
-        -- entirely-explicit idiom    _ = rhs
-        -- 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
+              bind' = bind { pat_rhs  = grhss'
+                           , pat_rhs_ty = placeHolderType, bind_fvs = fvs' }
+
+              ok_nobind_pat
+                  = -- See Note [Pattern bindings that bind no variables]
+                    case pat of
+                       L _ (WildPat {}) -> True
+                       L _ (BangPat {}) -> True -- #9127, #13646
+                       _                -> False
+
+        -- Warn if the pattern binds no variables
+        -- See Note [Pattern bindings that bind no variables]
         ; whenWOptM Opt_WarnUnusedPatternBinds $
-          when (null bndrs && not is_wild_pat) $
-          addWarn (Reason Opt_WarnUnusedPatternBinds) $ unusedPatBindWarn bind'
+          when (null bndrs && not ok_nobind_pat) $
+          addWarn (Reason Opt_WarnUnusedPatternBinds) $
+          unusedPatBindWarn bind'
 
         ; fvs' `seq` -- See Note [Free-variable space leak]
           return (bind', bndrs, all_fvs) }
@@ -505,7 +506,24 @@ rnBind sig_fn (PatSynBind bind)
 
 rnBind _ b = pprPanic "rnBind" (ppr b)
 
-{-
+{- Note [Pattern bindings that bind no variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Generally, we want to warn about pattern bindings like
+  Just _ = e
+because they don't do anything!  But we have two exceptions:
+
+* A wildcard pattern
+       _ = rhs
+  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
+
+* A strict patten binding; that is, one with an outermost bang
+     !Just _ = e
+  This can fail, so unlike the lazy variant, it is not a no-op.
+  Moreover, Trac #13646 argues that even for single constructor
+  types, you might want to write the constructor.  See also #9127.
+
 Note [Free-variable space leak]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We have
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index ed2b12b84c..6a42f548d4 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -902,18 +902,20 @@ of ``-W(no-)*``.
        single: binds, unused
 
     Warn if a pattern binding binds no variables at all, unless it is a
-    lone, possibly-banged, wild-card pattern. For example: ::
+    lone wild-card pattern, or a banged pattern. For example: ::
 
         Just _ = rhs3    -- Warning: unused pattern binding
         (_, _) = rhs4    -- Warning: unused pattern binding
         _  = rhs3        -- No warning: lone wild-card pattern
-        !_ = rhs4        -- No warning: banged wild-card pattern; behaves like seq
+        !() = rhs4       -- No warning: banged pattern; behaves like seq
 
+    In general a lazy pattern binding `p = e` is a no-op if `p` does not
+    bind any variables.
     The motivation for allowing lone wild-card patterns is they are not
     very different from ``_v = rhs3``, which elicits no warning; and
     they can be useful to add a type constraint, e.g. ``_ = x::Int``. A
-    lone banged wild-card pattern is useful as an alternative (to
-    ``seq``) way to force evaluation.
+    banged pattern (see :ref:`bang-patterns`) is *not* a no-op, because
+    it forces evaluation, and is useful as an alternative to ``seq``.
 
 .. ghc-flag:: -Wunused-imports
 
diff --git a/testsuite/tests/rename/should_compile/T13646.hs b/testsuite/tests/rename/should_compile/T13646.hs
new file mode 100644
index 0000000000..d2d82797ae
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T13646.hs
@@ -0,0 +1,15 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE BangPatterns #-}
+
+module T13646 where
+
+import Control.Exception
+
+foo :: IO ()
+foo = do let !() = assert False ()
+             -- Should not give a warning
+
+         let () = assert False ()
+             -- Should give a warning
+
+         pure ()
diff --git a/testsuite/tests/rename/should_compile/T13646.stderr b/testsuite/tests/rename/should_compile/T13646.stderr
new file mode 100644
index 0000000000..ad23c444c9
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T13646.stderr
@@ -0,0 +1,3 @@
+
+T13646.hs:12:14: warning: [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)]
+    This pattern-binding binds no variables: () = assert False ()
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index f6b71fda3b..e7ad719278 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -27,7 +27,7 @@ test('rn034', normal, compile, [''])
 test('rn035', normal, compile, [''])
 test('rn036', normal, compile, [''])
 test('rn037', normal, compile, [''])
-	
+
 # Missing:
 # test('rn038', normal, compile, [''])
 
@@ -150,3 +150,4 @@ test('T12533', normal, compile, [''])
 test('T12597', normal, compile, [''])
 test('T12548', normal, compile, [''])
 test('T13132', normal, compile, [''])
+test('T13646', normal, compile, [''])