diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/basicTypes/DataCon.lhs | 4 | ||||
| -rw-r--r-- | compiler/deSugar/MatchCon.lhs | 5 |
2 files changed, 5 insertions, 4 deletions
diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index 8d300d288c..289fdef46f 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -603,10 +603,10 @@ dataConInstArgTys (MkData {dcRepArgTys = arg_tys, -- And the same deal for the original arg tys dataConInstOrigArgTys :: DataCon -> [Type] -> [Type] -dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, +dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys, dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs}) inst_tys - = ASSERT( length tyvars == length inst_tys ) + = ASSERT2( length tyvars == length inst_tys, ptext SLIT("dataConInstOrigArgTys") <+> ppr dc <+> ppr inst_tys ) map (substTyWith tyvars inst_tys) arg_tys where tyvars = univ_tvs ++ ex_tvs diff --git a/compiler/deSugar/MatchCon.lhs b/compiler/deSugar/MatchCon.lhs index 2612b503db..fd840e6f93 100644 --- a/compiler/deSugar/MatchCon.lhs +++ b/compiler/deSugar/MatchCon.lhs @@ -12,7 +12,7 @@ import {-# SOURCE #-} Match ( match ) import HsSyn ( Pat(..), LPat, HsConDetails(..) ) import DsBinds ( dsLHsBinds ) -import DataCon ( DataCon, dataConInstOrigArgTys, +import DataCon ( DataCon, dataConInstOrigArgTys, dataConEqSpec, dataConFieldLabels, dataConSourceArity ) import TcType ( tcTyConAppArgs ) import Type ( mkTyVarTys ) @@ -100,7 +100,8 @@ matchOneCon vars ty (eqn1 : eqns) -- All eqns for a single constructor pat_tvs = tvs1, pat_dicts = dicts1 } = firstPat eqn1 arg_tys = dataConInstOrigArgTys con inst_tys - inst_tys = tcTyConAppArgs pat_ty1 ++ mkTyVarTys tvs1 + n_co_args = length (dataConEqSpec con) + inst_tys = tcTyConAppArgs pat_ty1 ++ (drop n_co_args $ mkTyVarTys tvs1) -- Newtypes opaque, hence tcTyConAppArgs shift eqn@(EqnInfo { eqn_pats = ConPatOut{ pat_tvs = tvs, pat_dicts = ds, |