diff options
| author | Manuel M T Chakravarty <chak@cse.unsw.edu.au> | 2006-09-18 20:40:38 +0000 |
|---|---|---|
| committer | Manuel M T Chakravarty <chak@cse.unsw.edu.au> | 2006-09-18 20:40:38 +0000 |
| commit | f86fa5fd11a2847c6687ad84d579760a7a06eb8b (patch) | |
| tree | 0c35e9025734b9dde3084f48ac2900d2d861b838 /compiler | |
| parent | 8ddec564494dc7889ea7aa8b4133f08cf3e64e0c (diff) | |
| download | haskell-f86fa5fd11a2847c6687ad84d579760a7a06eb8b.tar.gz | |
GADT pattern matching fix
Sun Aug 6 17:01:59 EDT 2006 Manuel M T Chakravarty <chak@cse.unsw.edu.au>
* GADT pattern matching fix
Wed Jul 19 10:53:09 EDT 2006 kevind@bu.edu
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, |