X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=959575900470d3efc578565cd4cb4af4dadd4af6;hp=15be3e2cef672270d7177d5d55c94e79b9d33ede;hb=84923cc7de2a93c22a2f72daf9ac863959efae13;hpb=53569e145c8ff8af89303742f261302fdcd98f04 diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index 15be3e2..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,17 +12,20 @@ module TyCon( PrimRep(..), tyConPrimRep, - AlgTyConRhs(..), visibleDataCons, AlgTyConParent(..), + AlgTyConRhs(..), visibleDataCons, + AlgTyConParent(..), SynTyConRhs(..), isFunTyCon, isUnLiftedTyCon, isProductTyCon, - isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, + isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isClosedNewTyCon, + isPrimTyCon, 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, @@ -60,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} @@ -100,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 @@ -108,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) @@ -166,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 @@ -182,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 @@ -191,10 +202,6 @@ data TyCon tyConName :: Name } -type KindCon = TyCon - -type SuperKindCon = TyCon - type FieldLabel = Name data AlgTyConRhs @@ -536,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 @@ -549,14 +556,24 @@ 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 isNewTyCon :: TyCon -> Bool -isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True -isNewTyCon other = False +isNewTyCon (AlgTyCon {algTcRhs = rhs}) = case rhs of + OpenNewTyCon -> True + 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) isProductTyCon :: TyCon -> Bool -- A "product" tycon @@ -646,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} @@ -745,9 +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 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 @@ -799,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}