X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=cf2de8986ab85dd2a4687487d6f973f6b93b5eff;hb=13cd965d80be5c25dc54534a833df39ab7aa7a12;hp=8b2b24c3727d2f49e2f5d4d5d1e1e432f7708a24;hpb=8406c69e81f9416bc4b93c4323bbd36b25655e65;p=ghc-hetmet.git

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 8b2b24c..cf2de89 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -13,7 +13,7 @@ module TyCon(
 	tyConPrimRep,
 
 	AlgTyConRhs(..), visibleDataCons, 
-        AlgTyConParent(..), 
+        TyConParent(..), 
 	SynTyConRhs(..),
 
 	isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
@@ -125,7 +125,7 @@ data TyCon
 	hasGenerics :: Bool,		-- True <=> generic to/from functions are available
 					-- (in the exports of the data type's source module)
 
-	algTcParent :: AlgTyConParent	-- Gives the class or family tycon for
+	algTcParent :: TyConParent	-- Gives the class or family tycon for
 					-- derived tycons representing classes
 					-- or family instances, respectively.
     }
@@ -149,7 +149,12 @@ data TyCon
 
 	tyConTyVars  :: [TyVar],	-- Bound tyvars
 
-	synTcRhs     :: SynTyConRhs	-- Expanded type in here
+	synTcRhs     :: SynTyConRhs,	-- Expanded type in here
+
+        synTcParent  :: TyConParent     -- Gives the family tycon of
+                                        -- representation tycons of family
+                                        -- instances
+
     }
 
   | PrimTyCon {			-- Primitive types; cannot be defined in Haskell
@@ -203,10 +208,11 @@ data AlgTyConRhs
   | OpenTyCon {
 
       otArgPoss   :: Maybe [Int],  
-	-- for associated families: for each tyvar in the AT decl, gives the
-	-- position of that tyvar in the class argument list (starting from 0).
-	-- NB: Length is less than tyConArity iff higher kind signature.
-	-- NB: Just _ <=> associated (not toplevel) family
+	-- Nothing <=> top-level indexed type family
+	-- Just ns <=> associated (not toplevel) family
+	--   In the latter case, for each tyvar in the AT decl, 'ns' gives the
+	--   position of that tyvar in the class argument list (starting from 0).
+	--   NB: Length is less than tyConArity iff higher kind signature.
 	
       otIsNewtype :: Bool	     
         -- is a newtype (rather than data type)?
@@ -261,12 +267,13 @@ visibleDataCons OpenTyCon {}		      = []
 visibleDataCons (DataTyCon{ data_cons = cs }) = cs
 visibleDataCons (NewTyCon{ data_con = c })    = [c]
 
--- Both type classes as well as data/newtype family instances imply implicit
--- type constructors.  These implicit type constructors refer to their parent
+-- Both type classes as well as family instances imply implicit type 
+-- constructors.  These implicit type constructors refer to their parent
 -- structure (ie, the class or family from which they derive) using a type of
--- the following form.
+-- the following form.  We use `TyConParent' for both algebraic and synonym 
+-- types, but the variant `ClassTyCon' will only be used by algebraic tycons.
 --
-data AlgTyConParent 
+data TyConParent 
   = NoParentTyCon	-- An ordinary type constructor has no parent.
 
   | ClassTyCon      	-- Type constructors representing a class dictionary.
@@ -274,15 +281,16 @@ data AlgTyConParent
 
   | FamilyTyCon		-- Type constructors representing an instance of a type
 	TyCon		--   The type family
-	[Type]		--   Instance types
+	[Type]		--   Instance types; free variables are the tyConTyVars
+			--	of this TyCon
 	TyCon		--   A CoercionTyCon identifying the representation 
 			--     type with the type instance family.  
 			--	c.f. Note [Newtype coercions]
 	-- E.g.  data intance T [a] = ...
 	-- gives a representation tycon:
-	--	data T77 a = ...
-	-- 	axiom co a :: T [a] ~ T77 a
-	-- with T77's algTcParent = FamilyTyCon T [a] co
+	--	data :R7T a = ...
+	-- 	axiom co a :: T [a] ~ :R7T a
+	-- with :R7T's algTcParent = FamilyTyCon T [a] co
 
 data SynTyConRhs
   = OpenSynTyCon Kind	        -- Type family: *result* kind given
@@ -295,7 +303,7 @@ data SynTyConRhs
 
   | SynonymTyCon Type   -- Mentioning head type vars.  Acts as a template for
 			--  the expansion when the tycon is applied to some
-			--  types.  
+			--  types.
 \end{code}
 
 Note [Newtype coercions]
@@ -496,14 +504,15 @@ mkPrimTyCon' name kind arity rep is_unlifted
 	tyConExtName = Nothing
     }
 
-mkSynTyCon name kind tyvars rhs
+mkSynTyCon name kind tyvars rhs parent
   = SynTyCon {	
 	tyConName = name,
 	tyConUnique = nameUnique name,
 	tyConKind = kind,
 	tyConArity = length tyvars,
 	tyConTyVars = tyvars,
-	synTcRhs = rhs
+	synTcRhs = rhs,
+        synTcParent = parent
     }
 
 mkCoercionTyCon name arity kindRule
@@ -858,17 +867,22 @@ tyConClass_maybe other_tycon				    = Nothing
 
 isFamInstTyCon :: TyCon -> Bool
 isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
+isFamInstTyCon (SynTyCon {synTcParent = FamilyTyCon _ _ _ }) = True
 isFamInstTyCon other_tycon			             = False
 
 tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
 tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) = 
   Just (fam, instTys)
+tyConFamInst_maybe (SynTyCon {synTcParent = FamilyTyCon fam instTys _}) = 
+  Just (fam, instTys)
 tyConFamInst_maybe other_tycon				                = 
   Nothing
 
 tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
 tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) = 
   Just coe
+tyConFamilyCoercion_maybe (SynTyCon {synTcParent = FamilyTyCon _ _ coe}) = 
+  Just coe
 tyConFamilyCoercion_maybe other_tycon 				         = 
   Nothing
 \end{code}