X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=959575900470d3efc578565cd4cb4af4dadd4af6;hp=1464fabcc7d3aa7223d99b4ed88546b3267f8b33;hb=84923cc7de2a93c22a2f72daf9ac863959efae13;hpb=27897431cf24d4bde04b15947440c7205f2d703c

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 1464fab..9595759 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -1,7 +1,9 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section[TyCon]{The @TyCon@ datatype}
+
+The @TyCon@ datatype
 
 \begin{code}
 module TyCon(
@@ -10,7 +12,8 @@ module TyCon(
 	PrimRep(..),
 	tyConPrimRep,
 
-	AlgTyConRhs(..), visibleDataCons, AlgTyConParent(..),
+	AlgTyConRhs(..), visibleDataCons, 
+        AlgTyConParent(..), 
 	SynTyConRhs(..),
 
 	isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
@@ -19,9 +22,10 @@ module TyCon(
 	isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
 	assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
 	isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
-	isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo,
+	isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo_maybe,
 	isHiBootTyCon, isSuperKindTyCon,
         isCoercionTyCon_maybe, isCoercionTyCon,
+        isImplicitTyCon,
 
 	tcExpandTyCon_maybe, coreExpandTyCon_maybe,
 
@@ -61,16 +65,15 @@ module TyCon(
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} TypeRep ( Kind, Type, Coercion, PredType )
+import {-# SOURCE #-} TypeRep ( Kind, Type, PredType )
 import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
 
-import Var   		( TyVar, Id )
-import Class		( Class )
-import BasicTypes	( Arity, RecFlag(..), Boxity(..), isBoxed )
-import Name		( Name, nameUnique, NamedThing(getName) )
-import PrelNames	( Unique, Uniquable(..) )
-import Maybe		( isJust )
-import Maybes		( orElse )
+import Var
+import Class
+import BasicTypes
+import Name
+import PrelNames
+import Maybes
 import Outputable
 import FastString
 \end{code}
@@ -101,6 +104,8 @@ data TyCon
 	tyConTyVars :: [TyVar],		-- Scopes over (a) the algTcStupidTheta
 					--	       (b) the cached types in
 					--		   algTyConRhs.NewTyCon
+					--	       (c) the family instance
+					--		   types if present
 					-- But not over the data constructors
 
         tyConArgPoss :: Maybe [Int],    -- for associated families: for each
@@ -109,6 +114,8 @@ data TyCon
 					-- argument list (starting from 0).
 					-- NB: Length is less than tyConArity
 					--     if higher kind signature.
+					-- NB: Just _ <=> associated (not
+					--		  toplevel) family
 	
 	algTcSelIds :: [Id],  		-- Its record selectors (empty if none)
 
@@ -167,7 +174,8 @@ data TyCon
 	tyConUnique   :: Unique,
 	tyConName     :: Name,
 	tyConKind     :: Kind,
-	tyConArity    :: Arity,
+	tyConArity    :: Arity,		-- SLPJ Oct06: I'm not sure what the significance
+					--	       of the arity of a primtycon is!
 
 	primTyConRep  :: PrimRep,
 			-- Many primitive tycons are unboxed, but some are
@@ -183,8 +191,10 @@ data TyCon
 	tyConUnique :: Unique,
         tyConName   :: Name,
 	tyConArity  :: Arity,
-	coKindFun   :: [Type] -> Kind
-    }
+	coKindFun   :: [Type] -> (Type,Type)
+    }		-- INVARAINT: coKindFun is always applied to exactly 'arity' args
+		-- E.g. for trans (c1 :: ta=tb) (c2 :: tb=tc), the coKindFun returns 
+		--	the kind as a pair of types: (ta,tc)
 	
   | SuperKindTyCon {    -- Super Kinds, TY (box) and CO (diamond).
 			-- They have no kind; and arity zero
@@ -192,10 +202,6 @@ data TyCon
         tyConName   :: Name
     }
 
-type KindCon = TyCon
-
-type SuperKindCon = TyCon
-
 type FieldLabel = Name
 
 data AlgTyConRhs
@@ -537,8 +543,8 @@ isAlgTyCon (TupleTyCon {}) = True
 isAlgTyCon other 	   = False
 
 isDataTyCon :: TyCon -> Bool
--- isDataTyCon returns True for data types that are represented by
--- heap-allocated constructors.
+-- isDataTyCon returns True for data types that are definitely
+-- represented by heap-allocated constructors.
 -- These are srcutinised by Core-level @case@ expressions, and they
 -- get info tables allocated for them.
 --	True for all @data@ types
@@ -550,7 +556,7 @@ isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})
 	DataTyCon {}  -> True
 	OpenNewTyCon  -> False
 	NewTyCon {}   -> False
-	AbstractTyCon -> pprPanic "isDataTyCon" (ppr tc)
+	AbstractTyCon -> False	-- We don't know, so return False
 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 isDataTyCon other = False
 
@@ -657,13 +663,34 @@ isSuperKindTyCon :: TyCon -> Bool
 isSuperKindTyCon (SuperKindTyCon {}) = True
 isSuperKindTyCon other               = False
 
-isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> Kind)
+isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> (Type,Type))
 isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule}) 
   = Just (ar, rule)
 isCoercionTyCon_maybe other = Nothing
 
+isCoercionTyCon :: TyCon -> Bool
 isCoercionTyCon (CoercionTyCon {}) = True
 isCoercionTyCon other              = False
+
+-- Identifies implicit tycons that, in particular, do not go into interface
+-- files (because they are implicitly reconstructed when the interface is
+-- read).
+--
+-- Note that 
+--
+-- * associated families are implicit, as they are re-constructed from
+--   the class declaration in which they reside, and 
+-- * family instances are *not* implicit as they represent the instance body
+--   (similar to a dfun does that for a class instance).
+--
+isImplicitTyCon :: TyCon -> Bool
+isImplicitTyCon tycon | isTyConAssoc tycon           = True
+		      | isSynTyCon tycon	     = False
+		      | isAlgTyCon tycon	     = isClassTyCon tycon ||
+						       isTupleTyCon tycon
+isImplicitTyCon _other                               = True
+        -- catches: FunTyCon, PrimTyCon, 
+        -- CoercionTyCon, SuperKindTyCon
 \end{code}
 
 
@@ -756,12 +783,9 @@ newTyConRep :: TyCon -> ([TyVar], Type)
 newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
 newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
 
-newTyConCo :: TyCon -> Maybe TyCon
-newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_co = co }})
-  = co
-newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = OpenNewTyCon})
-  = Nothing
-newTyConCo tycon = pprPanic "newTyConCo" (ppr tycon)
+newTyConCo_maybe :: TyCon -> Maybe TyCon
+newTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = co
+newTyConCo_maybe _						 = Nothing
 
 tyConPrimRep :: TyCon -> PrimRep
 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
@@ -813,22 +837,22 @@ isClassTyCon other_tycon			     = False
 
 tyConClass_maybe :: TyCon -> Maybe Class
 tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
-tyConClass_maybe ther_tycon				    = Nothing
+tyConClass_maybe other_tycon				    = Nothing
 
 isFamInstTyCon :: TyCon -> Bool
-isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _}) = True
-isFamInstTyCon other_tycon			            = False
+isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
+isFamInstTyCon other_tycon			             = False
 
 tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
 tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) = 
   Just (fam, instTys)
-tyConFamInst_maybe ther_tycon				                = 
+tyConFamInst_maybe other_tycon				                = 
   Nothing
 
 tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
 tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) = 
   Just coe
-tyConFamilyCoercion_maybe ther_tycon 				         = 
+tyConFamilyCoercion_maybe other_tycon 				         = 
   Nothing
 \end{code}