import PrelNames
import TyCon
import Type
-import Unify( dataConCannotMatch )
import SrcLoc
import UniqSet
import Util
-- if there are view patterns, just give up - don't know what the function is
check qs = (untidy_warns, shadowed_eqns)
where
- (warns, used_nos) = check' ([1..] `zip` map tidy_eqn qs)
+ tidy_qs = map tidy_eqn qs
+ (warns, used_nos) = check' ([1..] `zip` tidy_qs)
untidy_warns = map untidy_exhaustive warns
shadowed_eqns = [eqn | (eqn,i) <- qs `zip` [1..],
not (i `elementOfUniqSet` used_nos)]
-- 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_pat _ = False -- VarPat, WildPat, LitPat, NPat, TypePat
--------------
might_fail_lpat :: LPat Id -> Bool
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 (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 }
where
arity = length ps
--- Unpack string patterns fully, so we can see when they overlap with
--- each other, or even explicit lists of Chars.
-tidy_pat (LitPat lit)
+tidy_pat (NPat lit mb_neg eq) = tidyNPat tidy_lit_pat lit mb_neg eq
+tidy_pat (LitPat lit) = tidy_lit_pat lit
+
+tidy_lit_pat :: HsLit -> Pat Id
+-- Unpack string patterns fully, so we can see when they
+-- overlap with each other, or even explicit lists of Chars.
+tidy_lit_pat lit
| HsString s <- lit
- = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mk_char_lit c, pat] stringTy)
+ = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] stringTy)
(mkPrefixConPat nilDataCon [] stringTy) (unpackFS s)
| otherwise
= tidyLitPat lit
- where
- mk_char_lit c = mkPrefixConPat charDataCon [nlLitPat (HsCharPrim c)] charTy
-----------------
tidy_con :: DataCon -> HsConPatDetails Id -> HsConPatDetails Id