X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=fc27995d95c3d63d8044c9218fe8f7f9a0936e6a;hb=8a5d47de2b82d9cca86546a7bd89d915488934ef;hp=51bc1f1d0ba7b466d5a891b5813d142bb79948ab;hpb=f37e239fb5e81fc493e0ea1af98178bf1f7ceaba;p=ghc-hetmet.git

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 51bc1f1..fc27995 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(..), hasParent,
 	SynTyConRhs(..),
 
 	isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
@@ -22,6 +25,7 @@ module TyCon(
 	isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo_maybe,
 	isHiBootTyCon, isSuperKindTyCon,
         isCoercionTyCon_maybe, isCoercionTyCon,
+        isImplicitTyCon,
 
 	tcExpandTyCon_maybe, coreExpandTyCon_maybe,
 
@@ -64,13 +68,13 @@ module TyCon(
 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 Maybe
+import Maybes
 import Outputable
 import FastString
 \end{code}
@@ -185,8 +189,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
@@ -273,6 +279,10 @@ data AlgTyConParent = -- An ordinary type constructor has no parent.
 						-- the representation type
 						-- with the type instance
 
+hasParent :: AlgTyConParent -> Bool
+hasParent NoParentTyCon = False
+hasParent _other        = True
+
 data SynTyConRhs
   = OpenSynTyCon Kind	-- Type family: *result* kind given
   | SynonymTyCon Type   -- Mentioning head type vars.  Acts as a template for
@@ -655,13 +665,21 @@ 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
+
+isImplicitTyCon :: TyCon -> Bool
+isImplicitTyCon SynTyCon{}                     = False
+isImplicitTyCon AlgTyCon{algTcParent = parent} = hasParent parent
+isImplicitTyCon other                          = True
+        -- catches: FunTyCon, TupleTyCon, PrimTyCon, 
+        -- CoercionTyCon, SuperKindTyCon
 \end{code}