X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FMatchCon.lhs;h=fd840e6f93b7c8e4402fa9dff89bbe788f24a134;hp=2612b503db616415768d768e8346694acf05a16a;hb=9da4639011348fb6c318e3cba4b08622f811d9c4;hpb=37507b3a4342773030ef538599363a5aff8b666a

diff --git a/compiler/deSugar/MatchCon.lhs b/compiler/deSugar/MatchCon.lhs
index 2612b50..fd840e6 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,