[commit: ghc] master: Don't warn about variable-free strict pattern bindings (549c8b3)
git at git.haskell.org
git at git.haskell.org
Tue May 9 09:44:28 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/549c8b33da25371ab1aa1818ef27fc418252e667/ghc
>---------------------------------------------------------------
commit 549c8b33da25371ab1aa1818ef27fc418252e667
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon May 8 14:04:34 2017 +0100
Don't warn about variable-free strict pattern bindings
See Trac #13646 and the new
Note [Pattern bindings that bind no variables]
>---------------------------------------------------------------
549c8b33da25371ab1aa1818ef27fc418252e667
compiler/rename/RnBinds.hs | 48 +++++++++++++++-------
docs/users_guide/using-warnings.rst | 10 +++--
testsuite/tests/rename/should_compile/T13646.hs | 15 +++++++
.../tests/rename/should_compile/T13646.stderr | 3 ++
testsuite/tests/rename/should_compile/all.T | 1 +
5 files changed, 58 insertions(+), 19 deletions(-)
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index d78ed93..0b4cbeb 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 ed2b12b..6a42f54 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 0000000..d2d8279
--- /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 0000000..ad23c44
--- /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 f6b71fd..e7ad719 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -150,3 +150,4 @@ test('T12533', normal, compile, [''])
test('T12597', normal, compile, [''])
test('T12548', normal, compile, [''])
test('T13132', normal, compile, [''])
+test('T13646', normal, compile, [''])
More information about the ghc-commits
mailing list