More import tidying and fixing the stage 2 build

[ghc-hetmet.git] / compiler / types / TyCon.lhs

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 1464fab..fc27995 100644 (file)
--- 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, 
@@ -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,16 @@ 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 Maybe
+import Maybes
 import Outputable
 import FastString
 \end{code}
@@ -101,6 +105,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
@@ -183,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
@@ -192,10 +200,6 @@ data TyCon
         tyConName   :: Name
     }
 
-type KindCon = TyCon
-
-type SuperKindCon = TyCon
-
 type FieldLabel = Name
 
 data AlgTyConRhs
@@ -275,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
@@ -657,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}
 
 
@@ -756,12 +772,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
@@ -816,8 +829,8 @@ tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
 tyConClass_maybe ther_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 _}) =