Pmc: Implement `considerAccessible` (#18610)

Consider (`T18610`):
```hs
  f :: Bool -> Int
  f x = case (x, x) of
    (True,  True)  -> 1
    (False, False) -> 2
    (True,  False) -> 3 -- Warning: Redundant
```
The third clause will be flagged as redundant. Nevertheless, the
programmer might intend to keep the clause in order to avoid bitrot.

After this patch, the programmer can write
```hs
  g :: Bool -> Int
  g x = case (x, x) of
    (True,  True)  -> 1
    (False, False) -> 2
    (True,  False) | GHC.Exts.considerAccessible -> 3 -- No warning
```
And won't be bothered any longer. See also `Note [considerAccessible]`
and the updated entries in the user's guide.

Fixes #18610 and #19228.

3 files changed, 85 insertions, 0 deletions

diff --git a/testsuite/tests/pmcheck/should_compile/T18610.hs b/testsuite/tests/pmcheck/should_compile/T18610.hs
new file mode 100644
index 0000000000..fbde93138e
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T18610.hs
@@ -0,0 +1,66 @@
+{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE BangPatterns #-}
+
+module T18610 where
+
+import GHC.Exts
+import Data.Type.Equality
+
+f :: Bool -> Int
+f x = case (x, x) of
+  (True,  True)  -> 1
+  (False, False) -> 2
+  (True,  False) -> 3 -- Warning: redundant
+
+g :: Bool -> Int
+g x = case (x, x) of
+  (True,  True)  -> 1
+  (False, False) -> 2
+  (True,  False) | considerAccessible -> 3 -- No warning!
+
+h :: Bool -> Int
+h x = case (x, x) of
+  (True,  True)  -> 1
+  (False, False) -> 2
+  (True,  False) | considerAccessible, False <- x -> 3
+  -- Warning: Not exhaustive. A non-severe leaking implementation detail of
+  -- Note [considerAccessible]
+
+--
+-- All the following bindings should not emit PMC warnings
+--
+
+-- | Clause 1 is not redundant, but has inaccessible RHS. The marker should
+-- prevent a warning.
+i :: () -> Int
+i () | False, considerAccessible = 1
+i _                              = 2
+
+-- | Clause 1 is accessible with or without the marker. It has no
+-- impact on checking the other equations.
+j :: Bool -> Int
+j x = case (x, x) of
+  (True,  True)  | considerAccessible -> 1
+  (False, False) -> 2
+
+-- | The 'Refl' makes the second clause inaccessible (even a bang would do).
+-- The marker prevents a warning. Unfortunately, it has no effect on
+-- @-Winaccessible-code@.
+k :: Int :~: Bool -> Bool -> Int
+k _    False                      = 1
+k Refl _     | considerAccessible = 2
+
+-- | Compared to 'g', the marked inaccessible clause comes first. It has no
+-- impact on checking the other equations.
+l :: Bool -> Int
+l x = case (x, x) of
+  (True,  False) | considerAccessible -> 1 -- No warning!
+  (True,  True)  -> 2
+  (False, False) -> 3
+
+-- | Warning that the second GRHS is redundant would be unsound here.
+m :: Int -> Int
+m x | False <- considerAccessible = 1
+    | otherwise                   = 2 -- Not redundant!
diff --git a/testsuite/tests/pmcheck/should_compile/T18610.stderr b/testsuite/tests/pmcheck/should_compile/T18610.stderr
new file mode 100644
index 0000000000..7f6a2dfe67
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T18610.stderr
@@ -0,0 +1,17 @@
+
+T18610.hs:15:3: warning: [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match is redundant
+    In a case alternative: (True, False) -> ...
+
+T18610.hs:24:7: warning: [-Wincomplete-patterns (in -Wextra)]
+    Pattern match(es) are non-exhaustive
+    In a case alternative:
+        Patterns of type ‘(Bool, Bool)’ not matched: (_, _)
+
+T18610.hs:53:3: warning: [-Winaccessible-code (in -Wdefault)]
+    • Couldn't match type ‘Bool’ with ‘Int’
+      Inaccessible code in
+        a pattern with constructor: Refl :: forall {k} (a :: k). a :~: a,
+        in an equation for ‘k’
+    • In the pattern: Refl
+      In an equation for ‘k’: k Refl _ | considerAccessible = 2
diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T
index b922696fae..5245862851 100644
--- a/testsuite/tests/pmcheck/should_compile/all.T
+++ b/testsuite/tests/pmcheck/should_compile/all.T
@@ -154,6 +154,8 @@ test('T18572', normal, compile,
      ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns'])
 test('T18609', normal, compile,
      ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T18610', normal, compile,
+     ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 test('T18670', normal, compile,
      ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 test('T18708', normal, compile,