- 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"
+ ConPatOut (L _ con) tvs1 dicts1 _ (PrefixCon arg_pats1) pat_ty = firstPat (head eqns)
+
+ shift eqn@(EqnInfo { eqn_wrap = wrap,
+ eqn_pats = ConPatOut _ tvs ds bind (PrefixCon arg_pats) _ : pats })
+ = do { prs <- dsHsNestedBinds bind
+ ; return (eqn { eqn_wrap = wrap . wrapBinds (tvs `zip` tvs1)
+ . wrapBinds (ds `zip` dicts1)
+ . mkDsLet (Rec prs),
+ eqn_pats = map unLoc arg_pats ++ pats }) }
+
+ -- 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 con) inst_tys)
+ (dataConOrigArgTys con)
+ inst_tys | isVanillaDataCon con = tcTyConAppArgs pat_ty -- Newtypes opaque!
+ | otherwise = mkTyVarTys tvs1