- shift_con_pat :: EquationInfo -> EquationInfo
- shift_con_pat (EqnInfo n ctx (ConPatOut _ (PrefixCon arg_pats) _ _ _ : pats) match_result)
- = EqnInfo n ctx (arg_pats ++ pats) match_result
-
- other_pats = [p | EqnInfo _ _ (p:_) _ <- other_eqns]
-
- var_prs = concat [ (ex_tvs' `zip` ex_tvs) ++
- (ex_dicts' `zip` ex_dicts)
- | ConPatOut _ _ _ ex_tvs' ex_dicts' <- other_pats ]
-
- do_subst e = substExpr subst e
- where
- subst = foldl (\ s (v', v) -> bindSubst s v' v) in_scope var_prs
- in_scope = mkSubst (mkInScopeSet (exprFreeVars e)) emptySubstEnv
- -- We put all the free variables of e into the in-scope
- -- set of the substitution, not because it is necessary,
- -- but to suppress the warning in Subst.lookupInScope
- -- Tiresome, but doing the substitution at all is rare.
+ 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