From 731c8d3bc5a84515793e5dadb26adf52f9280e13 Mon Sep 17 00:00:00 2001 From: nineonine Date: Fri, 22 May 2020 00:41:55 -0700 Subject: Implement -Wredundant-bang-patterns (#17340) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. --- testsuite/tests/pmcheck/should_compile/T17340.hs | 54 ++++++++++++++++++++++ .../tests/pmcheck/should_compile/T17340.stderr | 48 +++++++++++++++++++ testsuite/tests/pmcheck/should_compile/all.T | 2 + 3 files changed, 104 insertions(+) create mode 100644 testsuite/tests/pmcheck/should_compile/T17340.hs create mode 100644 testsuite/tests/pmcheck/should_compile/T17340.stderr (limited to 'testsuite/tests') diff --git a/testsuite/tests/pmcheck/should_compile/T17340.hs b/testsuite/tests/pmcheck/should_compile/T17340.hs new file mode 100644 index 0000000000..fa2ef60812 --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T17340.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternSynonyms #-} +module T17340 where + +data A = A { a :: () } +data B = B +newtype C = C Int +pattern P = B + +f_nowarn :: Bool -> Bool +f_nowarn !x = x + +f :: Bool -> Bool +f True = False +f !x = x + +g :: (Int, Int) -> Bool -> () +g (a,b) True = () +g !x False = () + +data T = MkT !Int +h :: T -> () +h (MkT !x) = () + +k :: Bool -> Int +k True = 1 +k !_ = 2 -- clause is accessible, so warn for the bang + +t :: () -> Bool -> Int +t _ True = 1 +t !() True = 2 -- the clause has inaccessible RHS, warn for the bang +t _ False = 3 + +q :: Bool -> Int +q True = 1 +q !True = 2 -- clause is redundant, don't warn for the bang +q False = 3 + +i :: Bool -> Int +i True = 1 +i !x | x = 2 -- redundant + | not x = 3 -- accessible. This one will stay alive, so warn for the bang + +newtype T2 a = T2 a +w :: T2 a -> Bool -> () +w _ True = () +w (T2 _) True = () -- redundant +w !_ True = () -- inaccessible +w _ _ = () + +z :: T2 a -> Bool -> () +z _ True = () +z t2 !x | T2 _ <- t2, x = () -- redundant + | !_ <- t2, x = () -- inaccessable diff --git a/testsuite/tests/pmcheck/should_compile/T17340.stderr b/testsuite/tests/pmcheck/should_compile/T17340.stderr new file mode 100644 index 0000000000..c31fb2a6f5 --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T17340.stderr @@ -0,0 +1,48 @@ + +T17340.hs:15:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘f’: f x = ... + +T17340.hs:19:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘g’: g x = ... + +T17340.hs:27:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘k’: k _ = ... + +T17340.hs:31:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘t’: t !() True = ... + +T17340.hs:36:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘q’: q !True = ... + +T17340.hs:41:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘i’: i x = ... + +T17340.hs:41:8: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘i’: i !x | x = ... + +T17340.hs:47:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘w’: w (T2 _) True = ... + +T17340.hs:48:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘w’: w !_ True = ... + +T17340.hs:53:7: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘z’: z x = ... + +T17340.hs:53:11: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘z’: z t2 !x | T2 _ <- t2, x = ... + +T17340.hs:54:11: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘z’: z t2 !x | !_ <- t2, x = ... diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T index 054ad82873..51fb76b078 100644 --- a/testsuite/tests/pmcheck/should_compile/all.T +++ b/testsuite/tests/pmcheck/should_compile/all.T @@ -124,6 +124,8 @@ test('T18478', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18533', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17340', normal, compile, + ['-Wredundant-bang-patterns']) # Other tests test('pmc001', [], compile, -- cgit v1.2.1