X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=4e2ae695d90888804298f01c41ac285a0529a809;hb=dc8ffcb9797ade3e3a68e6ec0a89fe2e7444e0ef;hp=e23155d0de4ff22c6641cfed9c3a0a44a8f67170;hpb=b89a7fb470edee5762fba51effb64d1c071df373;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index e23155d..4e2ae69 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -600,18 +600,19 @@ reifyTyCon tc
 
 reifyTyCon tc
   = do 	{ cxt <- reifyCxt (tyConStupidTheta tc)
-	; cons <- mapM reifyDataCon (tyConDataCons tc)
+	; let tvs = tyConTyVars tc
+	; cons <- mapM (reifyDataCon (mkTyVarTys tvs)) (tyConDataCons tc)
 	; let name = reifyName tc
-	      tvs  = reifyTyVars (tyConTyVars tc)
+	      r_tvs  = reifyTyVars tvs
 	      deriv = []	-- Don't know about deriving
-	      decl | isNewTyCon tc = TH.NewtypeD cxt name tvs (head cons) deriv
-		   | otherwise	   = TH.DataD    cxt name tvs cons 	  deriv
+	      decl | isNewTyCon tc = TH.NewtypeD cxt name r_tvs (head cons) deriv
+		   | otherwise	   = TH.DataD    cxt name r_tvs cons 	  deriv
 	; return (TH.TyConI decl) }
 
-reifyDataCon :: DataCon -> TcM TH.Con
-reifyDataCon dc
+reifyDataCon :: [Type] -> DataCon -> TcM TH.Con
+reifyDataCon tys dc
   | isVanillaDataCon dc
-  = do 	{ arg_tys <- reifyTypes (dataConOrigArgTys dc)
+  = do 	{ arg_tys <- reifyTypes (dataConInstOrigArgTys dc tys)
 	; let stricts = map reifyStrict (dataConStrictMarks dc)
 	      fields  = dataConFieldLabels dc
 	      name    = reifyName dc