X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FDataCon.lhs;fp=compiler%2FbasicTypes%2FDataCon.lhs;h=df8af8e221045eadb411b98a3733ff9eb4b92549;hp=1b354c65ddcf1c44098557a7001e288e477b05a9;hb=7299e42cc5214458ba16034dbfbf58de55f7121b;hpb=35fb5c6ff0861be5ab72df799df536982d3966b8

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index 1b354c6..df8af8e 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -317,7 +317,8 @@ data DataCon
 
 	dcOrigArgTys :: [Type],		-- Original argument types
 					-- (before unboxing and flattening of strict fields)
-	dcOrigResTy :: Type,		-- Original result type
+	dcOrigResTy :: Type,		-- Original result type, as seen by the user
+		-- INVARIANT: mentions only dcUnivTyVars
 		-- NB: for a data instance, the original user result type may 
 		-- differ from the DataCon's representation TyCon.  Example
 		--	data instance T [a] where MkT :: a -> T [a]
@@ -466,14 +467,17 @@ instance Show DataCon where
 mkDataCon :: Name 
 	  -> Bool	        -- ^ Is the constructor declared infix?
 	  -> [StrictnessMark]   -- ^ Strictness annotations written in the source file
-	  -> [FieldLabel]       -- ^ Field labels for the constructor, if it is a record, otherwise empty
+	  -> [FieldLabel]       -- ^ Field labels for the constructor, if it is a record, 
+				--   otherwise empty
 	  -> [TyVar]            -- ^ Universally quantified type variables
 	  -> [TyVar]            -- ^ Existentially quantified type variables
 	  -> [(TyVar,Type)]     -- ^ GADT equalities
 	  -> ThetaType          -- ^ Theta-type occuring before the arguments proper
-	  -> [Type]             -- ^ Argument types
-	  -> TyCon              -- ^ Type constructor we are for
-	  -> ThetaType          -- ^ The "stupid theta", context of the data declaration e.g. @data Eq a => T a ...@
+	  -> [Type]             -- ^ Original argument types
+	  -> Type		-- ^ Original result type
+	  -> TyCon              -- ^ Representation type constructor
+	  -> ThetaType          -- ^ The "stupid theta", context of the data declaration 
+				--   e.g. @data Eq a => T a ...@
 	  -> DataConIds         -- ^ The Ids of the actual builder functions
 	  -> DataCon
   -- Can get the tag from the TyCon
@@ -483,7 +487,7 @@ mkDataCon name declared_infix
 	  fields
 	  univ_tvs ex_tvs 
 	  eq_spec theta
-	  orig_arg_tys tycon
+	  orig_arg_tys orig_res_ty rep_tycon
 	  stupid_theta ids
 -- Warning: mkDataCon is not a good place to check invariants. 
 -- If the programmer writes the wrong result type in the decl, thus:
@@ -506,7 +510,7 @@ mkDataCon name declared_infix
 		  dcStupidTheta = stupid_theta, 
 		  dcEqTheta = eq_theta, dcDictTheta = dict_theta,
 		  dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
-		  dcRepTyCon = tycon, 
+		  dcRepTyCon = rep_tycon, 
 		  dcRepArgTys = rep_arg_tys,
 		  dcStrictMarks = arg_stricts, 
 		  dcRepStrictness = rep_arg_stricts,
@@ -525,21 +529,11 @@ mkDataCon name declared_infix
     real_arg_tys 	   = dict_tys ++ orig_arg_tys
     real_stricts 	   = map mk_dict_strict_mark dict_theta ++ arg_stricts
 
-	-- Example
-	--   data instance T (b,c) where 
-	--	TI :: forall e. e -> T (e,e)
-	--
-	-- The representation tycon looks like this:
-	--   data :R7T b c where 
-	--	TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1
-	-- In this case orig_res_ty = T (e,e)
-    orig_res_ty = mkFamilyTyConApp tycon (substTyVars (mkTopTvSubst eq_spec) univ_tvs)
-
 	-- Representation arguments and demands
 	-- To do: eliminate duplication with MkId
     (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
 
-    tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
+    tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con
     ty  = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $ 
 	  mkFunTys (mkPredTys (eqSpecPreds eq_spec)) $
 	  mkFunTys (mkPredTys eq_theta) $
@@ -547,7 +541,7 @@ mkDataCon name declared_infix
 		--	because they might be flattened..
 		--	but the equality predicates are not
 	  mkFunTys rep_arg_tys $
-	  mkTyConApp tycon (mkTyVarTys univ_tvs)
+	  mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
 
 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
@@ -690,7 +684,8 @@ dataConRepStrictness dc = dcRepStrictness dc
 -- 4) The /original/ result type of the 'DataCon'
 dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
 dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
-		    dcEqTheta  = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+		    dcEqTheta  = eq_theta, dcDictTheta = dict_theta, 
+		    dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
   = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ eq_theta ++ dict_theta, arg_tys, res_ty)
 
 -- | The \"full signature\" of the 'DataCon' returns, in order:
@@ -703,13 +698,15 @@ dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_
 --
 -- 4) The result of 'dataConDictTheta'
 --
--- 5) The original argument types to the 'DataCon' (i.e. before any change of the representation of the type)
+-- 5) The original argument types to the 'DataCon' (i.e. before 
+--    any change of the representation of the type)
 --
 -- 6) The original result type of the 'DataCon'
 dataConFullSig :: DataCon 
 	       -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, ThetaType, [Type], Type)
 dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
-			dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+			dcEqTheta = eq_theta, dcDictTheta = dict_theta, 
+			dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
   = (univ_tvs, ex_tvs, eq_spec, eq_theta, dict_theta, arg_tys, res_ty)
 
 dataConOrigResTy :: DataCon -> Type