Broaden the circumstances under which inaccessible code warnings are reported...

Broaden the circumstances under which inaccessible code warnings are reported due to unsatisfiable constraints.

compiler/GHC/Tc/Errors.hs

@@ -577,8 +577,13 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_impl = implics
     -- we might suppress its error message, and proceed on past
     -- type checking to get a Lint error later
     report1 = [ ("custom_error", unblocked is_user_type_error, True,  mkUserTypeErrorReporter)
-
-              , given_eq_spec
+              , -- See Note [Given warnings]
+                -- Don't bother doing this if -Winaccessible-code isn't enabled.
+                -- See Note [Avoid -Winaccessible-code when deriving] in GHC.Tc.TyCl.Instance.
+                -- False means don't suppress subsequent errors, because these are warnings anyway.
+                if any ic_warn_inaccessible (cec_encl ctxt)
+                   then ("insoluble1a", is_given_eq, False, mkGivenWarningReporter)
+                   else ("insoluble1b", is_given_eq, False, ignoreGivenWarningReporter)
               , ("insoluble2",   unblocked utterly_wrong,  True, mkGroupReporter mkEqErr)
               , ("skolem eq1",   unblocked very_wrong,     True, mkSkolReporter)
               , ("skolem eq2",   unblocked skolem_eq,      True, mkSkolReporter)
@@ -645,29 +650,6 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_impl = implics
     is_irred _ (IrredPred {}) = True
     is_irred _ _              = False
 
-    given_eq_spec  -- See Note [Given errors]
-      | has_gadt_match (cec_encl ctxt)
-      = ("insoluble1a", is_given_eq, True,  mkGivenErrorReporter)
-      | otherwise
-      = ("insoluble1b", is_given_eq, False, ignoreErrorReporter)
-          -- False means don't suppress subsequent errors
-          -- Reason: we don't report all given errors
-          --         (see mkGivenErrorReporter), and we should only suppress
-          --         subsequent errors if we actually report this one!
-          --         #13446 is an example
-
-    -- See Note [Given errors]
-    has_gadt_match [] = False
-    has_gadt_match (implic : implics)
-      | PatSkol {} <- ic_info implic
-      , not (ic_no_eqs implic)
-      , ic_warn_inaccessible implic
-          -- Don't bother doing this if -Winaccessible-code isn't enabled.
-          -- See Note [Avoid -Winaccessible-code when deriving] in GHC.Tc.TyCl.Instance.
-      = True
-      | otherwise
-      = has_gadt_match implics
-
 ---------------
 isSkolemTy :: TcLevel -> Type -> Bool
 -- The type is a skolem tyvar
@@ -735,13 +717,13 @@ mkUserTypeError ctxt ct = mkErrorMsgFromCt ctxt ct
                             Nothing  -> pprPanic "mkUserTypeError" (ppr ct)
 
 
-mkGivenErrorReporter :: Reporter
--- See Note [Given errors]
-mkGivenErrorReporter ctxt cts
+mkGivenWarningReporter :: Reporter
+-- See Note [Given warnings]
+mkGivenWarningReporter ctxt cts
   = do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct
        ; dflags <- getDynFlags
        ; let (implic:_) = cec_encl ctxt
-                 -- Always non-empty when mkGivenErrorReporter is called
+                 -- Always non-empty when mkGivenWarningReporter is called
              ct' = setCtLoc ct (setCtLocEnv (ctLoc ct) (ic_env implic))
                    -- For given constraints we overwrite the env (and hence src-loc)
                    -- with one from the immediately-enclosing implication.
@@ -755,21 +737,21 @@ mkGivenErrorReporter ctxt cts
        ; err <- mkEqErr_help dflags ctxt report ct'
                              Nothing ty1 ty2
 
-       ; traceTc "mkGivenErrorReporter" (ppr ct)
+       ; traceTc "mkGivenWarningReporter" (ppr ct)
        ; reportWarning (Reason Opt_WarnInaccessibleCode) err }
   where
     (ct : _ )  = cts    -- Never empty
     (ty1, ty2) = getEqPredTys (ctPred ct)
 
-ignoreErrorReporter :: Reporter
+ignoreGivenWarningReporter :: Reporter
 -- Discard Given errors that don't come from
 -- a pattern match; maybe we should warn instead?
-ignoreErrorReporter ctxt cts
-  = do { traceTc "mkGivenErrorReporter no" (ppr cts $$ ppr (cec_encl ctxt))
+ignoreGivenWarningReporter ctxt cts
+  = do { traceTc "mkGivenWarningReporter no" (ppr cts $$ ppr (cec_encl ctxt))
        ; return () }
 
 
-{- Note [Given errors]
+{- Note [Given warnings]
 ~~~~~~~~~~~~~~~~~~~~~~
 Given constraints represent things for which we have (or will have)
 evidence, so they aren't errors.  But if a Given constraint is
@@ -789,18 +771,25 @@ warn about that.  A classic case is
 We'd like to point out that the T3 match is inaccessible. It
 will have a Given constraint [G] Int ~ Bool.
 
-But we don't want to report ALL insoluble Given constraints.  See Trac
-#12466 for a long discussion.  For example, if we aren't careful
-we'll complain about
-   f :: ((Int ~ Bool) => a -> a) -> Int
-which arguably is OK.  It's more debatable for
-   g :: (Int ~ Bool) => Int -> Int
-but it's tricky to distinguish these cases so we don't report
-either.
-
-The bottom line is this: has_gadt_match looks for an enclosing
-pattern match which binds some equality constraints.  If we
-find one, we report the insoluble Given.
+It's possible that we now over-report some Given constraints.
+
+For example, consider the following two functions:
+   f :: (Int ~ Bool) => Int -> Int
+   g :: ((Int ~ Bool) => a -> a) -> Int
+While f cannot be used at all, and essentially must be dead code,
+the function g could be used, as it only requires a function which
+demands an absurd premise. That is, f requires something that is
+impossible, while g merely requires something that is unnecessary.
+
+However, it's tricky to distinguish these two cases due to the way
+that the constraint solver is written. Since this is now just a
+warning though, little harm should be caused by reporting it in
+all cases.
+
+See Trac #12466 for a long discussion in the context when this was
+still an error. In Trac #11066 it became a warning only. In
+discussing issue #17543, it was found that we would like the warning
+in a broader range of cases again.
 -}
 
 mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM ErrMsg)
@@ -1352,7 +1341,7 @@ mkEqErr _ [] = panic "mkEqErr"
 
 mkEqErr1 :: ReportErrCtxt -> Ct -> TcM ErrMsg
 mkEqErr1 ctxt ct   -- Wanted or derived;
-                   -- givens handled in mkGivenErrorReporter
+                   -- givens handled in mkGivenWarningReporter
   = do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct
        ; rdr_env <- getGlobalRdrEnv
        ; fam_envs <- tcGetFamInstEnvs

compiler/GHC/Tc/Types/Constraint.hs

@@ -1058,7 +1058,7 @@ Residual implication looks like
 
 We do /not/ want to set the implication status to IC_Insoluble,
 because that'll suppress reports of [W] C b (f b).  But we
-may not report the insoluble [G] f b ~# b either (see Note [Given errors]
+may not report the insoluble [G] f b ~# b either (see Note [Given warnings]
 in GHC.Tc.Errors), so we may fail to report anything at all!  Yikes.
 
 The same applies to Derived constraints that /arise from/ Givens.

testsuite/tests/deriving/should_compile/T15398.stderr

+
+T15398.hs:20:1: warning: [-Winaccessible-code (in -Wdefault)]
+    • Couldn't match type ‘OpenDistance’ with ‘CourseLine’
+      Inaccessible code in
+        a pattern with constructor:
+          Point :: forall a. (Eq a, Ord a) => Zone CourseLine a,
+        in a case alternative
+    • In the pattern: Point {}
+      In a case alternative: Point {} -> GT
+      In the expression:
+        case b of
+          Point {} -> GT
+          Vector -> EQ
+          _ -> LT
+      When typechecking the code for ‘compare’
+        in a derived instance for ‘Ord (Zone k a)’:
+        To see the code I am typechecking, use -ddump-deriv
+
+T15398.hs:20:1: warning: [-Winaccessible-code (in -Wdefault)]
+    • Couldn't match type ‘OpenDistance’ with ‘CourseLine’
+      Inaccessible code in
+        a pattern with constructor:
+          Point :: forall a. (Eq a, Ord a) => Zone CourseLine a,
+        in a case alternative
+    • In the pattern: Point {}
+      In a case alternative: Point {} -> False
+      In the expression:
+        case b of
+          Point {} -> False
+          Vector -> False
+          _ -> True
+      When typechecking the code for ‘<’
+        in a derived instance for ‘Ord (Zone k a)’:
+        To see the code I am typechecking, use -ddump-deriv

testsuite/tests/deriving/should_compile/T8128.stderr

+
+T8128.hs:9:1: warning: [-Winaccessible-code (in -Wdefault)]
+    • Couldn't match type ‘Int’ with ‘Bool’
+      Inaccessible code in
+        a pattern with constructor: MkT2 :: Bool -> T Bool,
+        in an equation for ‘showsPrec’
+    • In the pattern: MkT2 b1
+      In an equation for ‘showsPrec’:
+          showsPrec a (MkT2 b1)
+            = showParen (a >= 11) ((.) (showString "MkT2 ") (showsPrec 11 b1))
+      When typechecking the code for ‘showsPrec’
+        in a derived instance for ‘Show (T Int)’:
+        To see the code I am typechecking, use -ddump-deriv
+      In the instance declaration for ‘Show (T Int)’

testsuite/tests/deriving/should_compile/T8740.stderr

+
+T8740.hs:17:1: warning: [-Winaccessible-code (in -Wdefault)]
+    • Couldn't match type ‘Reified’ with ‘Abstract’
+      Inaccessible code in
+        a pattern with constructor:
+          ElectRefAsTypeOf :: forall a.
+                              Int -> Elect Abstract a -> Elect Abstract a,
+        in a case alternative
+    • In the pattern: ElectRefAsTypeOf {}
+      In a case alternative: ElectRefAsTypeOf {} -> GT
+      In the expression:
+        case b of
+          ElectRefAsTypeOf {} -> GT
+          ElectHandle b1 -> (a1 `compare` b1)
+          _ -> LT
+      When typechecking the code for ‘compare’
+        in a derived instance for ‘Ord (Elect p a)’:
+        To see the code I am typechecking, use -ddump-deriv

testsuite/tests/ghci/scripts/Defer02.stderr

@@ -54,6 +54,21 @@ Defer01.hs:39:17: warning: [-Wdeferred-type-errors (in -Wdefault)]
         a :: a (bound at Defer01.hs:39:3)
         i :: a -> () (bound at Defer01.hs:39:1)
 
+Defer01.hs:46:1: warning: [-Winaccessible-code (in -Wdefault)]
+    Couldn't match type ‘Int’ with ‘Bool’
+    Inaccessible code in
+      the type signature for:
+        k :: (Int ~ Bool) => Int -> Bool
+
+Defer01.hs:46:6: warning: [-Winaccessible-code (in -Wdefault)]
+    • Couldn't match type ‘Int’ with ‘Bool’
+      Inaccessible code in
+        the type signature for:
+          k :: (Int ~ Bool) => Int -> Bool
+    • In the ambiguity check for ‘k’
+      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+      In the type signature: k :: (Int ~ Bool) => Int -> Bool
+
 Defer01.hs:47:7: warning: [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match expected type ‘Bool’ with actual type ‘Int’
     • In the expression: x

testsuite/tests/pmcheck/should_compile/T15450.stderr

 
+T15450.hs:5:1: warning: [-Winaccessible-code (in -Wdefault)]
+    Couldn't match type ‘Int’ with ‘Bool’
+    Inaccessible code in
+      the type signature for:
+        f :: forall a. (Int ~ Bool) => Bool -> a
+
+T15450.hs:5:6: warning: [-Winaccessible-code (in -Wdefault)]
+    • Couldn't match type ‘Int’ with ‘Bool’
+      Inaccessible code in
+        the type signature for:
+          f :: forall a. (Int ~ Bool) => Bool -> a
+    • In the ambiguity check for ‘f’
+      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+      In the type signature: f :: (Int ~ Bool) => Bool -> a
+
 T15450.hs:6:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
@@ -6,6 +21,21 @@ T15450.hs:6:7: warning: [-Wincomplete-patterns (in -Wextra)]
             False
             True
 
+T15450.hs:8:1: warning: [-Winaccessible-code (in -Wdefault)]
+    Couldn't match type ‘Int’ with ‘Bool’
+    Inaccessible code in
+      the type signature for:
+        g :: forall a. (Int ~ Bool) => Bool -> a
+
+T15450.hs:8:6: warning: [-Winaccessible-code (in -Wdefault)]
+    • Couldn't match type ‘Int’ with ‘Bool’
+      Inaccessible code in
+        the type signature for:
+          g :: forall a. (Int ~ Bool) => Bool -> a
+    • In the ambiguity check for ‘g’
+      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+      In the type signature: g :: (Int ~ Bool) => Bool -> a
+
 T15450.hs:9:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative: Patterns not matched: False

testsuite/tests/typecheck/should_compile/T12466.stderr

+
+T12466.hs:9:10: warning: [-Winaccessible-code (in -Wdefault)]
+    • Couldn't match type ‘Char’ with ‘Int’
+      Inaccessible code in
+        a type expected by the context:
+          (Char ~ Int) => Int
+    • In the expression: T12466.$dmfoo @(Char)
+      In an equation for ‘foo’: foo = T12466.$dmfoo @(Char)
+      In the instance declaration for ‘Foo Char’

testsuite/tests/typecheck/should_compile/T12466a.stderr

+
+T12466a.hs:26:18: warning: [-Winaccessible-code (in -Wdefault)]
+    • Occurs check: cannot construct the infinite type: a ~ Gcd a b
+      Inaccessible code in
+        a type expected by the context:
+          (a ~ Gcd a b, a ~ Gcd a c) => Dict (a ~ Gcd a (Gcd b c))
+    • In the first argument of ‘Sub’, namely ‘axiom’
+      In the expression: Sub axiom
+      In an equation for ‘dividesGcd’: dividesGcd = Sub axiom
+    • Relevant bindings include
+        dividesGcd :: (Divides a b, Divides a c) :- Divides a (Gcd b c)
+          (bound at T12466a.hs:26:1)

testsuite/tests/typecheck/should_fail/FDsFromGivens.stderr

+
+FDsFromGivens.hs:13:1: warning: [-Winaccessible-code (in -Wdefault)]
+    Couldn't match type ‘[a]’ with ‘Bool’
+      arising from a functional dependency between constraints:
+        ‘C Char Bool’
+          arising from the type signature for:
+                         g1 :: forall a.
+                               (C Char [a], C Char Bool) =>
+                               a -> () at FDsFromGivens.hs:13:1-42
+        ‘C Char [a]’
+          arising from the type signature for:
+                         g1 :: forall a.
+                               (C Char [a], C Char Bool) =>
+                               a -> () at FDsFromGivens.hs:13:1-42
+    Inaccessible code in
+      the type signature for:
+        g1 :: forall a. (C Char [a], C Char Bool) => a -> ()
+
+FDsFromGivens.hs:13:7: warning: [-Winaccessible-code (in -Wdefault)]
+    • Couldn't match type ‘[a]’ with ‘Bool’
+        arising from a functional dependency between constraints:
+          ‘C Char Bool’
+            arising from the type signature for:
+                           g1 :: forall a.
+                                 (C Char [a], C Char Bool) =>
+                                 a -> () at FDsFromGivens.hs:13:7-42
+          ‘C Char [a]’
+            arising from the type signature for:
+                           g1 :: forall a.
+                                 (C Char [a], C Char Bool) =>
+                                 a -> () at FDsFromGivens.hs:13:7-42
+      Inaccessible code in
+        the type signature for:
+          g1 :: forall a. (C Char [a], C Char Bool) => a -> ()
+    • In the ambiguity check for ‘g1’
+      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+      In the type signature: g1 :: (C Char [a], C Char Bool) => a -> ()

testsuite/tests/typecheck/should_fail/T10715.stderr

+
+T10715.hs:17:1: warning: [-Winaccessible-code (in -Wdefault)]
+    Occurs check: cannot construct the infinite type: a ~ X a
+    Inaccessible code in
+      the type signature for:
+        doCoerce :: forall a. Coercible a (X a) => a -> X a
+
+T10715.hs:17:13: warning: [-Winaccessible-code (in -Wdefault)]
+    • Occurs check: cannot construct the infinite type: a ~ X a
+      Inaccessible code in
+        the type signature for:
+          doCoerce :: forall a. Coercible a (X a) => a -> X a
+    • In the ambiguity check for ‘doCoerce’
+      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+      In the type signature: doCoerce :: Coercible a (X a) => a -> X a

testsuite/tests/typecheck/should_fail/T5236.stderr

+
+T5236.hs:16:1: warning: [-Winaccessible-code (in -Wdefault)]
+    Couldn't match type ‘B’ with ‘A’
+      arising from a functional dependency between:
+        constraint ‘Id A B’
+          arising from the type signature for:
+                         loop :: Id A B => Bool
+        instance ‘Id B B’ at T5236.hs:11:10-15
+    Inaccessible code in
+      the type signature for:
+        loop :: Id A B => Bool
+
+T5236.hs:16:9: warning: [-Winaccessible-code (in -Wdefault)]
+    • Couldn't match type ‘B’ with ‘A’
+        arising from a functional dependency between:
+          constraint ‘Id A B’
+            arising from the type signature for:
+                           loop :: Id A B => Bool
+          instance ‘Id B B’ at T5236.hs:11:10-15
+      Inaccessible code in
+        the type signature for:
+          loop :: Id A B => Bool
+    • In the ambiguity check for ‘loop’
+      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+      In the type signature: loop :: Id A B => Bool

testsuite/tests/typecheck/should_fail/T8392a.stderr

+
+T8392a.hs:10:1: warning: [-Winaccessible-code (in -Wdefault)]
+    Couldn't match type ‘Int’ with ‘Bool’
+    Inaccessible code in
+      the type signature for:
+        foo :: forall a. (Int ~ Bool) => a -> a

testsuite/tests/typecheck/should_fail/tcfail085.stderr

 
-tcfail085.hs:9:5:
-    Constructor ‘F’ does not have the required strict field(s): y
-    In the expression: F {x = 2}
-    In an equation for ‘z’: z = F {x = 2}
+tcfail085.hs:9:5: error:
+    • Constructor ‘F’ does not have the required strict field(s): y
+    • In the expression: F {x = 2}
+      In an equation for ‘z’: z = F {x = 2}