{-# LANGUAGE CPP, DeriveDataTypeable #-}
module GHC.Core.DataCon (
DataCon, DataConRep(..),
SrcStrictness(..), SrcUnpackedness(..),
HsSrcBang(..), HsImplBang(..),
StrictnessMark(..),
ConTag,
EqSpec, mkEqSpec, eqSpecTyVar, eqSpecType,
eqSpecPair, eqSpecPreds,
substEqSpec, filterEqSpec,
FieldLabel(..), FieldLabelString,
mkDataCon, fIRST_TAG,
dataConRepType, dataConInstSig, dataConFullSig,
dataConName, dataConIdentity, dataConTag, dataConTagZ,
dataConTyCon, dataConOrigTyCon,
dataConWrapperType,
dataConNonlinearType,
dataConDisplayType,
dataConUnivTyVars, dataConExTyCoVars, dataConUnivAndExTyCoVars,
dataConUserTyVars, dataConUserTyVarBinders,
dataConEqSpec, dataConTheta,
dataConStupidTheta,
dataConOtherTheta,
dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
dataConInstOrigArgTys, dataConRepArgTys,
dataConFieldLabels, dataConFieldType, dataConFieldType_maybe,
dataConSrcBangs,
dataConSourceArity, dataConRepArity,
dataConIsInfix,
dataConWorkId, dataConWrapId, dataConWrapId_maybe,
dataConImplicitTyThings,
dataConRepStrictness, dataConImplBangs, dataConBoxer,
splitDataProductType_maybe,
isNullarySrcDataCon, isNullaryRepDataCon,
isTupleDataCon, isBoxedTupleDataCon, isUnboxedTupleDataCon,
isUnboxedSumDataCon,
isVanillaDataCon, isNewDataCon, classDataCon, dataConCannotMatch,
dataConUserTyVarsArePermuted,
isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked,
specialPromotedDc,
promoteDataCon
) where
#include "HsVersions.h"
import GHC.Prelude
import {-# SOURCE #-} GHC.Types.Id.Make ( DataConBoxer )
import GHC.Core.Type as Type
import GHC.Core.Coercion
import GHC.Core.Unify
import GHC.Core.TyCon
import GHC.Core.Multiplicity
import {-# SOURCE #-} GHC.Types.TyThing
import GHC.Types.FieldLabel
import GHC.Types.SourceText
import GHC.Core.Class
import GHC.Types.Name
import GHC.Builtin.Names
import GHC.Core.Predicate
import GHC.Types.Var
import GHC.Types.Basic
import GHC.Data.FastString
import GHC.Unit.Types
import GHC.Unit.Module.Name
import GHC.Utils.Binary
import GHC.Types.Unique.Set
import GHC.Builtin.Uniques( mkAlphaTyVarUnique )
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import Data.ByteString (ByteString)
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Data as Data
import Data.Char
import Data.List( find )
data DataCon
= MkData {
DataCon -> Name
dcName :: Name,
DataCon -> Unique
dcUnique :: Unique,
DataCon -> Arity
dcTag :: ConTag,
DataCon -> Bool
dcVanilla :: Bool,
DataCon -> [TyVar]
dcUnivTyVars :: [TyVar],
DataCon -> [TyVar]
dcExTyCoVars :: [TyCoVar],
DataCon -> [InvisTVBinder]
dcUserTyVarBinders :: [InvisTVBinder],
DataCon -> [EqSpec]
dcEqSpec :: [EqSpec],
DataCon -> [Type]
dcOtherTheta :: ThetaType,
DataCon -> [Type]
dcStupidTheta :: ThetaType,
DataCon -> [Scaled Type]
dcOrigArgTys :: [Scaled Type],
DataCon -> Type
dcOrigResTy :: Type,
DataCon -> [HsSrcBang]
dcSrcBangs :: [HsSrcBang],
DataCon -> [FieldLabel]
dcFields :: [FieldLabel],
DataCon -> TyVar
dcWorkId :: Id,
DataCon -> DataConRep
dcRep :: DataConRep,
DataCon -> Arity
dcRepArity :: Arity,
DataCon -> Arity
dcSourceArity :: Arity,
DataCon -> TyCon
dcRepTyCon :: TyCon,
DataCon -> Type
dcRepType :: Type,
DataCon -> Bool
dcInfix :: Bool,
DataCon -> TyCon
dcPromoted :: TyCon
}
data DataConRep
=
NoDataConRep
| DCR { DataConRep -> TyVar
dcr_wrap_id :: Id
, DataConRep -> DataConBoxer
dcr_boxer :: DataConBoxer
, DataConRep -> [Scaled Type]
dcr_arg_tys :: [Scaled Type]
, DataConRep -> [StrictnessMark]
dcr_stricts :: [StrictnessMark]
, DataConRep -> [HsImplBang]
dcr_bangs :: [HsImplBang]
}
data HsSrcBang =
HsSrcBang SourceText
SrcUnpackedness
SrcStrictness
deriving Typeable HsSrcBang
HsSrcBang -> DataType
HsSrcBang -> Constr
(forall b. Data b => b -> b) -> HsSrcBang -> HsSrcBang
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Arity -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Arity -> (forall d. Data d => d -> u) -> HsSrcBang -> u
forall u. (forall d. Data d => d -> u) -> HsSrcBang -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsSrcBang -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsSrcBang -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsSrcBang -> m HsSrcBang
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsSrcBang -> m HsSrcBang
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsSrcBang
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsSrcBang -> c HsSrcBang
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsSrcBang)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsSrcBang)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsSrcBang -> m HsSrcBang
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsSrcBang -> m HsSrcBang
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsSrcBang -> m HsSrcBang
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsSrcBang -> m HsSrcBang
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsSrcBang -> m HsSrcBang
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsSrcBang -> m HsSrcBang
gmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> HsSrcBang -> u
$cgmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> HsSrcBang -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsSrcBang -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HsSrcBang -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsSrcBang -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsSrcBang -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsSrcBang -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsSrcBang -> r
gmapT :: (forall b. Data b => b -> b) -> HsSrcBang -> HsSrcBang
$cgmapT :: (forall b. Data b => b -> b) -> HsSrcBang -> HsSrcBang
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsSrcBang)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsSrcBang)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsSrcBang)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsSrcBang)
dataTypeOf :: HsSrcBang -> DataType
$cdataTypeOf :: HsSrcBang -> DataType
toConstr :: HsSrcBang -> Constr
$ctoConstr :: HsSrcBang -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsSrcBang
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsSrcBang
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsSrcBang -> c HsSrcBang
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsSrcBang -> c HsSrcBang
Data.Data
data HsImplBang
= HsLazy
| HsStrict
| HsUnpack (Maybe Coercion)
deriving Typeable HsImplBang
HsImplBang -> DataType
HsImplBang -> Constr
(forall b. Data b => b -> b) -> HsImplBang -> HsImplBang
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Arity -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Arity -> (forall d. Data d => d -> u) -> HsImplBang -> u
forall u. (forall d. Data d => d -> u) -> HsImplBang -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsImplBang -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsImplBang -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsImplBang -> m HsImplBang
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsImplBang -> m HsImplBang
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsImplBang
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsImplBang -> c HsImplBang
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsImplBang)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsImplBang)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsImplBang -> m HsImplBang
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsImplBang -> m HsImplBang
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsImplBang -> m HsImplBang
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsImplBang -> m HsImplBang
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsImplBang -> m HsImplBang
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsImplBang -> m HsImplBang
gmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> HsImplBang -> u
$cgmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> HsImplBang -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsImplBang -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HsImplBang -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsImplBang -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsImplBang -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsImplBang -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsImplBang -> r
gmapT :: (forall b. Data b => b -> b) -> HsImplBang -> HsImplBang
$cgmapT :: (forall b. Data b => b -> b) -> HsImplBang -> HsImplBang
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsImplBang)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsImplBang)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsImplBang)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsImplBang)
dataTypeOf :: HsImplBang -> DataType
$cdataTypeOf :: HsImplBang -> DataType
toConstr :: HsImplBang -> Constr
$ctoConstr :: HsImplBang -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsImplBang
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsImplBang
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsImplBang -> c HsImplBang
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsImplBang -> c HsImplBang
Data.Data
data SrcStrictness = SrcLazy
| SrcStrict
| NoSrcStrict
deriving (SrcStrictness -> SrcStrictness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcStrictness -> SrcStrictness -> Bool
$c/= :: SrcStrictness -> SrcStrictness -> Bool
== :: SrcStrictness -> SrcStrictness -> Bool
$c== :: SrcStrictness -> SrcStrictness -> Bool
Eq, Typeable SrcStrictness
SrcStrictness -> DataType
SrcStrictness -> Constr
(forall b. Data b => b -> b) -> SrcStrictness -> SrcStrictness
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Arity -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Arity -> (forall d. Data d => d -> u) -> SrcStrictness -> u
forall u. (forall d. Data d => d -> u) -> SrcStrictness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcStrictness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcStrictness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcStrictness -> m SrcStrictness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcStrictness -> m SrcStrictness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcStrictness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcStrictness -> c SrcStrictness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcStrictness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcStrictness)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcStrictness -> m SrcStrictness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcStrictness -> m SrcStrictness
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcStrictness -> m SrcStrictness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcStrictness -> m SrcStrictness
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcStrictness -> m SrcStrictness
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcStrictness -> m SrcStrictness
gmapQi :: forall u.
Arity -> (forall d. Data d => d -> u) -> SrcStrictness -> u
$cgmapQi :: forall u.
Arity -> (forall d. Data d => d -> u) -> SrcStrictness -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SrcStrictness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcStrictness -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcStrictness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcStrictness -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcStrictness -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcStrictness -> r
gmapT :: (forall b. Data b => b -> b) -> SrcStrictness -> SrcStrictness
$cgmapT :: (forall b. Data b => b -> b) -> SrcStrictness -> SrcStrictness
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcStrictness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcStrictness)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcStrictness)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcStrictness)
dataTypeOf :: SrcStrictness -> DataType
$cdataTypeOf :: SrcStrictness -> DataType
toConstr :: SrcStrictness -> Constr
$ctoConstr :: SrcStrictness -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcStrictness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcStrictness
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcStrictness -> c SrcStrictness
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcStrictness -> c SrcStrictness
Data.Data)
data SrcUnpackedness = SrcUnpack
| SrcNoUnpack
| NoSrcUnpack
deriving (SrcUnpackedness -> SrcUnpackedness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcUnpackedness -> SrcUnpackedness -> Bool
$c/= :: SrcUnpackedness -> SrcUnpackedness -> Bool
== :: SrcUnpackedness -> SrcUnpackedness -> Bool
$c== :: SrcUnpackedness -> SrcUnpackedness -> Bool
Eq, Typeable SrcUnpackedness
SrcUnpackedness -> DataType
SrcUnpackedness -> Constr
(forall b. Data b => b -> b) -> SrcUnpackedness -> SrcUnpackedness
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Arity -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Arity -> (forall d. Data d => d -> u) -> SrcUnpackedness -> u
forall u. (forall d. Data d => d -> u) -> SrcUnpackedness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcUnpackedness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcUnpackedness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SrcUnpackedness -> m SrcUnpackedness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SrcUnpackedness -> m SrcUnpackedness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcUnpackedness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcUnpackedness -> c SrcUnpackedness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcUnpackedness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcUnpackedness)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SrcUnpackedness -> m SrcUnpackedness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SrcUnpackedness -> m SrcUnpackedness
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SrcUnpackedness -> m SrcUnpackedness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SrcUnpackedness -> m SrcUnpackedness
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SrcUnpackedness -> m SrcUnpackedness
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SrcUnpackedness -> m SrcUnpackedness
gmapQi :: forall u.
Arity -> (forall d. Data d => d -> u) -> SrcUnpackedness -> u
$cgmapQi :: forall u.
Arity -> (forall d. Data d => d -> u) -> SrcUnpackedness -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SrcUnpackedness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcUnpackedness -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcUnpackedness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcUnpackedness -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcUnpackedness -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcUnpackedness -> r
gmapT :: (forall b. Data b => b -> b) -> SrcUnpackedness -> SrcUnpackedness
$cgmapT :: (forall b. Data b => b -> b) -> SrcUnpackedness -> SrcUnpackedness
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcUnpackedness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcUnpackedness)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcUnpackedness)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcUnpackedness)
dataTypeOf :: SrcUnpackedness -> DataType
$cdataTypeOf :: SrcUnpackedness -> DataType
toConstr :: SrcUnpackedness -> Constr
$ctoConstr :: SrcUnpackedness -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcUnpackedness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcUnpackedness
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcUnpackedness -> c SrcUnpackedness
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcUnpackedness -> c SrcUnpackedness
Data.Data)
data StrictnessMark = MarkedStrict | NotMarkedStrict
data EqSpec = EqSpec TyVar
Type
mkEqSpec :: TyVar -> Type -> EqSpec
mkEqSpec :: TyVar -> Type -> EqSpec
mkEqSpec TyVar
tv Type
ty = TyVar -> Type -> EqSpec
EqSpec TyVar
tv Type
ty
eqSpecTyVar :: EqSpec -> TyVar
eqSpecTyVar :: EqSpec -> TyVar
eqSpecTyVar (EqSpec TyVar
tv Type
_) = TyVar
tv
eqSpecType :: EqSpec -> Type
eqSpecType :: EqSpec -> Type
eqSpecType (EqSpec TyVar
_ Type
ty) = Type
ty
eqSpecPair :: EqSpec -> (TyVar, Type)
eqSpecPair :: EqSpec -> (TyVar, Type)
eqSpecPair (EqSpec TyVar
tv Type
ty) = (TyVar
tv, Type
ty)
eqSpecPreds :: [EqSpec] -> ThetaType
eqSpecPreds :: [EqSpec] -> [Type]
eqSpecPreds [EqSpec]
spec = [ Type -> Type -> Type
mkPrimEqPred (TyVar -> Type
mkTyVarTy TyVar
tv) Type
ty
| EqSpec TyVar
tv Type
ty <- [EqSpec]
spec ]
substEqSpec :: TCvSubst -> EqSpec -> EqSpec
substEqSpec :: TCvSubst -> EqSpec -> EqSpec
substEqSpec TCvSubst
subst (EqSpec TyVar
tv Type
ty)
= TyVar -> Type -> EqSpec
EqSpec TyVar
tv' (HasCallStack => TCvSubst -> Type -> Type
substTy TCvSubst
subst Type
ty)
where
tv' :: TyVar
tv' = String -> Type -> TyVar
getTyVar String
"substEqSpec" (TCvSubst -> TyVar -> Type
substTyVar TCvSubst
subst TyVar
tv)
filterEqSpec :: [EqSpec] -> [TyVar] -> [TyVar]
filterEqSpec :: [EqSpec] -> [TyVar] -> [TyVar]
filterEqSpec [EqSpec]
eq_spec
= forall a. (a -> Bool) -> [a] -> [a]
filter TyVar -> Bool
not_in_eq_spec
where
not_in_eq_spec :: TyVar -> Bool
not_in_eq_spec TyVar
var = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== TyVar
var) forall b c a. (b -> c) -> (a -> b) -> a -> c
. EqSpec -> TyVar
eqSpecTyVar) [EqSpec]
eq_spec
instance Outputable EqSpec where
ppr :: EqSpec -> SDoc
ppr (EqSpec TyVar
tv Type
ty) = forall a. Outputable a => a -> SDoc
ppr (TyVar
tv, Type
ty)
instance Eq DataCon where
DataCon
a == :: DataCon -> DataCon -> Bool
== DataCon
b = forall a. Uniquable a => a -> Unique
getUnique DataCon
a forall a. Eq a => a -> a -> Bool
== forall a. Uniquable a => a -> Unique
getUnique DataCon
b
DataCon
a /= :: DataCon -> DataCon -> Bool
/= DataCon
b = forall a. Uniquable a => a -> Unique
getUnique DataCon
a forall a. Eq a => a -> a -> Bool
/= forall a. Uniquable a => a -> Unique
getUnique DataCon
b
instance Uniquable DataCon where
getUnique :: DataCon -> Unique
getUnique = DataCon -> Unique
dcUnique
instance NamedThing DataCon where
getName :: DataCon -> Name
getName = DataCon -> Name
dcName
instance Outputable DataCon where
ppr :: DataCon -> SDoc
ppr DataCon
con = forall a. Outputable a => a -> SDoc
ppr (DataCon -> Name
dataConName DataCon
con)
instance OutputableBndr DataCon where
pprInfixOcc :: DataCon -> SDoc
pprInfixOcc DataCon
con = forall a. (Outputable a, NamedThing a) => a -> SDoc
pprInfixName (DataCon -> Name
dataConName DataCon
con)
pprPrefixOcc :: DataCon -> SDoc
pprPrefixOcc DataCon
con = forall a. NamedThing a => a -> SDoc
pprPrefixName (DataCon -> Name
dataConName DataCon
con)
instance Data.Data DataCon where
toConstr :: DataCon -> Constr
toConstr DataCon
_ = String -> Constr
abstractConstr String
"DataCon"
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataCon
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: DataCon -> DataType
dataTypeOf DataCon
_ = String -> DataType
mkNoRepType String
"DataCon"
instance Outputable HsSrcBang where
ppr :: HsSrcBang -> SDoc
ppr (HsSrcBang SourceText
_ SrcUnpackedness
prag SrcStrictness
mark) = forall a. Outputable a => a -> SDoc
ppr SrcUnpackedness
prag SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr SrcStrictness
mark
instance Outputable HsImplBang where
ppr :: HsImplBang -> SDoc
ppr HsImplBang
HsLazy = String -> SDoc
text String
"Lazy"
ppr (HsUnpack Maybe Coercion
Nothing) = String -> SDoc
text String
"Unpacked"
ppr (HsUnpack (Just Coercion
co)) = String -> SDoc
text String
"Unpacked" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens (forall a. Outputable a => a -> SDoc
ppr Coercion
co)
ppr HsImplBang
HsStrict = String -> SDoc
text String
"StrictNotUnpacked"
instance Outputable SrcStrictness where
ppr :: SrcStrictness -> SDoc
ppr SrcStrictness
SrcLazy = Char -> SDoc
char Char
'~'
ppr SrcStrictness
SrcStrict = Char -> SDoc
char Char
'!'
ppr SrcStrictness
NoSrcStrict = SDoc
empty
instance Outputable SrcUnpackedness where
ppr :: SrcUnpackedness -> SDoc
ppr SrcUnpackedness
SrcUnpack = String -> SDoc
text String
"{-# UNPACK #-}"
ppr SrcUnpackedness
SrcNoUnpack = String -> SDoc
text String
"{-# NOUNPACK #-}"
ppr SrcUnpackedness
NoSrcUnpack = SDoc
empty
instance Outputable StrictnessMark where
ppr :: StrictnessMark -> SDoc
ppr StrictnessMark
MarkedStrict = String -> SDoc
text String
"!"
ppr StrictnessMark
NotMarkedStrict = SDoc
empty
instance Binary SrcStrictness where
put_ :: BinHandle -> SrcStrictness -> IO ()
put_ BinHandle
bh SrcStrictness
SrcLazy = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh SrcStrictness
SrcStrict = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
put_ BinHandle
bh SrcStrictness
NoSrcStrict = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
get :: BinHandle -> IO SrcStrictness
get BinHandle
bh =
do Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return SrcStrictness
SrcLazy
Word8
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return SrcStrictness
SrcStrict
Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return SrcStrictness
NoSrcStrict
instance Binary SrcUnpackedness where
put_ :: BinHandle -> SrcUnpackedness -> IO ()
put_ BinHandle
bh SrcUnpackedness
SrcNoUnpack = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh SrcUnpackedness
SrcUnpack = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
put_ BinHandle
bh SrcUnpackedness
NoSrcUnpack = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
get :: BinHandle -> IO SrcUnpackedness
get BinHandle
bh =
do Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return SrcUnpackedness
SrcNoUnpack
Word8
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return SrcUnpackedness
SrcUnpack
Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return SrcUnpackedness
NoSrcUnpack
eqHsBang :: HsImplBang -> HsImplBang -> Bool
eqHsBang :: HsImplBang -> HsImplBang -> Bool
eqHsBang HsImplBang
HsLazy HsImplBang
HsLazy = Bool
True
eqHsBang HsImplBang
HsStrict HsImplBang
HsStrict = Bool
True
eqHsBang (HsUnpack Maybe Coercion
Nothing) (HsUnpack Maybe Coercion
Nothing) = Bool
True
eqHsBang (HsUnpack (Just Coercion
c1)) (HsUnpack (Just Coercion
c2))
= Type -> Type -> Bool
eqType (Coercion -> Type
coercionType Coercion
c1) (Coercion -> Type
coercionType Coercion
c2)
eqHsBang HsImplBang
_ HsImplBang
_ = Bool
False
isBanged :: HsImplBang -> Bool
isBanged :: HsImplBang -> Bool
isBanged (HsUnpack {}) = Bool
True
isBanged (HsStrict {}) = Bool
True
isBanged HsImplBang
HsLazy = Bool
False
isSrcStrict :: SrcStrictness -> Bool
isSrcStrict :: SrcStrictness -> Bool
isSrcStrict SrcStrictness
SrcStrict = Bool
True
isSrcStrict SrcStrictness
_ = Bool
False
isSrcUnpacked :: SrcUnpackedness -> Bool
isSrcUnpacked :: SrcUnpackedness -> Bool
isSrcUnpacked SrcUnpackedness
SrcUnpack = Bool
True
isSrcUnpacked SrcUnpackedness
_ = Bool
False
isMarkedStrict :: StrictnessMark -> Bool
isMarkedStrict :: StrictnessMark -> Bool
isMarkedStrict StrictnessMark
NotMarkedStrict = Bool
False
isMarkedStrict StrictnessMark
_ = Bool
True
mkDataCon :: Name
-> Bool
-> TyConRepName
-> [HsSrcBang]
-> [FieldLabel]
-> [TyVar]
-> [TyCoVar]
-> [InvisTVBinder]
-> [EqSpec]
-> KnotTied ThetaType
-> [KnotTied (Scaled Type)]
-> KnotTied Type
-> RuntimeRepInfo
-> KnotTied TyCon
-> ConTag
-> ThetaType
-> Id
-> DataConRep
-> DataCon
mkDataCon :: Name
-> Bool
-> Name
-> [HsSrcBang]
-> [FieldLabel]
-> [TyVar]
-> [TyVar]
-> [InvisTVBinder]
-> [EqSpec]
-> [Type]
-> [Scaled Type]
-> Type
-> RuntimeRepInfo
-> TyCon
-> Arity
-> [Type]
-> TyVar
-> DataConRep
-> DataCon
mkDataCon Name
name Bool
declared_infix Name
prom_info
[HsSrcBang]
arg_stricts
[FieldLabel]
fields
[TyVar]
univ_tvs [TyVar]
ex_tvs [InvisTVBinder]
user_tvbs
[EqSpec]
eq_spec [Type]
theta
[Scaled Type]
orig_arg_tys Type
orig_res_ty RuntimeRepInfo
rep_info TyCon
rep_tycon Arity
tag
[Type]
stupid_theta TyVar
work_id DataConRep
rep
= DataCon
con
where
is_vanilla :: Bool
is_vanilla = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
ex_tvs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EqSpec]
eq_spec Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
theta
con :: DataCon
con = MkData {dcName :: Name
dcName = Name
name, dcUnique :: Unique
dcUnique = Name -> Unique
nameUnique Name
name,
dcVanilla :: Bool
dcVanilla = Bool
is_vanilla, dcInfix :: Bool
dcInfix = Bool
declared_infix,
dcUnivTyVars :: [TyVar]
dcUnivTyVars = [TyVar]
univ_tvs,
dcExTyCoVars :: [TyVar]
dcExTyCoVars = [TyVar]
ex_tvs,
dcUserTyVarBinders :: [InvisTVBinder]
dcUserTyVarBinders = [InvisTVBinder]
user_tvbs,
dcEqSpec :: [EqSpec]
dcEqSpec = [EqSpec]
eq_spec,
dcOtherTheta :: [Type]
dcOtherTheta = [Type]
theta,
dcStupidTheta :: [Type]
dcStupidTheta = [Type]
stupid_theta,
dcOrigArgTys :: [Scaled Type]
dcOrigArgTys = [Scaled Type]
orig_arg_tys, dcOrigResTy :: Type
dcOrigResTy = Type
orig_res_ty,
dcRepTyCon :: TyCon
dcRepTyCon = TyCon
rep_tycon,
dcSrcBangs :: [HsSrcBang]
dcSrcBangs = [HsSrcBang]
arg_stricts,
dcFields :: [FieldLabel]
dcFields = [FieldLabel]
fields, dcTag :: Arity
dcTag = Arity
tag, dcRepType :: Type
dcRepType = Type
rep_ty,
dcWorkId :: TyVar
dcWorkId = TyVar
work_id,
dcRep :: DataConRep
dcRep = DataConRep
rep,
dcSourceArity :: Arity
dcSourceArity = forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Scaled Type]
orig_arg_tys,
dcRepArity :: Arity
dcRepArity = forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Scaled Type]
rep_arg_tys forall a. Num a => a -> a -> a
+ forall a. (a -> Bool) -> [a] -> Arity
count TyVar -> Bool
isCoVar [TyVar]
ex_tvs,
dcPromoted :: TyCon
dcPromoted = TyCon
promoted }
rep_arg_tys :: [Scaled Type]
rep_arg_tys = DataCon -> [Scaled Type]
dataConRepArgTys DataCon
con
rep_ty :: Type
rep_ty =
case DataConRep
rep of
DataConRep
NoDataConRep -> DataCon -> Type
dataConWrapperType DataCon
con
DCR{} -> [TyVar] -> Type -> Type
mkInfForAllTys [TyVar]
univ_tvs forall a b. (a -> b) -> a -> b
$ [TyVar] -> Type -> Type
mkTyCoInvForAllTys [TyVar]
ex_tvs forall a b. (a -> b) -> a -> b
$
[Scaled Type] -> Type -> Type
mkVisFunTys [Scaled Type]
rep_arg_tys forall a b. (a -> b) -> a -> b
$
TyCon -> [Type] -> Type
mkTyConApp TyCon
rep_tycon ([TyVar] -> [Type]
mkTyVarTys [TyVar]
univ_tvs)
prom_tv_bndrs :: [TyConBinder]
prom_tv_bndrs = [ ArgFlag -> TyVar -> TyConBinder
mkNamedTyConBinder (Specificity -> ArgFlag
Invisible Specificity
spec) TyVar
tv
| Bndr TyVar
tv Specificity
spec <- [InvisTVBinder]
user_tvbs ]
fresh_names :: [Name]
fresh_names = [Name] -> [Name]
freshNames (forall a b. (a -> b) -> [a] -> [b]
map forall a. NamedThing a => a -> Name
getName [InvisTVBinder]
user_tvbs)
prom_theta_bndrs :: [TyConBinder]
prom_theta_bndrs = [ AnonArgFlag -> TyVar -> TyConBinder
mkAnonTyConBinder AnonArgFlag
InvisArg (Name -> Type -> TyVar
mkTyVar Name
n Type
t)
| (Name
n,Type
t) <- [Name]
fresh_names forall a b. [a] -> [b] -> [(a, b)]
`zip` [Type]
theta ]
prom_arg_bndrs :: [TyConBinder]
prom_arg_bndrs = [ AnonArgFlag -> TyVar -> TyConBinder
mkAnonTyConBinder AnonArgFlag
VisArg (Name -> Type -> TyVar
mkTyVar Name
n Type
t)
| (Name
n,Type
t) <- forall b a. [b] -> [a] -> [a]
dropList [Type]
theta [Name]
fresh_names forall a b. [a] -> [b] -> [(a, b)]
`zip` forall a b. (a -> b) -> [a] -> [b]
map forall a. Scaled a -> a
scaledThing [Scaled Type]
orig_arg_tys ]
prom_bndrs :: [TyConBinder]
prom_bndrs = [TyConBinder]
prom_tv_bndrs forall a. [a] -> [a] -> [a]
++ [TyConBinder]
prom_theta_bndrs forall a. [a] -> [a] -> [a]
++ [TyConBinder]
prom_arg_bndrs
prom_res_kind :: Type
prom_res_kind = Type
orig_res_ty
promoted :: TyCon
promoted = DataCon
-> Name
-> Name
-> [TyConBinder]
-> Type
-> [Role]
-> RuntimeRepInfo
-> TyCon
mkPromotedDataCon DataCon
con Name
name Name
prom_info [TyConBinder]
prom_bndrs
Type
prom_res_kind [Role]
roles RuntimeRepInfo
rep_info
roles :: [Role]
roles = forall a b. (a -> b) -> [a] -> [b]
map (\TyVar
tv -> if TyVar -> Bool
isTyVar TyVar
tv then Role
Nominal else Role
Phantom)
([TyVar]
univ_tvs forall a. [a] -> [a] -> [a]
++ [TyVar]
ex_tvs)
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const Role
Representational) ([Type]
theta forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. Scaled a -> a
scaledThing [Scaled Type]
orig_arg_tys)
freshNames :: [Name] -> [Name]
freshNames :: [Name] -> [Name]
freshNames [Name]
avoids
= [ Unique -> OccName -> Name
mkSystemName Unique
uniq OccName
occ
| Arity
n <- [Arity
0..]
, let uniq :: Unique
uniq = Arity -> Unique
mkAlphaTyVarUnique Arity
n
occ :: OccName
occ = FieldLabelString -> OccName
mkTyVarOccFS (String -> FieldLabelString
mkFastString (Char
'x' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Arity
n))
, Bool -> Bool
not (Unique
uniq forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` UniqSet Unique
avoid_uniqs)
, Bool -> Bool
not (OccName
occ OccName -> OccSet -> Bool
`elemOccSet` OccSet
avoid_occs) ]
where
avoid_uniqs :: UniqSet Unique
avoid_uniqs :: UniqSet Unique
avoid_uniqs = forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet (forall a b. (a -> b) -> [a] -> [b]
map forall a. Uniquable a => a -> Unique
getUnique [Name]
avoids)
avoid_occs :: OccSet
avoid_occs :: OccSet
avoid_occs = [OccName] -> OccSet
mkOccSet (forall a b. (a -> b) -> [a] -> [b]
map forall a. NamedThing a => a -> OccName
getOccName [Name]
avoids)
dataConName :: DataCon -> Name
dataConName :: DataCon -> Name
dataConName = DataCon -> Name
dcName
dataConTag :: DataCon -> ConTag
dataConTag :: DataCon -> Arity
dataConTag = DataCon -> Arity
dcTag
dataConTagZ :: DataCon -> ConTagZ
dataConTagZ :: DataCon -> Arity
dataConTagZ DataCon
con = DataCon -> Arity
dataConTag DataCon
con forall a. Num a => a -> a -> a
- Arity
fIRST_TAG
dataConTyCon :: DataCon -> TyCon
dataConTyCon :: DataCon -> TyCon
dataConTyCon = DataCon -> TyCon
dcRepTyCon
dataConOrigTyCon :: DataCon -> TyCon
dataConOrigTyCon :: DataCon -> TyCon
dataConOrigTyCon DataCon
dc
| Just (TyCon
tc, [Type]
_) <- TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe (DataCon -> TyCon
dcRepTyCon DataCon
dc) = TyCon
tc
| Bool
otherwise = DataCon -> TyCon
dcRepTyCon DataCon
dc
dataConRepType :: DataCon -> Type
dataConRepType :: DataCon -> Type
dataConRepType = DataCon -> Type
dcRepType
dataConIsInfix :: DataCon -> Bool
dataConIsInfix :: DataCon -> Bool
dataConIsInfix = DataCon -> Bool
dcInfix
dataConUnivTyVars :: DataCon -> [TyVar]
dataConUnivTyVars :: DataCon -> [TyVar]
dataConUnivTyVars (MkData { dcUnivTyVars :: DataCon -> [TyVar]
dcUnivTyVars = [TyVar]
tvbs }) = [TyVar]
tvbs
dataConExTyCoVars :: DataCon -> [TyCoVar]
dataConExTyCoVars :: DataCon -> [TyVar]
dataConExTyCoVars (MkData { dcExTyCoVars :: DataCon -> [TyVar]
dcExTyCoVars = [TyVar]
tvbs }) = [TyVar]
tvbs
dataConUnivAndExTyCoVars :: DataCon -> [TyCoVar]
dataConUnivAndExTyCoVars :: DataCon -> [TyVar]
dataConUnivAndExTyCoVars (MkData { dcUnivTyVars :: DataCon -> [TyVar]
dcUnivTyVars = [TyVar]
univ_tvs, dcExTyCoVars :: DataCon -> [TyVar]
dcExTyCoVars = [TyVar]
ex_tvs })
= [TyVar]
univ_tvs forall a. [a] -> [a] -> [a]
++ [TyVar]
ex_tvs
dataConUserTyVars :: DataCon -> [TyVar]
dataConUserTyVars :: DataCon -> [TyVar]
dataConUserTyVars (MkData { dcUserTyVarBinders :: DataCon -> [InvisTVBinder]
dcUserTyVarBinders = [InvisTVBinder]
tvbs }) = forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [InvisTVBinder]
tvbs
dataConUserTyVarBinders :: DataCon -> [InvisTVBinder]
dataConUserTyVarBinders :: DataCon -> [InvisTVBinder]
dataConUserTyVarBinders = DataCon -> [InvisTVBinder]
dcUserTyVarBinders
dataConEqSpec :: DataCon -> [EqSpec]
dataConEqSpec :: DataCon -> [EqSpec]
dataConEqSpec con :: DataCon
con@(MkData { dcEqSpec :: DataCon -> [EqSpec]
dcEqSpec = [EqSpec]
eq_spec, dcOtherTheta :: DataCon -> [Type]
dcOtherTheta = [Type]
theta })
= DataCon -> [EqSpec]
dataConKindEqSpec DataCon
con
forall a. [a] -> [a] -> [a]
++ [EqSpec]
eq_spec forall a. [a] -> [a] -> [a]
++
[ EqSpec
spec
| Just (TyCon
tc, [Type
_k1, Type
_k2, Type
ty1, Type
ty2]) <- forall a b. (a -> b) -> [a] -> [b]
map HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe [Type]
theta
, TyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey
, EqSpec
spec <- case (Type -> Maybe TyVar
getTyVar_maybe Type
ty1, Type -> Maybe TyVar
getTyVar_maybe Type
ty2) of
(Just TyVar
tv1, Maybe TyVar
_) -> [TyVar -> Type -> EqSpec
mkEqSpec TyVar
tv1 Type
ty2]
(Maybe TyVar
_, Just TyVar
tv2) -> [TyVar -> Type -> EqSpec
mkEqSpec TyVar
tv2 Type
ty1]
(Maybe TyVar, Maybe TyVar)
_ -> []
] forall a. [a] -> [a] -> [a]
++
[ EqSpec
spec
| Just (TyCon
tc, [Type
_k, Type
ty1, Type
ty2]) <- forall a b. (a -> b) -> [a] -> [b]
map HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe [Type]
theta
, TyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey
, EqSpec
spec <- case (Type -> Maybe TyVar
getTyVar_maybe Type
ty1, Type -> Maybe TyVar
getTyVar_maybe Type
ty2) of
(Just TyVar
tv1, Maybe TyVar
_) -> [TyVar -> Type -> EqSpec
mkEqSpec TyVar
tv1 Type
ty2]
(Maybe TyVar
_, Just TyVar
tv2) -> [TyVar -> Type -> EqSpec
mkEqSpec TyVar
tv2 Type
ty1]
(Maybe TyVar, Maybe TyVar)
_ -> []
]
dataConKindEqSpec :: DataCon -> [EqSpec]
dataConKindEqSpec :: DataCon -> [EqSpec]
dataConKindEqSpec (MkData {dcExTyCoVars :: DataCon -> [TyVar]
dcExTyCoVars = [TyVar]
ex_tcvs})
= [ TyVar -> Type -> EqSpec
EqSpec TyVar
tv Type
ty
| TyVar
cv <- [TyVar]
ex_tcvs
, TyVar -> Bool
isCoVar TyVar
cv
, let (Type
_, Type
_, Type
ty1, Type
ty, Role
_) = HasDebugCallStack => TyVar -> (Type, Type, Type, Type, Role)
coVarKindsTypesRole TyVar
cv
tv :: TyVar
tv = String -> Type -> TyVar
getTyVar String
"dataConKindEqSpec" Type
ty1
]
dataConTheta :: DataCon -> ThetaType
dataConTheta :: DataCon -> [Type]
dataConTheta con :: DataCon
con@(MkData { dcEqSpec :: DataCon -> [EqSpec]
dcEqSpec = [EqSpec]
eq_spec, dcOtherTheta :: DataCon -> [Type]
dcOtherTheta = [Type]
theta })
= [EqSpec] -> [Type]
eqSpecPreds (DataCon -> [EqSpec]
dataConKindEqSpec DataCon
con forall a. [a] -> [a] -> [a]
++ [EqSpec]
eq_spec) forall a. [a] -> [a] -> [a]
++ [Type]
theta
dataConWorkId :: DataCon -> Id
dataConWorkId :: DataCon -> TyVar
dataConWorkId DataCon
dc = DataCon -> TyVar
dcWorkId DataCon
dc
dataConWrapId_maybe :: DataCon -> Maybe Id
dataConWrapId_maybe :: DataCon -> Maybe TyVar
dataConWrapId_maybe DataCon
dc = case DataCon -> DataConRep
dcRep DataCon
dc of
DataConRep
NoDataConRep -> forall a. Maybe a
Nothing
DCR { dcr_wrap_id :: DataConRep -> TyVar
dcr_wrap_id = TyVar
wrap_id } -> forall a. a -> Maybe a
Just TyVar
wrap_id
dataConWrapId :: DataCon -> Id
dataConWrapId :: DataCon -> TyVar
dataConWrapId DataCon
dc = case DataCon -> DataConRep
dcRep DataCon
dc of
DataConRep
NoDataConRep-> DataCon -> TyVar
dcWorkId DataCon
dc
DCR { dcr_wrap_id :: DataConRep -> TyVar
dcr_wrap_id = TyVar
wrap_id } -> TyVar
wrap_id
dataConImplicitTyThings :: DataCon -> [TyThing]
dataConImplicitTyThings :: DataCon -> [TyThing]
dataConImplicitTyThings (MkData { dcWorkId :: DataCon -> TyVar
dcWorkId = TyVar
work, dcRep :: DataCon -> DataConRep
dcRep = DataConRep
rep })
= [TyVar -> TyThing
mkAnId TyVar
work] forall a. [a] -> [a] -> [a]
++ [TyThing]
wrap_ids
where
wrap_ids :: [TyThing]
wrap_ids = case DataConRep
rep of
DataConRep
NoDataConRep -> []
DCR { dcr_wrap_id :: DataConRep -> TyVar
dcr_wrap_id = TyVar
wrap } -> [TyVar -> TyThing
mkAnId TyVar
wrap]
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels = DataCon -> [FieldLabel]
dcFields
dataConFieldType :: DataCon -> FieldLabelString -> Type
dataConFieldType :: DataCon -> FieldLabelString -> Type
dataConFieldType DataCon
con FieldLabelString
label = case DataCon -> FieldLabelString -> Maybe (FieldLabel, Type)
dataConFieldType_maybe DataCon
con FieldLabelString
label of
Just (FieldLabel
_, Type
ty) -> Type
ty
Maybe (FieldLabel, Type)
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"dataConFieldType" (forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr FieldLabelString
label)
dataConFieldType_maybe :: DataCon -> FieldLabelString
-> Maybe (FieldLabel, Type)
dataConFieldType_maybe :: DataCon -> FieldLabelString -> Maybe (FieldLabel, Type)
dataConFieldType_maybe DataCon
con FieldLabelString
label
= forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== FieldLabelString
label) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FieldLabelString
flLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (DataCon -> [FieldLabel]
dcFields DataCon
con forall a b. [a] -> [b] -> [(a, b)]
`zip` (forall a. Scaled a -> a
scaledThing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataCon -> [Scaled Type]
dcOrigArgTys DataCon
con))
dataConSrcBangs :: DataCon -> [HsSrcBang]
dataConSrcBangs :: DataCon -> [HsSrcBang]
dataConSrcBangs = DataCon -> [HsSrcBang]
dcSrcBangs
dataConSourceArity :: DataCon -> Arity
dataConSourceArity :: DataCon -> Arity
dataConSourceArity (MkData { dcSourceArity :: DataCon -> Arity
dcSourceArity = Arity
arity }) = Arity
arity
dataConRepArity :: DataCon -> Arity
dataConRepArity :: DataCon -> Arity
dataConRepArity (MkData { dcRepArity :: DataCon -> Arity
dcRepArity = Arity
arity }) = Arity
arity
isNullarySrcDataCon :: DataCon -> Bool
isNullarySrcDataCon :: DataCon -> Bool
isNullarySrcDataCon DataCon
dc = DataCon -> Arity
dataConSourceArity DataCon
dc forall a. Eq a => a -> a -> Bool
== Arity
0
isNullaryRepDataCon :: DataCon -> Bool
isNullaryRepDataCon :: DataCon -> Bool
isNullaryRepDataCon DataCon
dc = DataCon -> Arity
dataConRepArity DataCon
dc forall a. Eq a => a -> a -> Bool
== Arity
0
dataConRepStrictness :: DataCon -> [StrictnessMark]
dataConRepStrictness :: DataCon -> [StrictnessMark]
dataConRepStrictness DataCon
dc = case DataCon -> DataConRep
dcRep DataCon
dc of
DataConRep
NoDataConRep -> [StrictnessMark
NotMarkedStrict | Scaled Type
_ <- DataCon -> [Scaled Type]
dataConRepArgTys DataCon
dc]
DCR { dcr_stricts :: DataConRep -> [StrictnessMark]
dcr_stricts = [StrictnessMark]
strs } -> [StrictnessMark]
strs
dataConImplBangs :: DataCon -> [HsImplBang]
dataConImplBangs :: DataCon -> [HsImplBang]
dataConImplBangs DataCon
dc
= case DataCon -> DataConRep
dcRep DataCon
dc of
DataConRep
NoDataConRep -> forall a. Arity -> a -> [a]
replicate (DataCon -> Arity
dcSourceArity DataCon
dc) HsImplBang
HsLazy
DCR { dcr_bangs :: DataConRep -> [HsImplBang]
dcr_bangs = [HsImplBang]
bangs } -> [HsImplBang]
bangs
dataConBoxer :: DataCon -> Maybe DataConBoxer
dataConBoxer :: DataCon -> Maybe DataConBoxer
dataConBoxer (MkData { dcRep :: DataCon -> DataConRep
dcRep = DCR { dcr_boxer :: DataConRep -> DataConBoxer
dcr_boxer = DataConBoxer
boxer } }) = forall a. a -> Maybe a
Just DataConBoxer
boxer
dataConBoxer DataCon
_ = forall a. Maybe a
Nothing
dataConInstSig
:: DataCon
-> [Type]
-> ([TyCoVar], ThetaType, [Type])
dataConInstSig :: DataCon -> [Type] -> ([TyVar], [Type], [Type])
dataConInstSig con :: DataCon
con@(MkData { dcUnivTyVars :: DataCon -> [TyVar]
dcUnivTyVars = [TyVar]
univ_tvs, dcExTyCoVars :: DataCon -> [TyVar]
dcExTyCoVars = [TyVar]
ex_tvs
, dcOrigArgTys :: DataCon -> [Scaled Type]
dcOrigArgTys = [Scaled Type]
arg_tys })
[Type]
univ_tys
= ( [TyVar]
ex_tvs'
, HasCallStack => TCvSubst -> [Type] -> [Type]
substTheta TCvSubst
subst (DataCon -> [Type]
dataConTheta DataCon
con)
, HasCallStack => TCvSubst -> [Type] -> [Type]
substTys TCvSubst
subst (forall a b. (a -> b) -> [a] -> [b]
map forall a. Scaled a -> a
scaledThing [Scaled Type]
arg_tys))
where
univ_subst :: TCvSubst
univ_subst = HasDebugCallStack => [TyVar] -> [Type] -> TCvSubst
zipTvSubst [TyVar]
univ_tvs [Type]
univ_tys
(TCvSubst
subst, [TyVar]
ex_tvs') = HasCallStack => TCvSubst -> [TyVar] -> (TCvSubst, [TyVar])
Type.substVarBndrs TCvSubst
univ_subst [TyVar]
ex_tvs
dataConFullSig :: DataCon
-> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Scaled Type], Type)
dataConFullSig :: DataCon
-> ([TyVar], [TyVar], [EqSpec], [Type], [Scaled Type], Type)
dataConFullSig (MkData {dcUnivTyVars :: DataCon -> [TyVar]
dcUnivTyVars = [TyVar]
univ_tvs, dcExTyCoVars :: DataCon -> [TyVar]
dcExTyCoVars = [TyVar]
ex_tvs,
dcEqSpec :: DataCon -> [EqSpec]
dcEqSpec = [EqSpec]
eq_spec, dcOtherTheta :: DataCon -> [Type]
dcOtherTheta = [Type]
theta,
dcOrigArgTys :: DataCon -> [Scaled Type]
dcOrigArgTys = [Scaled Type]
arg_tys, dcOrigResTy :: DataCon -> Type
dcOrigResTy = Type
res_ty})
= ([TyVar]
univ_tvs, [TyVar]
ex_tvs, [EqSpec]
eq_spec, [Type]
theta, [Scaled Type]
arg_tys, Type
res_ty)
dataConOrigResTy :: DataCon -> Type
dataConOrigResTy :: DataCon -> Type
dataConOrigResTy DataCon
dc = DataCon -> Type
dcOrigResTy DataCon
dc
dataConStupidTheta :: DataCon -> ThetaType
dataConStupidTheta :: DataCon -> [Type]
dataConStupidTheta DataCon
dc = DataCon -> [Type]
dcStupidTheta DataCon
dc
dataConWrapperType :: DataCon -> Type
dataConWrapperType :: DataCon -> Type
dataConWrapperType (MkData { dcUserTyVarBinders :: DataCon -> [InvisTVBinder]
dcUserTyVarBinders = [InvisTVBinder]
user_tvbs,
dcOtherTheta :: DataCon -> [Type]
dcOtherTheta = [Type]
theta, dcOrigArgTys :: DataCon -> [Scaled Type]
dcOrigArgTys = [Scaled Type]
arg_tys,
dcOrigResTy :: DataCon -> Type
dcOrigResTy = Type
res_ty })
= [InvisTVBinder] -> Type -> Type
mkInvisForAllTys [InvisTVBinder]
user_tvbs forall a b. (a -> b) -> a -> b
$
[Type] -> Type -> Type
mkInvisFunTysMany [Type]
theta forall a b. (a -> b) -> a -> b
$
[Scaled Type] -> Type -> Type
mkVisFunTys [Scaled Type]
arg_tys forall a b. (a -> b) -> a -> b
$
Type
res_ty
dataConNonlinearType :: DataCon -> Type
dataConNonlinearType :: DataCon -> Type
dataConNonlinearType (MkData { dcUserTyVarBinders :: DataCon -> [InvisTVBinder]
dcUserTyVarBinders = [InvisTVBinder]
user_tvbs,
dcOtherTheta :: DataCon -> [Type]
dcOtherTheta = [Type]
theta, dcOrigArgTys :: DataCon -> [Scaled Type]
dcOrigArgTys = [Scaled Type]
arg_tys,
dcOrigResTy :: DataCon -> Type
dcOrigResTy = Type
res_ty })
= let arg_tys' :: [Scaled Type]
arg_tys' = forall a b. (a -> b) -> [a] -> [b]
map (\(Scaled Type
w Type
t) -> forall a. Type -> a -> Scaled a
Scaled (case Type
w of Type
One -> Type
Many; Type
_ -> Type
w) Type
t) [Scaled Type]
arg_tys
in [InvisTVBinder] -> Type -> Type
mkInvisForAllTys [InvisTVBinder]
user_tvbs forall a b. (a -> b) -> a -> b
$
[Type] -> Type -> Type
mkInvisFunTysMany [Type]
theta forall a b. (a -> b) -> a -> b
$
[Scaled Type] -> Type -> Type
mkVisFunTys [Scaled Type]
arg_tys' forall a b. (a -> b) -> a -> b
$
Type
res_ty
dataConDisplayType :: Bool -> DataCon -> Type
dataConDisplayType :: Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
dc
= if Bool
show_linear_types
then DataCon -> Type
dataConWrapperType DataCon
dc
else DataCon -> Type
dataConNonlinearType DataCon
dc
dataConInstArgTys :: DataCon
-> [Type]
-> [Scaled Type]
dataConInstArgTys :: DataCon -> [Type] -> [Scaled Type]
dataConInstArgTys dc :: DataCon
dc@(MkData {dcUnivTyVars :: DataCon -> [TyVar]
dcUnivTyVars = [TyVar]
univ_tvs,
dcExTyCoVars :: DataCon -> [TyVar]
dcExTyCoVars = [TyVar]
ex_tvs}) [Type]
inst_tys
= ASSERT2( univ_tvs `equalLength` inst_tys
, text "dataConInstArgTys" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
ASSERT2( null ex_tvs, ppr dc )
forall a b. (a -> b) -> [a] -> [b]
map ((Type -> Type) -> Scaled Type -> Scaled Type
mapScaledType (HasCallStack => [TyVar] -> [Type] -> Type -> Type
substTyWith [TyVar]
univ_tvs [Type]
inst_tys)) (DataCon -> [Scaled Type]
dataConRepArgTys DataCon
dc)
dataConInstOrigArgTys
:: DataCon
-> [Type]
-> [Scaled Type]
dataConInstOrigArgTys :: DataCon -> [Type] -> [Scaled Type]
dataConInstOrigArgTys dc :: DataCon
dc@(MkData {dcOrigArgTys :: DataCon -> [Scaled Type]
dcOrigArgTys = [Scaled Type]
arg_tys,
dcUnivTyVars :: DataCon -> [TyVar]
dcUnivTyVars = [TyVar]
univ_tvs,
dcExTyCoVars :: DataCon -> [TyVar]
dcExTyCoVars = [TyVar]
ex_tvs}) [Type]
inst_tys
= ASSERT2( tyvars `equalLength` inst_tys
, text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
HasCallStack => TCvSubst -> [Scaled Type] -> [Scaled Type]
substScaledTys TCvSubst
subst [Scaled Type]
arg_tys
where
tyvars :: [TyVar]
tyvars = [TyVar]
univ_tvs forall a. [a] -> [a] -> [a]
++ [TyVar]
ex_tvs
subst :: TCvSubst
subst = HasDebugCallStack => [TyVar] -> [Type] -> TCvSubst
zipTCvSubst [TyVar]
tyvars [Type]
inst_tys
dataConOrigArgTys :: DataCon -> [Scaled Type]
dataConOrigArgTys :: DataCon -> [Scaled Type]
dataConOrigArgTys DataCon
dc = DataCon -> [Scaled Type]
dcOrigArgTys DataCon
dc
dataConOtherTheta :: DataCon -> ThetaType
dataConOtherTheta :: DataCon -> [Type]
dataConOtherTheta DataCon
dc = DataCon -> [Type]
dcOtherTheta DataCon
dc
dataConRepArgTys :: DataCon -> [Scaled Type]
dataConRepArgTys :: DataCon -> [Scaled Type]
dataConRepArgTys (MkData { dcRep :: DataCon -> DataConRep
dcRep = DataConRep
rep
, dcEqSpec :: DataCon -> [EqSpec]
dcEqSpec = [EqSpec]
eq_spec
, dcOtherTheta :: DataCon -> [Type]
dcOtherTheta = [Type]
theta
, dcOrigArgTys :: DataCon -> [Scaled Type]
dcOrigArgTys = [Scaled Type]
orig_arg_tys })
= case DataConRep
rep of
DataConRep
NoDataConRep -> ASSERT( null eq_spec ) (map unrestricted theta) ++ orig_arg_tys
DCR { dcr_arg_tys :: DataConRep -> [Scaled Type]
dcr_arg_tys = [Scaled Type]
arg_tys } -> [Scaled Type]
arg_tys
dataConIdentity :: DataCon -> ByteString
dataConIdentity :: DataCon -> ByteString
dataConIdentity DataCon
dc = ByteString -> ByteString
LBS.toStrict forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BSB.toLazyByteString forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ ShortByteString -> Builder
BSB.shortByteString forall a b. (a -> b) -> a -> b
$ FieldLabelString -> ShortByteString
fastStringToShortByteString forall a b. (a -> b) -> a -> b
$
forall u. IsUnitId u => u -> FieldLabelString
unitFS forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> unit
moduleUnit Module
mod
, Int8 -> Builder
BSB.int8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Arity
ord Char
':')
, ShortByteString -> Builder
BSB.shortByteString forall a b. (a -> b) -> a -> b
$ FieldLabelString -> ShortByteString
fastStringToShortByteString forall a b. (a -> b) -> a -> b
$
ModuleName -> FieldLabelString
moduleNameFS forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName Module
mod
, Int8 -> Builder
BSB.int8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Arity
ord Char
'.')
, ShortByteString -> Builder
BSB.shortByteString forall a b. (a -> b) -> a -> b
$ FieldLabelString -> ShortByteString
fastStringToShortByteString forall a b. (a -> b) -> a -> b
$
OccName -> FieldLabelString
occNameFS forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
name
]
where name :: Name
name = DataCon -> Name
dataConName DataCon
dc
mod :: Module
mod = ASSERT( isExternalName name ) nameModule name
isTupleDataCon :: DataCon -> Bool
isTupleDataCon :: DataCon -> Bool
isTupleDataCon (MkData {dcRepTyCon :: DataCon -> TyCon
dcRepTyCon = TyCon
tc}) = TyCon -> Bool
isTupleTyCon TyCon
tc
isBoxedTupleDataCon :: DataCon -> Bool
isBoxedTupleDataCon :: DataCon -> Bool
isBoxedTupleDataCon (MkData {dcRepTyCon :: DataCon -> TyCon
dcRepTyCon = TyCon
tc}) = TyCon -> Bool
isBoxedTupleTyCon TyCon
tc
isUnboxedTupleDataCon :: DataCon -> Bool
isUnboxedTupleDataCon :: DataCon -> Bool
isUnboxedTupleDataCon (MkData {dcRepTyCon :: DataCon -> TyCon
dcRepTyCon = TyCon
tc}) = TyCon -> Bool
isUnboxedTupleTyCon TyCon
tc
isUnboxedSumDataCon :: DataCon -> Bool
isUnboxedSumDataCon :: DataCon -> Bool
isUnboxedSumDataCon (MkData {dcRepTyCon :: DataCon -> TyCon
dcRepTyCon = TyCon
tc}) = TyCon -> Bool
isUnboxedSumTyCon TyCon
tc
isVanillaDataCon :: DataCon -> Bool
isVanillaDataCon :: DataCon -> Bool
isVanillaDataCon DataCon
dc = DataCon -> Bool
dcVanilla DataCon
dc
isNewDataCon :: DataCon -> Bool
isNewDataCon :: DataCon -> Bool
isNewDataCon DataCon
dc = TyCon -> Bool
isNewTyCon (DataCon -> TyCon
dataConTyCon DataCon
dc)
specialPromotedDc :: DataCon -> Bool
specialPromotedDc :: DataCon -> Bool
specialPromotedDc = TyCon -> Bool
isKindTyCon forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> TyCon
dataConTyCon
classDataCon :: Class -> DataCon
classDataCon :: Class -> DataCon
classDataCon Class
clas = case TyCon -> [DataCon]
tyConDataCons (Class -> TyCon
classTyCon Class
clas) of
(DataCon
dict_constr:[DataCon]
no_more) -> ASSERT( null no_more ) dict_constr
[] -> forall a. String -> a
panic String
"classDataCon"
dataConCannotMatch :: [Type] -> DataCon -> Bool
dataConCannotMatch :: [Type] -> DataCon -> Bool
dataConCannotMatch [Type]
tys DataCon
con
| DataCon -> Name
dataConName DataCon
con forall a. Eq a => a -> a -> Bool
== Name
unsafeReflDataConName
= Bool
False
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
inst_theta = Bool
False
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Type -> Bool
isTyVarTy [Type]
tys = Bool
False
| Bool
otherwise = [(Type, Type)] -> Bool
typesCantMatch (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [(Type, Type)]
predEqs [Type]
inst_theta)
where
([TyVar]
_, [Type]
inst_theta, [Type]
_) = DataCon -> [Type] -> ([TyVar], [Type], [Type])
dataConInstSig DataCon
con [Type]
tys
predEqs :: Type -> [(Type, Type)]
predEqs Type
pred = case Type -> Pred
classifyPredType Type
pred of
EqPred EqRel
NomEq Type
ty1 Type
ty2 -> [(Type
ty1, Type
ty2)]
ClassPred Class
eq [Type]
args
| Class
eq forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey
, [Type
_, Type
ty1, Type
ty2] <- [Type]
args -> [(Type
ty1, Type
ty2)]
| Class
eq forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey
, [Type
_, Type
_, Type
ty1, Type
ty2] <- [Type]
args -> [(Type
ty1, Type
ty2)]
Pred
_ -> []
dataConUserTyVarsArePermuted :: DataCon -> Bool
dataConUserTyVarsArePermuted :: DataCon -> Bool
dataConUserTyVarsArePermuted (MkData { dcUnivTyVars :: DataCon -> [TyVar]
dcUnivTyVars = [TyVar]
univ_tvs
, dcExTyCoVars :: DataCon -> [TyVar]
dcExTyCoVars = [TyVar]
ex_tvs, dcEqSpec :: DataCon -> [EqSpec]
dcEqSpec = [EqSpec]
eq_spec
, dcUserTyVarBinders :: DataCon -> [InvisTVBinder]
dcUserTyVarBinders = [InvisTVBinder]
user_tvbs }) =
([EqSpec] -> [TyVar] -> [TyVar]
filterEqSpec [EqSpec]
eq_spec [TyVar]
univ_tvs forall a. [a] -> [a] -> [a]
++ [TyVar]
ex_tvs) forall a. Eq a => a -> a -> Bool
/= forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [InvisTVBinder]
user_tvbs
promoteDataCon :: DataCon -> TyCon
promoteDataCon :: DataCon -> TyCon
promoteDataCon (MkData { dcPromoted :: DataCon -> TyCon
dcPromoted = TyCon
tc }) = TyCon
tc
splitDataProductType_maybe
:: Type
-> Maybe (TyCon,
[Type],
DataCon,
[Scaled Type])
splitDataProductType_maybe :: Type -> Maybe (TyCon, [Type], DataCon, [Scaled Type])
splitDataProductType_maybe Type
ty
| Just (TyCon
tycon, [Type]
ty_args) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty
, Just DataCon
con <- TyCon -> Maybe DataCon
tyConSingleDataCon_maybe TyCon
tycon
, forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataCon -> [TyVar]
dataConExTyCoVars DataCon
con)
= forall a. a -> Maybe a
Just (TyCon
tycon, [Type]
ty_args, DataCon
con, DataCon -> [Type] -> [Scaled Type]
dataConInstArgTys DataCon
con [Type]
ty_args)
| Bool
otherwise
= forall a. Maybe a
Nothing