Commit f86fa5fd authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.

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
parent 8ddec564
......@@ -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
......
......@@ -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,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment