- splitByCon :: [EquationInfo] -> ([EquationInfo], [EquationInfo])
- splitByCon [] = ([],[])
- splitByCon (info@(EqnInfo (pat : _) _) : rest)
- = case pat of
- ConPat n _ _ | n == data_con -> (info:rest_yes, rest_no)
- WildPat _ -> (info:rest_yes, info:rest_no)
- -- WildPats will be in the shadows only,
- -- and they go into both groups
- other_pat -> (rest_yes, info:rest_no)
- where
- (rest_yes, rest_no) = splitByCon rest
-
- shift_con_pat :: EquationInfo -> EquationInfo
- shift_con_pat (EqnInfo (ConPat _ _ pats': pats) match_result)
- = EqnInfo (pats' ++ pats) match_result
- shift_con_pat (EqnInfo (WildPat _: pats) match_result) -- Will only happen in shadow
- = EqnInfo ([WildPat (outPatType arg_pat) | arg_pat <- arg_pats] ++ pats) match_result
- shift_con_pat other = panic "matchConFamily:match_cons_used:shift_con_pat"
+ pats@(pat1 : other_pats) = map firstPat eqns
+ ConPatOut (L _ data_con) tvs1 dicts1 _ (PrefixCon arg_pats1) pat_ty = pat1
+
+ ds_binds bind = do { prs <- dsHsNestedBinds bind; return (Rec prs) }
+
+ line_up pats
+ | null tvs1 && null dicts1 = [] -- Common case
+ | otherwise = [ pr | ConPatOut _ ts ds _ _ _ <- pats,
+ pr <- (ts `zip` tvs1) ++ (ds `zip` dicts1)]
+
+ -- Get the arg types, which we use to type the new vars
+ -- to match on, from the "outside"; the types of pats1 may
+ -- be more refined, and hence won't do
+ arg_tys = substTys (zipTopTvSubst (dataConTyVars data_con) inst_tys)
+ (dataConOrigArgTys data_con)
+ inst_tys | isVanillaDataCon data_con = tcTyConAppArgs pat_ty -- Newtypes opaque!
+ | otherwise = mkTyVarTys tvs1