X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=87ae25d1ca8eeabcf4c29c429cfd4a0b75187165;hb=8b5bfdf4e780bae6c596825a1042b059f9ae4f2d;hp=50d76cf63c248034440368dd6b70d7c5ff035488;hpb=683a26900e9170ba57c561a2dc94a3a4eb38cfdf;p=ghc-hetmet.git diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index 50d76cf..87ae25d 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -6,23 +6,34 @@ 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, TyConParent(..), SynTyConRhs(..), isFunTyCon, isUnLiftedTyCon, isProductTyCon, - isAlgTyCon, isDataTyCon, isNewTyCon, isClosedNewTyCon, isSynTyCon, - isClosedSynTyCon, isPrimTyCon, + isAlgTyCon, isDataTyCon, + isNewTyCon, unwrapNewTyCon_maybe, + isSynTyCon, isClosedSynTyCon, isOpenSynTyCon, + isPrimTyCon, + isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon, assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss, isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity, - isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo_maybe, + isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConEtadRhs, newTyConCo_maybe, isHiBootTyCon, isSuperKindTyCon, isCoercionTyCon_maybe, isCoercionTyCon, isImplicitTyCon, @@ -76,6 +87,7 @@ import PrelNames import Maybes import Outputable import FastString +import Constants \end{code} %************************************************************************ @@ -213,16 +225,13 @@ data AlgTyConRhs | OpenTyCon { - otArgPoss :: Maybe [Int], + 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. - otIsNewtype :: Bool - -- is a newtype (rather than data type)? - } | DataTyCon { @@ -241,10 +250,12 @@ data AlgTyConRhs -- = the representation type of the tycon -- The free tyvars of this type are the tyConTyVars - nt_co :: Maybe TyCon, -- The coercion used to create the newtype + nt_co :: Maybe TyCon, -- A CoercionTyCon used to create the newtype -- from the representation - -- optional for non-recursive newtypes + -- Optional for non-recursive newtypes -- See Note [Newtype coercions] + -- Invariant: arity = #tvs in nt_etad_rhs; + -- See Note [Newtype eta] nt_etad_rhs :: ([TyVar], Type) , -- The same again, but this time eta-reduced @@ -324,7 +335,6 @@ data SynTyConRhs Note [Newtype coercions] ~~~~~~~~~~~~~~~~~~~~~~~~ - The NewTyCon field nt_co is a a TyCon (a coercion constructor in fact) which is used for coercing from the representation type of the newtype, to the newtype itself. For example, @@ -388,6 +398,14 @@ we get: w2 = w1 And now Lint complains unless Foo T == Foo [], and that requires T==[] +This point carries over to the newtype coercion, because we need to +say + w2 = w1 `cast` Foo CoT + +so the coercion tycon CoT must have + kind: T ~ [] + and arity: 0 + Note [Indexed data types] (aka data type families) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -457,6 +475,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} %************************************************************************ @@ -616,9 +646,14 @@ 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 - OpenTyCon {} -> not (otIsNewtype rhs) + OpenTyCon {} -> False DataTyCon {} -> True NewTyCon {} -> False AbstractTyCon -> False -- We don't know, so return False @@ -626,20 +661,15 @@ isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity isDataTyCon other = False isNewTyCon :: TyCon -> Bool -isNewTyCon (AlgTyCon {algTcRhs = rhs}) = - case rhs of - OpenTyCon {} -> otIsNewtype rhs - 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 @@ -669,6 +699,9 @@ isSynTyCon _ = False 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 @@ -854,6 +887,10 @@ newTyConRhs :: TyCon -> ([TyVar], Type) newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs) newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon) +newTyConEtadRhs :: TyCon -> ([TyVar], Type) +newTyConEtadRhs (AlgTyCon {algTcRhs = NewTyCon { nt_etad_rhs = tvs_rhs }}) = tvs_rhs +newTyConEtadRhs tycon = pprPanic "newTyConEtadRhs" (ppr tycon) + newTyConRep :: TyCon -> ([TyVar], Type) newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep) newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)