X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FDataCon.lhs;h=9ce966ee7743dbbfff37e6288f352bd5f5d10374;hb=fe3321f99f4d9c9ff40429a7ac290f8ef7ca3297;hp=550be30b411851d76f7c0d2375866d8b0ed26a28;hpb=9c54ee0c9e25617b2a9ad4cdd9d3a6354e2edc0f;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index 550be30..9ce966e 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -640,34 +640,37 @@ dataConUserType  (MkData { dcUnivTyVars = univ_tvs,
     mkFunTys arg_tys $
     res_ty
 
-dataConInstArgTys :: DataCon
+dataConInstArgTys :: DataCon	-- A datacon with no existentials or equality constraints
+				-- However, it can have a dcTheta (notably it can be a 
+				-- class dictionary, with superclasses)
 	      	  -> [Type] 	-- Instantiated at these types
-	      	  		-- NB: these INCLUDE the existentially quantified arg types
 	      	  -> [Type]	-- Needs arguments of these types
-				-- NB: these INCLUDE the existentially quantified dict args
+				-- NB: these INCLUDE any dict args
 				--     but EXCLUDE the data-decl context which is discarded
 				-- It's all post-flattening etc; this is a representation type
-dataConInstArgTys dc@(MkData {dcRepArgTys = arg_tys, 
-			      dcUnivTyVars = univ_tvs, 
+dataConInstArgTys dc@(MkData {dcRepArgTys = rep_arg_tys, 
+			      dcUnivTyVars = univ_tvs, dcEqSpec = eq_spec,
 			      dcExTyVars = ex_tvs}) inst_tys
- = ASSERT2 ( length tyvars == length inst_tys 
-           , ptext SLIT("dataConInstArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys)
-           
-   map (substTyWith tyvars inst_tys) arg_tys
- where
-   tyvars = univ_tvs ++ ex_tvs
-
-
--- And the same deal for the original arg tys
-dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
+ = ASSERT2 ( length univ_tvs == length inst_tys 
+           , ptext SLIT("dataConInstArgTys") <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
+   ASSERT2 ( null ex_tvs && null eq_spec, ppr dc )        
+   map (substTyWith univ_tvs inst_tys) rep_arg_tys
+
+dataConInstOrigArgTys 
+	:: DataCon	-- Works for any DataCon
+	-> [Type]	-- Includes existential tyvar args, but NOT
+			-- equality constraints or dicts
+	-> [Type]	-- Returns just the instsantiated *value* arguments
+-- For vanilla datacons, it's all quite straightforward
+-- But for the call in MatchCon, we really do want just the value args
 dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
 			          dcUnivTyVars = univ_tvs, 
 			          dcExTyVars = ex_tvs}) inst_tys
- = ASSERT2( length tyvars == length inst_tys
+  = ASSERT2( length tyvars == length inst_tys
           , ptext SLIT("dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
-   map (substTyWith tyvars inst_tys) arg_tys
- where
-   tyvars = univ_tvs ++ ex_tvs
+    map (substTyWith tyvars inst_tys) arg_tys
+  where
+    tyvars = univ_tvs ++ ex_tvs
 \end{code}
 
 These two functions get the real argument types of the constructor,