[Git][ghc/ghc][master] -Wunused-pattern-binds: Recurse into patterns to check whether there's a splice
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Sep 17 01:42:28 UTC 2022
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
383f7549 by Matthew Pickering at 2022-09-16T21:42:10-04:00
-Wunused-pattern-binds: Recurse into patterns to check whether there's a splice
See the examples in #22057 which show we have to traverse deeply into a
pattern to determine whether it contains a splice or not. The original
implementation pointed this out but deemed this very shallow traversal
"too expensive".
Fixes #22057
I also fixed an oversight in !7821 which meant we lost a warning which
was present in 9.2.2.
Fixes #22067
- - - - -
5 changed files:
- compiler/GHC/Rename/Bind.hs
- + testsuite/tests/rename/should_compile/T22057.hs
- + testsuite/tests/rename/should_compile/T22067.hs
- + testsuite/tests/rename/should_compile/T22067.stderr
- testsuite/tests/rename/should_compile/all.T
Changes:
=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -493,18 +493,10 @@ rnBind _ bind@(PatBind { pat_lhs = pat
bind' = bind { pat_rhs = grhss'
, pat_ext = fvs' }
- ok_nobind_pat
- = -- See Note [Pattern bindings that bind no variables]
- case unLoc pat of
- WildPat {} -> True
- BangPat {} -> True -- #9127, #13646
- SplicePat {} -> True
- _ -> False
-
-- Warn if the pattern binds no variables
-- See Note [Pattern bindings that bind no variables]
; whenWOptM Opt_WarnUnusedPatternBinds $
- when (null bndrs && not ok_nobind_pat) $
+ when (null bndrs && not (isOkNoBindPattern pat)) $
addTcRnDiagnostic (TcRnUnusedPatternBinds bind')
; fvs' `seq` -- See Note [Free-variable space leak]
@@ -540,29 +532,66 @@ rnBind sig_fn (PatSynBind x bind)
rnBind _ b = pprPanic "rnBind" (ppr b)
+ -- See Note [Pattern bindings that bind no variables]
+isOkNoBindPattern :: LPat GhcRn -> Bool
+isOkNoBindPattern (L _ pat) =
+ case pat of
+ WildPat{} -> True -- Exception (1)
+ BangPat {} -> True -- Exception (2) #9127, #13646
+ p -> patternContainsSplice p -- Exception (3)
+
+ where
+ lpatternContainsSplice :: LPat GhcRn -> Bool
+ lpatternContainsSplice (L _ p) = patternContainsSplice p
+ patternContainsSplice :: Pat GhcRn -> Bool
+ patternContainsSplice p =
+ case p of
+ -- A top-level splice has been evaluated by this point, so we know the pattern it is evaluated to
+ SplicePat (HsUntypedSpliceTop _ p) _ -> patternContainsSplice p
+ -- A nested splice isn't evaluated so we can't guess what it will expand to
+ SplicePat (HsUntypedSpliceNested {}) _ -> True
+ -- The base cases
+ VarPat {} -> False
+ WildPat {} -> False
+ LitPat {} -> False
+ NPat {} -> False
+ NPlusKPat {} -> False
+ -- Recursive cases
+ BangPat _ lp -> lpatternContainsSplice lp
+ LazyPat _ lp -> lpatternContainsSplice lp
+ AsPat _ _ _ lp -> lpatternContainsSplice lp
+ ParPat _ _ lp _ -> lpatternContainsSplice lp
+ ViewPat _ _ lp -> lpatternContainsSplice lp
+ SigPat _ lp _ -> lpatternContainsSplice lp
+ ListPat _ lps -> any lpatternContainsSplice lps
+ TuplePat _ lps _ -> any lpatternContainsSplice lps
+ SumPat _ lp _ _ -> lpatternContainsSplice lp
+ ConPat _ _ cpd -> any lpatternContainsSplice (hsConPatArgs cpd)
+ XPat (HsPatExpanded _orig new) -> patternContainsSplice new
+
{- 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 three exceptions:
-* A wildcard pattern
+(1) 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 pattern binding; that is, one with an outermost bang
+(2) A strict pattern 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, #13646 argues that even for single constructor
types, you might want to write the constructor. See also #9127.
-* A splice pattern
+(3) A splice pattern
$(th-lhs) = rhs
It is impossible to determine whether or not th-lhs really
- binds any variable. We should disable the warning for any pattern
- which contain splices, but that is a more expensive check.
+ binds any variable. You have to recurse all the way into the pattern to check
+ it doesn't contain any splices like this. See #22057.
Note [Free-variable space leak]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
testsuite/tests/rename/should_compile/T22057.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# OPTIONS -Wall #-}
+module Thing (thing) where
+
+import Language.Haskell.TH
+
+thing :: Q ()
+thing = do
+ name <- newName "x"
+ -- warning:
+ _ <- [| let ($(pure (VarP name)), _) = (3.0, 4.0) in $(pure (VarE name)) |]
+ -- warning:
+ _ <- [| let ($(pure (VarP name)) ) = 3.0 in $(pure (VarE name)) |]
+ -- no warning:
+ _ <- [| let $(pure (VarP name)) = 3.0 in $(pure (VarE name)) |]
+ return ()
=====================================
testsuite/tests/rename/should_compile/T22067.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TTT where
+
+a :: ()
+a = let () = () in ()
+
+b :: ()
+b = let $([p|()|]) = () in ()
+
=====================================
testsuite/tests/rename/should_compile/T22067.stderr
=====================================
@@ -0,0 +1,6 @@
+
+T22067.hs:5:9: warning: [GHC-61367] [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)]
+ This pattern-binding binds no variables: () = ()
+
+T22067.hs:8:9: warning: [GHC-61367] [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)]
+ This pattern-binding binds no variables: (()) = ()
=====================================
testsuite/tests/rename/should_compile/all.T
=====================================
@@ -188,3 +188,5 @@ test('T18862', normal, compile, [''])
test('unused_haddock', normal, compile, ['-haddock -Wall'])
test('T19984', normal, compile, ['-fwarn-unticked-promoted-constructors'])
test('T21654', normal, compile, ['-Wunused-top-binds'])
+test('T22057', normal, compile, ['-Wall'])
+test('T22067', normal, compile, ['-Wall'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/383f75494a936bbc2f794a788141b103cd482913
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/383f75494a936bbc2f794a788141b103cd482913
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220916/1f3f80b5/attachment-0001.html>
More information about the ghc-commits
mailing list