X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FDataCon.lhs;h=a83d5f894c44a6b9d310a2bb3b65a81879b99f8a;hb=ff8e1d01524b48e028b09e2b04b2e5303cb6d95f;hp=ee2c6857dc24f4f7d0cfcf78db6784afb3958f2e;hpb=70918cf4a4d61d4752b18f29ce14c7d7f1fbce01;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index ee2c685..a83d5f8 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -246,6 +246,8 @@ data DataCon
 		--       The declaration format is held in the TyCon (algTcGadtSyntax)
 
 	dcUnivTyVars :: [TyVar],	-- Universally-quantified type vars 
+					-- INVARIANT: length matches arity of the dcRepTyCon
+
 	dcExTyVars   :: [TyVar],	-- Existentially-quantified type vars 
 		-- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
 		-- FOR THE PARENT TyCon. With GADTs the data con might not even have 
@@ -484,20 +486,13 @@ mkDataCon name declared_infix
     real_stricts = map mk_dict_strict_mark theta ++ arg_stricts
 
 	-- Example
-	--   data instance T [a] where 
-	--	TI :: forall b. b -> T [Maybe b]
+	--   data instance T (b,c) where 
+	--	TI :: forall e. e -> T (e,e)
+	--
 	-- The representation tycon looks like this:
-	--   data :R7T a where 
-	--	TI :: forall b c. (c :=: Maybe b) b -> :R7T c
-    orig_res_ty 
-	| Just (fam_tc, fam_tys) <- tyConFamInst_maybe tycon
-	, let fam_subst = zipTopTvSubst (tyConTyVars fam_tc) res_tys
-	= mkTyConApp fam_tc (substTys fam_subst fam_tys)
-	| otherwise
-	= mkTyConApp tycon res_tys
-	where
-	  res_tys = substTyVars (mkTopTvSubst eq_spec) univ_tvs
-		-- In the example above, res_tys is a singleton, (Maybe b)
+	--   data :R7T b c where 
+	--	TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1
+    orig_res_ty = mkFamilyTyConApp tycon (substTyVars (mkTopTvSubst eq_spec) univ_tvs)
 
 	-- Representation arguments and demands
 	-- To do: eliminate duplication with MkId
@@ -639,9 +634,9 @@ dataConStupidTheta dc = dcStupidTheta dc
 dataConUserType :: DataCon -> Type
 -- The user-declared type of the data constructor
 -- in the nice-to-read form 
---	T :: forall a. a -> T [a]
+--	T :: forall a b. a -> b -> T [a]
 -- rather than
---	T :: forall b. forall a. (a=[b]) => a -> T b
+--	T :: forall a c. forall b. (c=[a]) => a -> b -> T c
 -- NB: If the constructor is part of a data instance, the result type
 -- mentions the family tycon, not the internal one.
 dataConUserType  (MkData { dcUnivTyVars = univ_tvs, 
@@ -750,7 +745,8 @@ splitProductType_maybe ty
 					-- and for constructors visible
 	   -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
 	   where
-	      data_con = head (tyConDataCons tycon)
+	      data_con = ASSERT( not (null (tyConDataCons tycon)) ) 
+			 head (tyConDataCons tycon)
 	other -> Nothing
 
 splitProductType str ty