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

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 8b2b24c..e2b756b 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -6,19 +6,30 @@
 The @TyCon@ datatype
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module TyCon(
 	TyCon, FieldLabel,
 
 	PrimRep(..),
 	tyConPrimRep,
+        sizeofPrimRep,
 
 	AlgTyConRhs(..), visibleDataCons, 
-        AlgTyConParent(..), 
+        TyConParent(..), 
 	SynTyConRhs(..),
 
 	isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
-	isAlgTyCon, isDataTyCon, isNewTyCon, isClosedNewTyCon, isSynTyCon,
-	isClosedSynTyCon, isPrimTyCon, 
+	isAlgTyCon, isDataTyCon, 
+	isNewTyCon, unwrapNewTyCon_maybe, 
+	isSynTyCon, isClosedSynTyCon, isOpenSynTyCon,
+	isPrimTyCon, 
+
 	isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
 	assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
 	isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
@@ -76,6 +87,7 @@ import PrelNames
 import Maybes
 import Outputable
 import FastString
+import Constants
 \end{code}
 
 %************************************************************************
@@ -125,7 +137,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 +161,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
@@ -199,18 +216,22 @@ data AlgTyConRhs
 
   -- The constructor represents an open family without a fixed right hand
   -- side.  Additional instances can appear at any time.
-  --
+  -- 
+  -- These are introduced by either a top level decl:
+  --	data T a :: *
+  -- or an assoicated data type decl, in a class decl:
+  --    class C a b where
+  --	  data T b :: *
+
   | 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
+      otArgPoss   :: Maybe [Int]
+	-- 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)?
-
     }
 
   | DataTyCon {
@@ -261,29 +282,41 @@ 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
+-- 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.
---
-data AlgTyConParent 
+-- the following form.  We use `TyConParent' for both algebraic and synonym 
+-- types, but the variant `ClassTyCon' will only be used by algebraic tycons.
+
+data TyConParent 
   = NoParentTyCon	-- An ordinary type constructor has no parent.
 
   | ClassTyCon      	-- Type constructors representing a class dictionary.
-	Class	
+	Class		-- INVARIANT: the classTyCon of this Class is the current tycon
 
   | 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 the current TyCon (not the family one)
+			--	INVARIANT: the number of types matches the arity 
+			--		   of the family 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
 
+okParent :: Name -> TyConParent -> Bool	-- Checks invariants
+okParent tc_name NoParentTyCon    		= True
+okParent tc_name (ClassTyCon cls) 		= tyConName (classTyCon cls) == tc_name
+okParent tc_name (FamilyTyCon fam_tc tys co_tc) = tyConArity fam_tc == length tys
+
+--------------------
 data SynTyConRhs
   = OpenSynTyCon Kind	        -- Type family: *result* kind given
 		 (Maybe [Int])  -- for associated families: for each tyvars in
@@ -295,7 +328,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]
@@ -365,6 +398,39 @@ we get:
 And now Lint complains unless Foo T == Foo [], and that requires T==[]
 
 
+Note [Indexed data types] (aka data type families)
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   See also Note [Wrappers for data instance tycons] in MkId.lhs
+
+Consider
+	data family T a
+
+	data instance T (b,c) where
+	  T1 :: b -> c -> T (b,c)
+
+Then
+  * T is the "family TyCon"
+
+  * We make "representation TyCon" :R1T, thus:
+	data :R1T b c where
+	  T1 ::	forall b c. b -> c -> :R1T b c
+
+  * It has a top-level coercion connecting it to the family TyCon
+
+	axiom :Co:R1T b c : T (b,c) ~ :R1T b c
+
+  * The data contructor T1 has a wrapper (which is what the source-level
+    "T1" invokes):
+
+	$WT1 :: forall b c. b -> c -> T (b,c)
+	$WT1 b c (x::b) (y::c) = T1 b c x y `cast` sym (:Co:R1T b c)
+
+  * The representation TyCon :R1T has an AlgTyConParent of
+
+	FamilyTyCon T [(b,c)] :Co:R1T
+
+
+
 %************************************************************************
 %*									*
 \subsection{PrimRep}
@@ -400,6 +466,18 @@ data PrimRep
   | AddrRep		-- a pointer, but not to a Haskell value
   | FloatRep
   | DoubleRep
+
+-- Size of a PrimRep, in bytes
+sizeofPrimRep :: PrimRep -> Int
+sizeofPrimRep IntRep   = wORD_SIZE
+sizeofPrimRep WordRep  = wORD_SIZE
+sizeofPrimRep Int64Rep = wORD64_SIZE
+sizeofPrimRep Word64Rep= wORD64_SIZE
+sizeofPrimRep FloatRep = 4
+sizeofPrimRep DoubleRep= 8
+sizeofPrimRep AddrRep  = wORD_SIZE
+sizeofPrimRep PtrRep   = wORD_SIZE
+sizeofPrimRep VoidRep  = 0
 \end{code}
 
 %************************************************************************
@@ -437,7 +515,7 @@ mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn
 	algTcStupidTheta = stupid,
 	algTcRhs         = rhs,
 	algTcSelIds	 = sel_ids,
-	algTcParent	 = parent,
+	algTcParent	 = ASSERT( okParent name parent ) parent,
 	algTcRec	 = is_rec,
 	algTcGadtSyntax  = gadt_syn,
 	hasGenerics = gen_info
@@ -496,14 +574,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
@@ -558,9 +637,14 @@ isDataTyCon :: TyCon -> Bool
 --	True for all @data@ types
 --	False for newtypes
 --		  unboxed tuples
+--		  type families
+-- 
+-- NB: for a data type family, T, only the *instance* tycons are
+--     get an info table etc.  The family tycon does not.
+--     Hence False for OpenTyCon
 isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})  
   = case rhs of
-        OpenTyCon {}  -> not (otIsNewtype rhs)
+        OpenTyCon {}  -> False
 	DataTyCon {}  -> True
 	NewTyCon {}   -> False
 	AbstractTyCon -> False	 -- We don't know, so return False
@@ -568,20 +652,15 @@ isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 isDataTyCon other = False
 
 isNewTyCon :: TyCon -> Bool
-isNewTyCon (AlgTyCon {algTcRhs = rhs}) = 
-  case rhs of
-    OpenTyCon {} -> otIsNewtype rhs
-    NewTyCon {}  -> True
-    _	         -> False
-isNewTyCon other		       = False
-
--- This is an important refinement as typical newtype optimisations do *not*
--- hold for newtype families.  Why?  Given a type `T a', if T is a newtype
--- family, there is no unique right hand side by which `T a' can be replaced
--- by a cast.
---
-isClosedNewTyCon :: TyCon -> Bool
-isClosedNewTyCon tycon = isNewTyCon tycon && not (isOpenTyCon tycon)
+isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
+isNewTyCon other		               = False
+
+unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, Maybe TyCon)
+unwrapNewTyCon_maybe (AlgTyCon { tyConTyVars = tvs, 
+				 algTcRhs = NewTyCon { nt_co = mb_co, 
+						       nt_rhs = rhs }})
+			   = Just (tvs, rhs, mb_co)
+unwrapNewTyCon_maybe other = Nothing
 
 isProductTyCon :: TyCon -> Bool
 -- A "product" tycon
@@ -611,6 +690,9 @@ isSynTyCon _		 = False
 isClosedSynTyCon :: TyCon -> Bool
 isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon)
 
+isOpenSynTyCon :: TyCon -> Bool
+isOpenSynTyCon tycon = isSynTyCon tycon && isOpenTyCon tycon
+
 isGadtSyntaxTyCon :: TyCon -> Bool
 isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
 isGadtSyntaxTyCon other				       = False
@@ -858,17 +940,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}