X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=e2b756b0a0663037ee5daa1190e51aa3ded4d235;hp=144a670c396f59f641d399d1eb7fe6ac2cacd1c2;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hpb=e659c1f58da286070b96a75c65d966347cbcbfe5 diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index 144a670..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, isSynTyCon, isNewTyCon, isClosedNewTyCon, + 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} %************************************************************************ @@ -108,15 +120,6 @@ data TyCon -- types if present -- But not over the data constructors - tyConArgPoss :: 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 - -- if higher kind signature. - -- NB: Just _ <=> associated (not - -- toplevel) family - algTcSelIds :: [Id], -- Its record selectors (empty if none) algTcGadtSyntax :: Bool, -- True <=> the data type was declared using GADT syntax @@ -134,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. } @@ -158,14 +161,12 @@ data TyCon tyConTyVars :: [TyVar], -- Bound tyvars - tyConArgPoss :: 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 - -- if higher kind signature. - - 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 @@ -204,21 +205,41 @@ data TyCon type FieldLabel = Name +-- Right hand sides of type constructors for algebraic types +-- data AlgTyConRhs - = AbstractTyCon -- We know nothing about this data type, except - -- that it's represented by a pointer - -- Used when we export a data type abstractly into - -- an hi file - | OpenDataTyCon -- data family (further instances can appear - | OpenNewTyCon -- newtype family at any time) + -- We know nothing about this data type, except that it's represented by a + -- pointer. Used when we export a data type abstractly into an hi file. + -- + = AbstractTyCon + + -- 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] + -- 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. + + } | DataTyCon { data_cons :: [DataCon], -- The constructors; can be empty if the user declares -- the type to have no constructors -- INVARIANT: Kept in order of increasing tag - -- (see the tag assignment in DataCon.mkDataCon) + -- (see the tag assignment in DataCon.mkDataCon) is_enum :: Bool -- Cached: True <=> an enumeration type } -- Includes data types with no constructors. @@ -257,39 +278,57 @@ data AlgTyConRhs visibleDataCons :: AlgTyConRhs -> [DataCon] visibleDataCons AbstractTyCon = [] -visibleDataCons OpenDataTyCon = [] -visibleDataCons OpenNewTyCon = [] +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 + = OpenSynTyCon Kind -- Type family: *result* kind given + (Maybe [Int]) -- for associated families: for each tyvars in + -- the AT decl, gives the position of that + -- tyvar in the class argument list (starting + -- from 0). + -- NB: Length is less than tyConArity + -- if higher kind signature. + | 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] @@ -359,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} @@ -394,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} %************************************************************************ @@ -428,11 +512,10 @@ mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn tyConKind = kind, tyConArity = length tyvars, tyConTyVars = tyvars, - tyConArgPoss = Nothing, algTcStupidTheta = stupid, algTcRhs = rhs, algTcSelIds = sel_ids, - algTcParent = parent, + algTcParent = ASSERT( okParent name parent ) parent, algTcRec = is_rec, algTcGadtSyntax = gadt_syn, hasGenerics = gen_info @@ -491,15 +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, - tyConArgPoss = Nothing, - synTcRhs = rhs + synTcRhs = rhs, + synTcParent = parent } mkCoercionTyCon name arity kindRule @@ -554,30 +637,30 @@ 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 - OpenDataTyCon -> True + OpenTyCon {} -> False DataTyCon {} -> True - OpenNewTyCon -> False NewTyCon {} -> False - AbstractTyCon -> False -- We don't know, so return False + AbstractTyCon -> False -- We don't know, so return False isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity isDataTyCon other = False isNewTyCon :: TyCon -> Bool -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) +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 @@ -600,6 +683,16 @@ isSynTyCon :: TyCon -> Bool isSynTyCon (SynTyCon {}) = True isSynTyCon _ = False +-- As for newtypes, it is in some contexts important to distinguish between +-- closed synonyms and synonym families, as synonym families have no unique +-- right hand side to which a synonym family application can expand. +-- +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 @@ -609,22 +702,24 @@ isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res isEnumerationTyCon other = False isOpenTyCon :: TyCon -> Bool -isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _}) = True -isOpenTyCon (AlgTyCon {algTcRhs = OpenDataTyCon }) = True -isOpenTyCon (AlgTyCon {algTcRhs = OpenNewTyCon }) = True -isOpenTyCon _ = False +isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _ _}) = True +isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {} }) = True +isOpenTyCon _ = False assocTyConArgPoss_maybe :: TyCon -> Maybe [Int] -assocTyConArgPoss_maybe (AlgTyCon { tyConArgPoss = poss }) = poss -assocTyConArgPoss_maybe (SynTyCon { tyConArgPoss = poss }) = poss -assocTyConArgPoss_maybe _ = Nothing +assocTyConArgPoss_maybe (AlgTyCon { + algTcRhs = OpenTyCon {otArgPoss = poss}}) = poss +assocTyConArgPoss_maybe (SynTyCon { synTcRhs = OpenSynTyCon _ poss }) = poss +assocTyConArgPoss_maybe _ = Nothing isTyConAssoc :: TyCon -> Bool isTyConAssoc = isJust . assocTyConArgPoss_maybe setTyConArgPoss :: TyCon -> [Int] -> TyCon -setTyConArgPoss tc@(AlgTyCon {}) poss = tc { tyConArgPoss = Just poss } -setTyConArgPoss tc@(SynTyCon {}) poss = tc { tyConArgPoss = Just poss } +setTyConArgPoss tc@(AlgTyCon { algTcRhs = rhs }) poss = + tc { algTcRhs = rhs {otArgPoss = Just poss} } +setTyConArgPoss tc@(SynTyCon { synTcRhs = OpenSynTyCon ki _ }) poss = + tc { synTcRhs = OpenSynTyCon ki (Just poss) } setTyConArgPoss tc _ = pprPanic "setTyConArgPoss" (ppr tc) isTupleTyCon :: TyCon -> Bool @@ -762,7 +857,7 @@ tyConFamilySize :: TyCon -> Int tyConFamilySize (AlgTyCon {algTcRhs = DataTyCon {data_cons = cons}}) = length cons tyConFamilySize (AlgTyCon {algTcRhs = NewTyCon {}}) = 1 -tyConFamilySize (AlgTyCon {algTcRhs = OpenDataTyCon}) = 0 +tyConFamilySize (AlgTyCon {algTcRhs = OpenTyCon {}}) = 0 tyConFamilySize (TupleTyCon {}) = 1 #ifdef DEBUG tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other) @@ -819,7 +914,7 @@ synTyConType tc = case synTcRhs tc of _ -> pprPanic "synTyConType" (ppr tc) synTyConResKind :: TyCon -> Kind -synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind}) = kind +synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind _}) = kind synTyConResKind tycon = pprPanic "synTyConResKind" (ppr tycon) \end{code} @@ -845,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}