Commit 1593debf authored by Sebastian Graf's avatar Sebastian Graf Committed by Marge Bot

Check EmptyCase by simply adding a non-void constraint

We can handle non-void constraints since !1733, so we can now express
the strictness of `-XEmptyCase` just by adding a non-void constraint
to the initial Uncovered set.

For `case x of {}` we thus check that the Uncovered set `{ x | x /~ ⊥ }`
is non-empty. This is conceptually simpler than the plan outlined in
 #17376, because it talks to the oracle directly.

In order for this patch to pass the testsuite, I had to fix handling of
newtypes in the pattern-match checker (#17248).

Since we use a different code path (well, the main code path) for
`-XEmptyCase` now, we apparently also handle #13717 correctly.
There's also some dead code that we can get rid off now.

`provideEvidence` has been updated to provide output more in line with
the old logic, which used `inhabitationCandidates` under the hood.

A consequence of the shift away from the `UncoveredPatterns` type is
that we don't report reduced type families for empty case matches,
because the pretty printer is pure and only knows the match variable's
type.

Fixes #13717, #17248, #17386
parent 487ede42
......@@ -42,6 +42,7 @@ import SrcLoc
import Util
import Outputable
import DataCon
import TyCon
import Var (EvVar)
import Coercion
import TcEvidence
......@@ -236,7 +237,7 @@ instance Monoid PartialResult where
data PmResult =
PmResult {
pmresultRedundant :: [Located [LPat GhcTc]]
, pmresultUncovered :: UncoveredCandidates
, pmresultUncovered :: [Delta]
, pmresultInaccessible :: [Located [LPat GhcTc]]
, pmresultApproximate :: Precision }
......@@ -248,24 +249,6 @@ instance Outputable PmResult where
, text "pmresultApproximate" <+> ppr (pmresultApproximate pmr)
]
-- | Either a list of patterns that are not covered, or their type, in case we
-- have no patterns at hand. Not having patterns at hand can arise when
-- handling EmptyCase expressions, in two cases:
--
-- * The type of the scrutinee is a trivially inhabited type (like Int or Char)
-- * The type of the scrutinee cannot be reduced to WHNF.
--
-- In both these cases we have no inhabitation candidates for the type at hand,
-- but we don't want to issue just a wildcard as missing. Instead, we print a
-- type annotated wildcard, so that the user knows what kind of patterns is
-- expected (e.g. (_ :: Int), or (_ :: F Int), where F Int does not reduce).
data UncoveredCandidates = UncoveredPatterns [Id] [Delta]
| TypeOfUncovered Type
instance Outputable UncoveredCandidates where
ppr (UncoveredPatterns vva deltas) = text "UnPat" <+> ppr vva $$ ppr deltas
ppr (TypeOfUncovered ty) = text "UnTy" <+> ppr ty
{-
%************************************************************************
%* *
......@@ -279,7 +262,7 @@ checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM ()
checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do
tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p])
res <- checkSingle' locn var p
dsPmWarn dflags ctxt res
dsPmWarn dflags ctxt [var] res
-- | Check a single pattern binding (let)
checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> DsM PmResult
......@@ -291,11 +274,14 @@ checkSingle' locn var p = do
PartialResult cs us ds pc <- pmCheck grds [] 1 missing
dflags <- getDynFlags
us' <- getNFirstUncovered [var] (maxUncoveredPatterns dflags + 1) us
let uc = UncoveredPatterns [var] us'
let plain = PmResult { pmresultRedundant = []
, pmresultUncovered = us'
, pmresultInaccessible = []
, pmresultApproximate = pc }
return $ case (cs,ds) of
(Covered, _ ) -> PmResult [] uc [] pc -- useful
(NotCovered, NotDiverged) -> PmResult m uc [] pc -- redundant
(NotCovered, Diverged ) -> PmResult [] uc m pc -- inaccessible rhs
(Covered , _ ) -> plain -- useful
(NotCovered, NotDiverged) -> plain { pmresultRedundant = m } -- redundant
(NotCovered, Diverged ) -> plain { pmresultInaccessible = m } -- inaccessible rhs
where m = [cL locn [cL locn p]]
-- | Exhaustive for guard matches, is used for guards in pattern bindings and
......@@ -324,30 +310,26 @@ checkMatches dflags ctxt vars matches = do
, text "Matches:"])
2
(vcat (map ppr matches)))
res <- case matches of
-- Check EmptyCase separately
-- See Note [Checking EmptyCase Expressions] in GHC.HsToCore.PmCheck.Oracle
[] | [var] <- vars -> checkEmptyCase' var
_normal_match -> checkMatches' vars matches
dsPmWarn dflags ctxt res
-- | Check a matchgroup (case, functions, etc.). To be called on a non-empty
-- list of matches. For empty case expressions, use checkEmptyCase' instead.
res <- checkMatches' vars matches
dsPmWarn dflags ctxt vars res
-- | Check a matchgroup (case, functions, etc.).
checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM PmResult
checkMatches' vars matches
| null matches = panic "checkMatches': EmptyCase"
| otherwise = do
missing <- getPmDelta
tracePm "checkMatches': missing" (ppr missing)
(rs,us,ds,pc) <- go matches [missing]
dflags <- getDynFlags
us' <- getNFirstUncovered vars (maxUncoveredPatterns dflags + 1) us
let up = UncoveredPatterns vars us'
return $ PmResult {
pmresultRedundant = map hsLMatchToLPats rs
, pmresultUncovered = up
, pmresultInaccessible = map hsLMatchToLPats ds
, pmresultApproximate = pc }
checkMatches' vars matches = do
init_delta <- getPmDelta
missing <- case matches of
-- This must be an -XEmptyCase. See Note [Checking EmptyCase]
[] | [var] <- vars -> maybeToList <$> addTmCt init_delta (TmVarNonVoid var)
_ -> pure [init_delta]
tracePm "checkMatches': missing" (ppr missing)
(rs,us,ds,pc) <- go matches missing
dflags <- getDynFlags
us' <- getNFirstUncovered vars (maxUncoveredPatterns dflags + 1) us
return $ PmResult {
pmresultRedundant = map hsLMatchToLPats rs
, pmresultUncovered = us'
, pmresultInaccessible = map hsLMatchToLPats ds
, pmresultApproximate = pc }
where
go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered
-> DsM ( [LMatch GhcTc (LHsExpr GhcTc)]
......@@ -381,28 +363,32 @@ checkMatches' vars matches
hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats
hsLMatchToLPats _ = panic "checkMatches'"
-- | Check an empty case expression. Since there are no clauses to process, we
-- only compute the uncovered set. See Note [Checking EmptyCase Expressions]
-- in "GHC.HsToCore.PmCheck.Oracle" for details.
checkEmptyCase' :: Id -> DsM PmResult
checkEmptyCase' x = do
delta <- getPmDelta
us <- inhabitants delta (idType x) >>= \case
-- Inhabitation checking failed / the type is trivially inhabited
Left ty -> pure (TypeOfUncovered ty)
-- A list of oracle states for the different satisfiable constructors is
-- available. Turn this into a value set abstraction.
Right (va, deltas) -> pure (UncoveredPatterns [va] deltas)
pure (PmResult [] us [] Precise)
getNFirstUncovered :: [Id] -> Int -> [Delta] -> DsM [Delta]
getNFirstUncovered _ 0 _ = pure []
getNFirstUncovered _ _ [] = pure []
getNFirstUncovered vars n (delta:deltas) = do
front <- provideEvidenceForEquation vars n delta
front <- provideEvidence vars n delta
back <- getNFirstUncovered vars (n - length front) deltas
pure (front ++ back)
{- Note [Checking EmptyCase]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-XEmptyCase is useful for matching on empty data types like 'Void'. For example,
the following is a complete match:
f :: Void -> ()
f x = case x of {}
Really, -XEmptyCase is the only way to write a program that at the same time is
safe (@f _ = error "boom"@ is not because of ⊥), doesn't trigger a warning
(@f !_ = error "inaccessible" has inaccessible RHS) and doesn't turn an
exception into divergence (@f x = f x@).
Semantically, unlike every other case expression, -XEmptyCase is strict in its
match var x, which rules out ⊥ as an inhabitant. So we add x /~ ⊥ to the
initial Delta and check if there are any values left to match on.
-}
{-
%************************************************************************
%* *
......@@ -514,7 +500,7 @@ translatePat fam_insts x pat = case pat of
translateListPat fam_insts x ps
-- overloaded list
ListPat (ListPatTc _elem_ty (Just (pat_ty, to_list))) pats -> do
ListPat (ListPatTc elem_ty (Just (pat_ty, to_list))) pats -> do
dflags <- getDynFlags
case splitListTyConApp_maybe pat_ty of
Just _e_ty
......@@ -522,7 +508,7 @@ translatePat fam_insts x pat = case pat of
-- Just translate it as a regular ListPat
-> translateListPat fam_insts x pats
_ -> do
y <- selectMatchVar pat
y <- mkPmId (mkListTy elem_ty)
grds <- translateListPat fam_insts y pats
rhs_y <- dsSyntaxExpr to_list [Var x]
pure $ PmLet y rhs_y : grds
......@@ -1075,7 +1061,8 @@ pmCheck' (p : ps) guards n delta
pr_pos <- pmCheckM ps guards n (addPmConCts delta x con dicts args)
-- The var is forced regardless of whether @con@ was satisfiable
let pr_pos' = forceIfCanDiverge delta x pr_pos
-- See Note [Divergence of Newtype matches]
let pr_pos' = addConMatchStrictness delta x con pr_pos
-- Stuff for <next equation>
pr_neg <- addRefutableAltCon delta x con >>= \case
......@@ -1120,6 +1107,13 @@ forceIfCanDiverge delta x
| canDiverge delta x = forces
| otherwise = id
-- | 'forceIfCanDiverge' if the 'PmAltCon' was not a Newtype.
-- See Note [Divergence of Newtype matches].
addConMatchStrictness :: Delta -> Id -> PmAltCon -> PartialResult -> PartialResult
addConMatchStrictness _ _ (PmAltConLike (RealDataCon dc)) res
| isNewTyCon (dataConTyCon dc) = res
addConMatchStrictness delta x _ res = forceIfCanDiverge delta x res
-- ----------------------------------------------------------------------------
-- * Propagation of term constraints inwards when checking nested matches
......@@ -1242,14 +1236,12 @@ needToRunPmCheck dflags origin
= notNull (filter (`wopt` dflags) allPmCheckWarnings)
-- | Issue all the warnings (coverage, exhaustiveness, inaccessibility)
dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM ()
dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result
dsPmWarn :: DynFlags -> DsMatchContext -> [Id] -> PmResult -> DsM ()
dsPmWarn dflags ctx@(DsMatchContext kind loc) vars pm_result
= when (flag_i || flag_u) $ do
let exists_r = flag_i && notNull redundant
exists_i = flag_i && notNull inaccessible && not is_rec_upd
exists_u = flag_u && (case uncovered of
TypeOfUncovered _ -> True
UncoveredPatterns _ unc -> notNull unc)
exists_u = flag_u && notNull uncovered
approx = precision == Approximate
when (approx && (exists_u || exists_i)) $
......@@ -1262,9 +1254,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result
putSrcSpanDs l (warnDs (Reason Opt_WarnOverlappingPatterns)
(pprEqn q "has inaccessible right hand side"))
when exists_u $ putSrcSpanDs loc $ warnDs flag_u_reason $
case uncovered of
TypeOfUncovered ty -> warnEmptyCase ty
UncoveredPatterns vars unc -> pprEqns vars unc
pprEqns vars uncovered
where
PmResult
{ pmresultRedundant = redundant
......@@ -1293,11 +1283,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result
in hang (text "Patterns not matched:") 4
(vcat (take maxPatterns us) $$ dots maxPatterns us)
-- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for
-- which we only know the type and have no inhabitants at hand)
warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ ->
hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty)
approx_msg = vcat
[ hang
(text "Pattern match checker ran into -fmax-pmcheck-models="
......
This diff is collapsed.
......@@ -128,44 +128,6 @@ instance Eq PmLit where
pmLitType :: PmLit -> Type
pmLitType (PmLit ty _) = ty
-- | Type of a 'PmAltCon'
pmAltConType :: PmAltCon -> [Type] -> Type
pmAltConType (PmAltLit lit) _arg_tys = ASSERT( null _arg_tys ) pmLitType lit
pmAltConType (PmAltConLike con) arg_tys = conLikeResTy con arg_tys
instance Outputable PmLitValue where
ppr (PmLitInt i) = ppr i
ppr (PmLitRat r) = ppr (double (fromRat r)) -- good enough
ppr (PmLitChar c) = pprHsChar c
ppr (PmLitString s) = pprHsString s
ppr (PmLitOverInt n i) = minuses n (ppr i)
ppr (PmLitOverRat n r) = minuses n (ppr (double (fromRat r)))
ppr (PmLitOverString s) = pprHsString s
-- Take care of negated literals
minuses :: Int -> SDoc -> SDoc
minuses n sdoc = iterate (\sdoc -> parens (char '-' <> sdoc)) sdoc !! n
instance Outputable PmLit where
ppr (PmLit ty v) = ppr v <> suffix
where
-- Some ad-hoc hackery for displaying proper lit suffixes based on type
tbl = [ (intPrimTy, primIntSuffix)
, (int64PrimTy, primInt64Suffix)
, (wordPrimTy, primWordSuffix)
, (word64PrimTy, primWord64Suffix)
, (charPrimTy, primCharSuffix)
, (floatPrimTy, primFloatSuffix)
, (doublePrimTy, primDoubleSuffix) ]
suffix = fromMaybe empty (snd <$> find (eqType ty . fst) tbl)
instance Outputable PmAltCon where
ppr (PmAltConLike cl) = ppr cl
ppr (PmAltLit l) = ppr l
instance Outputable PmEquality where
ppr = text . show
-- | Undecidable equality for values represented by 'ConLike's.
-- See Note [Undecidable Equality for PmAltCons].
-- 'PatSynCon's aren't enforced to be generative, so two syntactically different
......@@ -222,6 +184,11 @@ eqPmAltCon _ _ = PossiblyOverlap
instance Eq PmAltCon where
a == b = eqPmAltCon a b == Equal
-- | Type of a 'PmAltCon'
pmAltConType :: PmAltCon -> [Type] -> Type
pmAltConType (PmAltLit lit) _arg_tys = ASSERT( null _arg_tys ) pmLitType lit
pmAltConType (PmAltConLike con) arg_tys = conLikeResTy con arg_tys
{- Note [Undecidable Equality for PmAltCons]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Equality on overloaded literals is undecidable in the general case. Consider
......@@ -364,20 +331,53 @@ coreExprAsPmLit e = case collectArgs e of
| otherwise
= False
instance Outputable PmLitValue where
ppr (PmLitInt i) = ppr i
ppr (PmLitRat r) = ppr (double (fromRat r)) -- good enough
ppr (PmLitChar c) = pprHsChar c
ppr (PmLitString s) = pprHsString s
ppr (PmLitOverInt n i) = minuses n (ppr i)
ppr (PmLitOverRat n r) = minuses n (ppr (double (fromRat r)))
ppr (PmLitOverString s) = pprHsString s
-- Take care of negated literals
minuses :: Int -> SDoc -> SDoc
minuses n sdoc = iterate (\sdoc -> parens (char '-' <> sdoc)) sdoc !! n
instance Outputable PmLit where
ppr (PmLit ty v) = ppr v <> suffix
where
-- Some ad-hoc hackery for displaying proper lit suffixes based on type
tbl = [ (intPrimTy, primIntSuffix)
, (int64PrimTy, primInt64Suffix)
, (wordPrimTy, primWordSuffix)
, (word64PrimTy, primWord64Suffix)
, (charPrimTy, primCharSuffix)
, (floatPrimTy, primFloatSuffix)
, (doublePrimTy, primDoubleSuffix) ]
suffix = fromMaybe empty (snd <$> find (eqType ty . fst) tbl)
instance Outputable PmAltCon where
ppr (PmAltConLike cl) = ppr cl
ppr (PmAltLit l) = ppr l
instance Outputable PmEquality where
ppr = text . show
type ConLikeSet = UniqDSet ConLike
-- | A data type caching the results of 'completeMatchConLikes' with support for
-- deletion of contructors that were already matched on.
-- deletion of constructors that were already matched on.
data PossibleMatches
= PM TyCon (NonEmpty.NonEmpty ConLikeSet)
-- ^ Each ConLikeSet is a (subset of) the constructors in a COMPLETE pragma
= PM (NonEmpty.NonEmpty ConLikeSet)
-- ^ Each ConLikeSet is a (subset of) the constructors in a COMPLETE set
-- 'NonEmpty' because the empty case would mean that the type has no COMPLETE
-- set at all, for which we have 'NoPM'
-- set at all, for which we have 'NoPM'.
| NoPM
-- ^ No COMPLETE set for this type (yet). Think of overloaded literals.
instance Outputable PossibleMatches where
ppr (PM _tc cs) = ppr (NonEmpty.toList cs)
ppr (PM cs) = ppr (NonEmpty.toList cs)
ppr NoPM = text "<NoPM>"
-- | Either @Indirect x@, meaning the value is represented by that of @x@, or
......
......@@ -241,7 +241,11 @@ tcCompleteSigs sigs =
mkMatch :: [ConLike] -> TyCon -> CompleteMatch
mkMatch cls ty_con = CompleteMatch {
completeMatchConLikes = map conLikeName cls,
-- foldM is a left-fold and will have accumulated the ConLikes in
-- the reverse order. foldrM would accumulate in the correct order,
-- but would type-check the last ConLike first, which might also be
-- confusing from the user's perspective. Hence reverse here.
completeMatchConLikes = reverse (map conLikeName cls),
completeMatchTyCon = tyConName ty_con
}
doOne _ = return Nothing
......@@ -287,7 +291,10 @@ tcCompleteSigs sigs =
<+> parens (quotes (ppr tc)
<+> text "resp."
<+> quotes (ppr tc'))
in mapMaybeM (addLocM doOne) sigs
-- For some reason I haven't investigated further, the signatures come in
-- backwards wrt. declaration order. So we reverse them here, because it makes
-- a difference for incomplete match suggestions.
in mapMaybeM (addLocM doOne) (reverse sigs) -- process in declaration order
tcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id]
-- A hs-boot file has only one BindGroup, and it only has type
......
......@@ -693,7 +693,7 @@ It does *not* reduce type or data family applications or look through newtypes.
Why is this useful? As one example, when coverage-checking an EmptyCase
expression, it's possible that the type of the scrutinee will only reduce
if some local equalities are solved for. See "Wrinkle: Local equalities"
in Note [Type normalisation for EmptyCase] in Check.
in Note [Type normalisation] in Check.
To accomplish its stated goal, tcNormalise first feeds the local constraints
into solveSimpleGivens, then stuffs the argument type in a CHoleCan, and feeds
......
......@@ -3,4 +3,7 @@ KindEqualities.hs:25:1: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In an equation for ‘zero’:
Patterns not matched:
TyApp (TyApp p _) _ where p is not one of {TyInt}
TyApp (TyApp _ _) TyInt
TyApp (TyApp _ _) TyBool
TyApp (TyApp _ _) TyMaybe
TyApp (TyApp _ _) (TyApp _ _)
{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-}
{-# LANGUAGE PatternSynonyms #-}
module Lib where
data B = T | F
pattern P :: B
pattern P = T
{-# COMPLETE P, F #-}
f :: B -> ()
f P = ()
pattern Q :: B
pattern Q = T
{-# COMPLETE T, Q #-}
g :: B -> ()
g Q = ()
T17386.hs:11:1: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In an equation for ‘f’: Patterns not matched: F
T17386.hs:18:1: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In an equation for ‘g’: Patterns not matched: T
......@@ -16,7 +16,7 @@ test('completesig15', normal, compile_fail, [''])
test('T13021', normal, compile, [''])
test('T13363a', normal, compile, [''])
test('T13363b', normal, compile, [''])
test('T13717', expect_broken('13717'), compile, [''])
test('T13717', normal, compile, [''])
test('T13964', normal, compile, [''])
test('T13965', normal, compile, [''])
test('T14059a', normal, compile, [''])
......@@ -24,3 +24,4 @@ test('T14059b', expect_broken('14059'), compile, [''])
test('T14253', normal, compile, [''])
test('T14851', normal, compile, [''])
test('T17149', normal, compile, [''])
test('T17386', normal, compile, [''])
......@@ -25,5 +25,5 @@ completesig06.hs:29:1: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In an equation for ‘m5’:
Patterns not matched:
A _
B _
A D
B D
......@@ -9,4 +9,4 @@ EmptyCase003.hs:32:6: warning: [-Wincomplete-patterns (in -Wextra)]
EmptyCase003.hs:37:6: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: _ :: Char
In a case alternative: Patterns not matched: _ :: C Int
......@@ -30,4 +30,4 @@ EmptyCase005.hs:91:8: warning: [-Wincomplete-patterns (in -Wextra)]
EmptyCase005.hs:101:8: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: _ :: H Char
In a case alternative: Patterns not matched: _ :: H Int
EmptyCase007.hs:21:7: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: _ :: Foo2 a
In a case alternative: Patterns not matched: Foo2 _
EmptyCase007.hs:25:7: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: _ :: Foo2 (a, a)
In a case alternative: Patterns not matched: Foo2 _
EmptyCase007.hs:33:7: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
......@@ -17,7 +17,7 @@ EmptyCase007.hs:37:7: warning: [-Wincomplete-patterns (in -Wextra)]
EmptyCase007.hs:44:17: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: _ :: Char
In a case alternative: Patterns not matched: _ :: FA Char
EmptyCase007.hs:48:7: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
......
......@@ -8,7 +8,7 @@ EmptyCase008.hs:17:7: warning: [-Wincomplete-patterns (in -Wextra)]
EmptyCase008.hs:21:7: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: _ :: Foo3 a
In a case alternative: Patterns not matched: Foo3 _
EmptyCase008.hs:40:7: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
......@@ -16,4 +16,4 @@ EmptyCase008.hs:40:7: warning: [-Wincomplete-patterns (in -Wextra)]
EmptyCase008.hs:48:7: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: _ :: Foo4 a b
In a case alternative: Patterns not matched: Foo4 _
EmptyCase009.hs:21:9: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: _ :: Bar f
In a case alternative: Patterns not matched: Bar _
EmptyCase009.hs:33:7: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
......
......@@ -31,7 +31,7 @@ EmptyCase010.hs:45:7: warning: [-Wincomplete-patterns (in -Wextra)]
EmptyCase010.hs:57:7: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: _ :: Baz (DC ()) a
In a case alternative: Patterns not matched: Baz _
EmptyCase010.hs:69:7: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
......@@ -39,4 +39,4 @@ EmptyCase010.hs:69:7: warning: [-Wincomplete-patterns (in -Wextra)]
EmptyCase010.hs:73:9: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: _ :: Baz f a
In a case alternative: Patterns not matched: Baz _
T10746.hs:9:10: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In a case alternative:
......
T11336b.hs:25:1: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In an equation for ‘fun’: Patterns not matched: _ :: Proxy a
In an equation for ‘fun’: Patterns not matched: Proxy
......@@ -10,8 +10,16 @@ T11822.hs:33:1: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In an equation for ‘mkTreeNode’:
Patterns not matched:
_ (Data.Sequence.Internal.Seq _) _ p where p is not one of {0}
_ (Data.Sequence.Internal.Seq _) _ p where p is not one of {0}
_ (Data.Sequence.Internal.Seq _) _ _
_ (Data.Sequence.Internal.Seq _) _ _
_ (Data.Sequence.Internal.Seq Data.Sequence.Internal.EmptyT)
(Data.Set.Internal.Bin _ _ _ _) p
where p is not one of {0}
_ (Data.Sequence.Internal.Seq Data.Sequence.Internal.EmptyT)
Data.Set.Internal.Tip p
where p is not one of {0}
_ (Data.Sequence.Internal.Seq (Data.Sequence.Internal.Single _))
(Data.Set.Internal.Bin _ _ _ _) p
where p is not one of {0}
_ (Data.Sequence.Internal.Seq (Data.Sequence.Internal.Single _))
Data.Set.Internal.Tip p
where p is not one of {0}
...
{-# LANGUAGE BangPatterns #-}
module Lib where
data T1 a = T1 a
......@@ -10,6 +11,7 @@ f _ _ = ()
g :: T2 a -> Bool -> ()
g _ True = ()
g (T2 _) True = ()
g (T2 _) True = () -- redundant
g !_ True = () -- inaccessible
g _ _ = ()
T17248.hs:8:1: warning: [-Woverlapping-patterns (in -Wdefault)]
T17248.hs:9:1: warning: [-Woverlapping-patterns (in -Wdefault)]
Pattern match has inaccessible right hand side
In an equation for ‘f’: f (T1 _) True = ...
T17248.hs:14:1: warning: [-Woverlapping-patterns (in -Wdefault)]
Pattern match is redundant
In an equation for ‘g’: g (T2 _) True = ...
T17248.hs:15:1: warning: [-Woverlapping-patterns (in -Wdefault)]
Pattern match has inaccessible right hand side
In an equation for ‘g’: g !_ True = ...
{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE BangPatterns #-}
module Lib where
import Data.Void
strictConst :: a -> b -> a
strictConst a b = seq b a
pattern F <- (const False -> True)
pattern SF <- (strictConst False -> True)
-- | The second clause is redundant, really, because (the matcher of) 'F' is
-- not strict in its argument. As a result, the third clause is *not*
-- redundant, but inaccessible RHS! Deleting the third clause would be unsound.
-- This is bad, especially because this outcome depends entirely on the
-- strictness of 'F's matcher.
f :: Bool -> Bool -> ()
f _ True = ()
f F True = ()
f !_ True = ()
f _ _ = ()