-%************************************************************************
-%* *
-%* Gathering stuff out of patterns
-%* *
-%************************************************************************
-
-This function @collectPatBinders@ works with the ``collectBinders''
-functions for @HsBinds@, etc. The order in which the binders are
-collected is important; see @HsBinds.lhs@.
-
-It collects the bounds *value* variables in renamed patterns; type variables
-are *not* collected.
-
-\begin{code}
-collectPatBinders :: Pat a -> [a]
-collectPatBinders pat = collect pat []
-
-collectPatsBinders :: [Pat a] -> [a]
-collectPatsBinders pats = foldr collect [] pats
-
-collect (WildPat _) bndrs = bndrs
-collect (VarPat var) bndrs = var : bndrs
-collect (LazyPat pat) bndrs = collect pat bndrs
-collect (AsPat a pat) bndrs = a : collect pat bndrs
-collect (ParPat pat) bndrs = collect pat bndrs
-
-collect (ListPat pats _) bndrs = foldr collect bndrs pats
-collect (PArrPat pats _) bndrs = foldr collect bndrs pats
-collect (TuplePat pats _) bndrs = foldr collect bndrs pats
-
-collect (ConPatIn c ps) bndrs = foldr collect bndrs (hsConArgs ps)
-collect (ConPatOut c ps _ _ ds) bndrs = ds ++ foldr collect bndrs (hsConArgs ps)
-
-collect (LitPat _) bndrs = bndrs
-collect (NPatIn _ _) bndrs = bndrs
-collect (NPatOut _ _ _) bndrs = bndrs
-
-collect (NPlusKPatIn n _ _) bndrs = n : bndrs
-collect (NPlusKPatOut n _ _ _) bndrs = n : bndrs
-
-collect (SigPatIn pat _) bndrs = collect pat bndrs
-collect (SigPatOut pat _ _) bndrs = collect pat bndrs
-collect (TypePat ty) bndrs = bndrs
-collect (DictPat ids1 ids2) bndrs = ids1 ++ ids2 ++ bndrs
-\end{code}
-
-\begin{code}
-collectSigTysFromPats :: [InPat name] -> [HsType name]
-collectSigTysFromPats pats = foldr collect_pat [] pats
-
-collectSigTysFromPat :: InPat name -> [HsType name]
-collectSigTysFromPat pat = collect_pat pat []
-
-collect_pat (SigPatIn pat ty) acc = collect_pat pat (ty:acc)
-collect_pat (TypePat ty) acc = ty:acc
-
-collect_pat (LazyPat pat) acc = collect_pat pat acc
-collect_pat (AsPat a pat) acc = collect_pat pat acc
-collect_pat (ParPat pat) acc = collect_pat pat acc
-collect_pat (ListPat pats _) acc = foldr collect_pat acc pats
-collect_pat (PArrPat pats _) acc = foldr collect_pat acc pats
-collect_pat (TuplePat pats _) acc = foldr collect_pat acc pats
-collect_pat (ConPatIn c ps) acc = foldr collect_pat acc (hsConArgs ps)
-collect_pat other acc = acc -- Literals, vars, wildcard
+isBangHsBind :: HsBind id -> Bool
+-- In this module because HsPat is above HsBinds in the import graph
+isBangHsBind (PatBind { pat_lhs = L _ (BangPat p) }) = True
+isBangHsBind bind = False
+
+isIrrefutableHsPat :: LPat id -> Bool
+-- This function returns False if it's in doubt; specifically
+-- on a ConPatIn it doesn't know the size of the constructor family
+-- But if it returns True, the pattern is definitely irrefutable
+isIrrefutableHsPat pat
+ = go pat
+ where
+ go (L _ pat) = go1 pat
+
+ go1 (WildPat _) = True
+ go1 (VarPat _) = True
+ go1 (VarPatOut _ _) = True
+ go1 (LazyPat pat) = True
+ go1 (BangPat pat) = go pat
+ go1 (ParPat pat) = go pat
+ go1 (AsPat _ pat) = go pat
+ go1 (SigPatIn pat _) = go pat
+ go1 (SigPatOut pat _) = go pat
+ go1 (TuplePat pats _ _) = all go pats
+ go1 (ListPat pats _) = False
+ go1 (PArrPat pats _) = False -- ?
+
+ go1 (ConPatIn _ _) = False -- Conservative
+ go1 (ConPatOut (L _ con) _ _ _ details _)
+ = isProductTyCon (dataConTyCon con)
+ && all go (hsConArgs details)
+
+ go1 (LitPat _) = False
+ go1 (NPat _ _ _ _) = False
+ go1 (NPlusKPat _ _ _ _) = False
+
+ go1 (TypePat _) = panic "isIrrefutableHsPat: type pattern"
+ go1 (DictPat _ _) = panic "isIrrefutableHsPat: type pattern"