-has_nplusk_lpat :: LPat Id -> Bool
-has_nplusk_lpat (L _ p) = has_nplusk_pat p
-
-has_nplusk_pat :: Pat Id -> Bool
-has_nplusk_pat (NPlusKPat _ _ _ _) = True
-has_nplusk_pat (ParPat p) = has_nplusk_lpat p
-has_nplusk_pat (AsPat _ p) = has_nplusk_lpat p
-has_nplusk_pat (SigPatOut p _ ) = has_nplusk_lpat p
-has_nplusk_pat (ConPatOut _ _ _ _ ps ty) = any has_nplusk_lpat (hsConArgs ps)
-has_nplusk_pat (ListPat ps _) = any has_nplusk_lpat ps
-has_nplusk_pat (TuplePat ps _ _) = any has_nplusk_lpat ps
-has_nplusk_pat (PArrPat ps _) = any has_nplusk_lpat ps
-has_nplusk_pat (LazyPat p) = False -- Why?
-has_nplusk_pat (BangPat p) = has_nplusk_lpat p -- I think
-has_nplusk_pat p = False -- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat, DictPat
-
-simplify_lpat :: LPat Id -> LPat Id
-simplify_lpat p = fmap simplify_pat p
-
-simplify_pat :: Pat Id -> Pat Id
-simplify_pat pat@(WildPat gt) = pat
-simplify_pat (VarPat id) = WildPat (idType id)
-simplify_pat (VarPatOut id _) = WildPat (idType id) -- Ignore the bindings
-simplify_pat (ParPat p) = unLoc (simplify_lpat p)
-simplify_pat (LazyPat p) = unLoc (simplify_lpat p)
-simplify_pat (BangPat p) = unLoc (simplify_lpat p)
-simplify_pat (AsPat id p) = unLoc (simplify_lpat p)
-simplify_pat (SigPatOut p _) = unLoc (simplify_lpat p) -- I'm not sure this is right
-
-simplify_pat (ConPatOut (L loc id) tvs dicts binds ps ty)
- = ConPatOut (L loc id) tvs dicts binds (simplify_con id ps) ty
-
-simplify_pat (ListPat ps ty) =
- unLoc $ foldr (\ x y -> mkPrefixConPat consDataCon [x,y] list_ty)
+--------------
+might_fail_pat :: Pat Id -> Bool
+-- Returns True of patterns that might fail (i.e. fall through) in a way
+-- that is not covered by the checking algorithm. Specifically:
+-- NPlusKPat
+-- ViewPat (if refutable)
+
+-- First the two special cases
+might_fail_pat (NPlusKPat {}) = True
+might_fail_pat (ViewPat _ p _) = not (isIrrefutableHsPat p)
+
+-- Now the recursive stuff
+might_fail_pat (ParPat p) = might_fail_lpat p
+might_fail_pat (AsPat _ p) = might_fail_lpat p
+might_fail_pat (SigPatOut p _ ) = might_fail_lpat p
+might_fail_pat (ListPat ps _) = any might_fail_lpat ps
+might_fail_pat (TuplePat ps _ _) = any might_fail_lpat ps
+might_fail_pat (PArrPat ps _) = any might_fail_lpat ps
+might_fail_pat (BangPat p) = might_fail_lpat p
+might_fail_pat (ConPatOut { pat_args = ps }) = any might_fail_lpat (hsConPatArgs ps)
+
+-- Finally the ones that are sure to succeed, or which are covered by the checking algorithm
+might_fail_pat (LazyPat _) = False -- Always succeeds
+might_fail_pat _ = False -- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat
+
+--------------
+might_fail_lpat :: LPat Id -> Bool
+might_fail_lpat (L _ p) = might_fail_pat p
+
+--------------
+tidy_lpat :: LPat Id -> LPat Id
+tidy_lpat p = fmap tidy_pat p
+
+--------------
+tidy_pat :: Pat Id -> Pat Id
+tidy_pat pat@(WildPat _) = pat
+tidy_pat (VarPat id) = WildPat (idType id)
+tidy_pat (VarPatOut id _) = WildPat (idType id) -- Ignore the bindings
+tidy_pat (ParPat p) = tidy_pat (unLoc p)
+tidy_pat (LazyPat p) = WildPat (hsLPatType p) -- For overlap and exhaustiveness checking
+ -- purposes, a ~pat is like a wildcard
+tidy_pat (BangPat p) = tidy_pat (unLoc p)
+tidy_pat (AsPat _ p) = tidy_pat (unLoc p)
+tidy_pat (SigPatOut p _) = tidy_pat (unLoc p)
+tidy_pat (CoPat _ pat _) = tidy_pat pat
+
+-- These two are might_fail patterns, so we map them to
+-- WildPats. The might_fail_pat stuff arranges that the
+-- guard says "this equation might fall through".
+tidy_pat (NPlusKPat id _ _ _) = WildPat (idType (unLoc id))
+tidy_pat (ViewPat _ _ ty) = WildPat ty
+
+tidy_pat (NPat lit mb_neg eq) = tidyNPat lit mb_neg eq
+
+tidy_pat pat@(ConPatOut { pat_con = L _ id, pat_args = ps })
+ = pat { pat_args = tidy_con id ps }
+
+tidy_pat (ListPat ps ty)
+ = unLoc $ foldr (\ x y -> mkPrefixConPat consDataCon [x,y] list_ty)