{-# LANGUAGE DeriveDataTypeable #-}
module GHC.Core.DataCon (
DataCon, DataConRep(..),
SrcStrictness(..), SrcUnpackedness(..),
HsSrcBang(..), HsImplBang(..),
StrictnessMark(..),
ConTag,
DataConEnv,
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,
dataConInstUnivs,
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, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked,
specialPromotedDc,
promoteDataCon
) where
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.TyCo.Subst
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.Var.Env
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.FM ( UniqFM )
import GHC.Types.Unique.Set
import GHC.Builtin.Uniques( mkAlphaTyVarUnique )
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
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]
}
type DataConEnv a = UniqFM DataCon a
data HsSrcBang =
HsSrcBang SourceText
SrcUnpackedness
SrcStrictness
deriving Typeable HsSrcBang
Typeable HsSrcBang
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsSrcBang -> c HsSrcBang)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsSrcBang)
-> (HsSrcBang -> Constr)
-> (HsSrcBang -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> HsSrcBang -> HsSrcBang)
-> (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 u. (forall d. Data d => d -> u) -> HsSrcBang -> [u])
-> (forall u.
Arity -> (forall d. Data d => d -> u) -> HsSrcBang -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsSrcBang -> m HsSrcBang)
-> Data HsSrcBang
HsSrcBang -> Constr
HsSrcBang -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsSrcBang -> c HsSrcBang
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsSrcBang -> c HsSrcBang
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsSrcBang
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsSrcBang
$ctoConstr :: HsSrcBang -> Constr
toConstr :: HsSrcBang -> Constr
$cdataTypeOf :: HsSrcBang -> DataType
dataTypeOf :: HsSrcBang -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsSrcBang)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsSrcBang)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsSrcBang)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsSrcBang)
$cgmapT :: (forall b. Data b => b -> b) -> HsSrcBang -> HsSrcBang
gmapT :: (forall b. Data b => b -> b) -> HsSrcBang -> HsSrcBang
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsSrcBang -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsSrcBang -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HsSrcBang -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsSrcBang -> [u]
$cgmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> HsSrcBang -> u
gmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> HsSrcBang -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsSrcBang -> m HsSrcBang
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsSrcBang -> m HsSrcBang
Data.Data
data HsImplBang
= HsLazy
| HsStrict
| HsUnpack (Maybe Coercion)
deriving Typeable HsImplBang
Typeable HsImplBang
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsImplBang -> c HsImplBang)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsImplBang)
-> (HsImplBang -> Constr)
-> (HsImplBang -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> HsImplBang -> HsImplBang)
-> (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 u. (forall d. Data d => d -> u) -> HsImplBang -> [u])
-> (forall u.
Arity -> (forall d. Data d => d -> u) -> HsImplBang -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsImplBang -> m HsImplBang)
-> Data HsImplBang
HsImplBang -> Constr
HsImplBang -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsImplBang -> c HsImplBang
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsImplBang -> c HsImplBang
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsImplBang
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsImplBang
$ctoConstr :: HsImplBang -> Constr
toConstr :: HsImplBang -> Constr
$cdataTypeOf :: HsImplBang -> DataType
dataTypeOf :: HsImplBang -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsImplBang)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsImplBang)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsImplBang)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsImplBang)
$cgmapT :: (forall b. Data b => b -> b) -> HsImplBang -> HsImplBang
gmapT :: (forall b. Data b => b -> b) -> HsImplBang -> HsImplBang
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsImplBang -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsImplBang -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HsImplBang -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsImplBang -> [u]
$cgmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> HsImplBang -> u
gmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> HsImplBang -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsImplBang -> m HsImplBang
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsImplBang -> m HsImplBang
Data.Data
data SrcStrictness = SrcLazy
| SrcStrict
| NoSrcStrict
deriving (SrcStrictness -> SrcStrictness -> Bool
(SrcStrictness -> SrcStrictness -> Bool)
-> (SrcStrictness -> SrcStrictness -> Bool) -> Eq SrcStrictness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrcStrictness -> SrcStrictness -> Bool
== :: SrcStrictness -> SrcStrictness -> Bool
$c/= :: SrcStrictness -> SrcStrictness -> Bool
/= :: SrcStrictness -> SrcStrictness -> Bool
Eq, Typeable SrcStrictness
Typeable SrcStrictness
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcStrictness -> c SrcStrictness)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcStrictness)
-> (SrcStrictness -> Constr)
-> (SrcStrictness -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> SrcStrictness -> SrcStrictness)
-> (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 u. (forall d. Data d => d -> u) -> SrcStrictness -> [u])
-> (forall u.
Arity -> (forall d. Data d => d -> u) -> SrcStrictness -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcStrictness -> m SrcStrictness)
-> Data SrcStrictness
SrcStrictness -> Constr
SrcStrictness -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcStrictness -> c SrcStrictness
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcStrictness -> c SrcStrictness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcStrictness
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcStrictness
$ctoConstr :: SrcStrictness -> Constr
toConstr :: SrcStrictness -> Constr
$cdataTypeOf :: SrcStrictness -> DataType
dataTypeOf :: SrcStrictness -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcStrictness)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcStrictness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcStrictness)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcStrictness)
$cgmapT :: (forall b. Data b => b -> b) -> SrcStrictness -> SrcStrictness
gmapT :: (forall b. Data b => b -> b) -> SrcStrictness -> SrcStrictness
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcStrictness -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcStrictness -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcStrictness -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SrcStrictness -> [u]
$cgmapQi :: forall u.
Arity -> (forall d. Data d => d -> u) -> SrcStrictness -> u
gmapQi :: forall u.
Arity -> (forall d. Data d => d -> u) -> SrcStrictness -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcStrictness -> m SrcStrictness
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcStrictness -> m SrcStrictness
Data.Data)
data SrcUnpackedness = SrcUnpack
| SrcNoUnpack
| NoSrcUnpack
deriving (SrcUnpackedness -> SrcUnpackedness -> Bool
(SrcUnpackedness -> SrcUnpackedness -> Bool)
-> (SrcUnpackedness -> SrcUnpackedness -> Bool)
-> Eq SrcUnpackedness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrcUnpackedness -> SrcUnpackedness -> Bool
== :: SrcUnpackedness -> SrcUnpackedness -> Bool
$c/= :: SrcUnpackedness -> SrcUnpackedness -> Bool
/= :: SrcUnpackedness -> SrcUnpackedness -> Bool
Eq, Typeable SrcUnpackedness
Typeable SrcUnpackedness
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcUnpackedness -> c SrcUnpackedness)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcUnpackedness)
-> (SrcUnpackedness -> Constr)
-> (SrcUnpackedness -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
-> SrcUnpackedness -> SrcUnpackedness)
-> (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 u.
(forall d. Data d => d -> u) -> SrcUnpackedness -> [u])
-> (forall u.
Arity -> (forall d. Data d => d -> u) -> SrcUnpackedness -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SrcUnpackedness -> m SrcUnpackedness)
-> Data SrcUnpackedness
SrcUnpackedness -> Constr
SrcUnpackedness -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcUnpackedness -> c SrcUnpackedness
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcUnpackedness -> c SrcUnpackedness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcUnpackedness
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcUnpackedness
$ctoConstr :: SrcUnpackedness -> Constr
toConstr :: SrcUnpackedness -> Constr
$cdataTypeOf :: SrcUnpackedness -> DataType
dataTypeOf :: SrcUnpackedness -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcUnpackedness)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcUnpackedness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcUnpackedness)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcUnpackedness)
$cgmapT :: (forall b. Data b => b -> b) -> SrcUnpackedness -> SrcUnpackedness
gmapT :: (forall b. Data b => b -> b) -> SrcUnpackedness -> SrcUnpackedness
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcUnpackedness -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcUnpackedness -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcUnpackedness -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SrcUnpackedness -> [u]
$cgmapQi :: forall u.
Arity -> (forall d. Data d => d -> u) -> SrcUnpackedness -> u
gmapQi :: forall u.
Arity -> (forall d. Data d => d -> u) -> SrcUnpackedness -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SrcUnpackedness -> m SrcUnpackedness
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SrcUnpackedness -> m SrcUnpackedness
Data.Data)
data StrictnessMark = MarkedStrict | NotMarkedStrict
deriving StrictnessMark -> StrictnessMark -> Bool
(StrictnessMark -> StrictnessMark -> Bool)
-> (StrictnessMark -> StrictnessMark -> Bool) -> Eq StrictnessMark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrictnessMark -> StrictnessMark -> Bool
== :: StrictnessMark -> StrictnessMark -> Bool
$c/= :: StrictnessMark -> StrictnessMark -> Bool
/= :: StrictnessMark -> StrictnessMark -> Bool
Eq
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' ((() :: Constraint) => TCvSubst -> Type -> Type
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
= (TyVar -> Bool) -> [TyVar] -> [TyVar]
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 = (EqSpec -> Bool) -> [EqSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (EqSpec -> Bool) -> EqSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TyVar -> TyVar -> Bool
forall a. Eq a => a -> a -> Bool
== TyVar
var) (TyVar -> Bool) -> (EqSpec -> TyVar) -> EqSpec -> Bool
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) = (TyVar, Type) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyVar
tv, Type
ty)
instance Eq DataCon where
DataCon
a == :: DataCon -> DataCon -> Bool
== DataCon
b = DataCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique DataCon
a Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique DataCon
b
DataCon
a /= :: DataCon -> DataCon -> Bool
/= DataCon
b = DataCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique DataCon
a Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
/= DataCon -> Unique
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 = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (DataCon -> Name
dataConName DataCon
con)
instance OutputableBndr DataCon where
pprInfixOcc :: DataCon -> SDoc
pprInfixOcc DataCon
con = Name -> SDoc
forall a. (Outputable a, NamedThing a) => a -> SDoc
pprInfixName (DataCon -> Name
dataConName DataCon
con)
pprPrefixOcc :: DataCon -> SDoc
pprPrefixOcc DataCon
con = Name -> SDoc
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
_ = String -> Constr -> c DataCon
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) = SrcUnpackedness -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcUnpackedness
prag SDoc -> SDoc -> SDoc
<+> SrcStrictness -> 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 (Coercion -> SDoc
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 StrictnessMark where
put_ :: BinHandle -> StrictnessMark -> IO ()
put_ BinHandle
bh StrictnessMark
NotMarkedStrict = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh StrictnessMark
MarkedStrict = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
get :: BinHandle -> IO StrictnessMark
get BinHandle
bh =
do Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> StrictnessMark -> IO StrictnessMark
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StrictnessMark
NotMarkedStrict
Word8
1 -> StrictnessMark -> IO StrictnessMark
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StrictnessMark
MarkedStrict
Word8
_ -> String -> IO StrictnessMark
forall a. String -> a
panic String
"Invalid binary format"
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 -> SrcStrictness -> IO SrcStrictness
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SrcStrictness
SrcLazy
Word8
1 -> SrcStrictness -> IO SrcStrictness
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SrcStrictness
SrcStrict
Word8
_ -> SrcStrictness -> IO SrcStrictness
forall a. a -> IO a
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 -> SrcUnpackedness -> IO SrcUnpackedness
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SrcUnpackedness
SrcNoUnpack
Word8
1 -> SrcUnpackedness -> IO SrcUnpackedness
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SrcUnpackedness
SrcUnpack
Word8
_ -> SrcUnpackedness -> IO SrcUnpackedness
forall a. a -> IO a
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
cbvFromStrictMark :: StrictnessMark -> CbvMark
cbvFromStrictMark :: StrictnessMark -> CbvMark
cbvFromStrictMark StrictnessMark
NotMarkedStrict = CbvMark
NotMarkedCbv
cbvFromStrictMark StrictnessMark
MarkedStrict = CbvMark
MarkedCbv
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 = [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
ex_tvs Bool -> Bool -> Bool
&& [EqSpec] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EqSpec]
eq_spec Bool -> Bool -> Bool
&& [Type] -> Bool
forall a. [a] -> 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 = [Scaled Type] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Scaled Type]
orig_arg_tys,
dcRepArity :: Arity
dcRepArity = [Scaled Type] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Scaled Type]
rep_arg_tys Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
+ (TyVar -> Bool) -> [TyVar] -> Arity
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 (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [TyVar] -> Type -> Type
mkTyCoInvForAllTys [TyVar]
ex_tvs (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
[Scaled Type] -> Type -> Type
mkVisFunTys [Scaled Type]
rep_arg_tys (Type -> Type) -> Type -> Type
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 ((InvisTVBinder -> Name) -> [InvisTVBinder] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map InvisTVBinder -> Name
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 [Name] -> [Type] -> [(Name, Type)]
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) <- [Type] -> [Name] -> [Name]
forall b a. [b] -> [a] -> [a]
dropList [Type]
theta [Name]
fresh_names [Name] -> [Type] -> [(Name, Type)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` (Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Scaled Type -> Type
forall a. Scaled a -> a
scaledThing [Scaled Type]
orig_arg_tys ]
prom_bndrs :: [TyConBinder]
prom_bndrs = [TyConBinder]
prom_tv_bndrs [TyConBinder] -> [TyConBinder] -> [TyConBinder]
forall a. [a] -> [a] -> [a]
++ [TyConBinder]
prom_theta_bndrs [TyConBinder] -> [TyConBinder] -> [TyConBinder]
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 = (TyVar -> Role) -> [TyVar] -> [Role]
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 [TyVar] -> [TyVar] -> [TyVar]
forall a. [a] -> [a] -> [a]
++ [TyVar]
ex_tvs)
[Role] -> [Role] -> [Role]
forall a. [a] -> [a] -> [a]
++ (Type -> Role) -> [Type] -> [Role]
forall a b. (a -> b) -> [a] -> [b]
map (Role -> Type -> Role
forall a b. a -> b -> a
const Role
Representational) ([Type]
theta [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ (Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Scaled Type -> Type
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' Char -> String -> String
forall a. a -> [a] -> [a]
: Arity -> String
forall a. Show a => a -> String
show Arity
n))
, Bool -> Bool
not (Unique
uniq Unique -> UniqSet Unique -> Bool
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 = [Unique] -> UniqSet Unique
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ((Name -> Unique) -> [Name] -> [Unique]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique [Name]
avoids)
avoid_occs :: OccSet
avoid_occs :: OccSet
avoid_occs = [OccName] -> OccSet
mkOccSet ((Name -> OccName) -> [Name] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> OccName
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 Arity -> Arity -> Arity
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 [TyVar] -> [TyVar] -> [TyVar]
forall a. [a] -> [a] -> [a]
++ [TyVar]
ex_tvs
dataConUserTyVars :: DataCon -> [TyVar]
dataConUserTyVars :: DataCon -> [TyVar]
dataConUserTyVars (MkData { dcUserTyVarBinders :: DataCon -> [InvisTVBinder]
dcUserTyVarBinders = [InvisTVBinder]
tvbs }) = [InvisTVBinder] -> [TyVar]
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
[EqSpec] -> [EqSpec] -> [EqSpec]
forall a. [a] -> [a] -> [a]
++ [EqSpec]
eq_spec [EqSpec] -> [EqSpec] -> [EqSpec]
forall a. [a] -> [a] -> [a]
++
[ EqSpec
spec
| Just (TyCon
tc, [Type
_k1, Type
_k2, Type
ty1, Type
ty2]) <- (Type -> Maybe (TyCon, [Type]))
-> [Type] -> [Maybe (TyCon, [Type])]
forall a b. (a -> b) -> [a] -> [b]
map (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe [Type]
theta
, TyCon
tc TyCon -> Unique -> Bool
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)
_ -> []
] [EqSpec] -> [EqSpec] -> [EqSpec]
forall a. [a] -> [a] -> [a]
++
[ EqSpec
spec
| Just (TyCon
tc, [Type
_k, Type
ty1, Type
ty2]) <- (Type -> Maybe (TyCon, [Type]))
-> [Type] -> [Maybe (TyCon, [Type])]
forall a b. (a -> b) -> [a] -> [b]
map (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe [Type]
theta
, TyCon
tc TyCon -> Unique -> Bool
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
_) = (() :: Constraint) => TyVar -> (Type, Type, Type, Type, Role)
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 [EqSpec] -> [EqSpec] -> [EqSpec]
forall a. [a] -> [a] -> [a]
++ [EqSpec]
eq_spec) [Type] -> [Type] -> [Type]
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 -> Maybe TyVar
forall a. Maybe a
Nothing
DCR { dcr_wrap_id :: DataConRep -> TyVar
dcr_wrap_id = TyVar
wrap_id } -> TyVar -> Maybe TyVar
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] [TyThing] -> [TyThing] -> [TyThing]
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 -> String -> SDoc -> Type
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"dataConFieldType" (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
<+> FieldLabelString -> 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
= ((FieldLabel, Type) -> Bool)
-> [(FieldLabel, Type)] -> Maybe (FieldLabel, Type)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FieldLabelString -> FieldLabelString -> Bool
forall a. Eq a => a -> a -> Bool
== FieldLabelString
label) (FieldLabelString -> Bool)
-> ((FieldLabel, Type) -> FieldLabelString)
-> (FieldLabel, Type)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FieldLabelString
flLabel (FieldLabel -> FieldLabelString)
-> ((FieldLabel, Type) -> FieldLabel)
-> (FieldLabel, Type)
-> FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldLabel, Type) -> FieldLabel
forall a b. (a, b) -> a
fst) (DataCon -> [FieldLabel]
dcFields DataCon
con [FieldLabel] -> [Type] -> [(FieldLabel, Type)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` (Scaled Type -> Type
forall a. Scaled a -> a
scaledThing (Scaled Type -> Type) -> [Scaled Type] -> [Type]
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 Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
0
isNullaryRepDataCon :: DataCon -> Bool
isNullaryRepDataCon :: DataCon -> Bool
isNullaryRepDataCon DataCon
dc = DataCon -> Arity
dataConRepArity DataCon
dc Arity -> Arity -> Bool
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 -> Arity -> HsImplBang -> [HsImplBang]
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 } }) = DataConBoxer -> Maybe DataConBoxer
forall a. a -> Maybe a
Just DataConBoxer
boxer
dataConBoxer DataCon
_ = Maybe DataConBoxer
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'
, (() :: Constraint) => TCvSubst -> [Type] -> [Type]
TCvSubst -> [Type] -> [Type]
substTheta TCvSubst
subst (DataCon -> [Type]
dataConTheta DataCon
con)
, (() :: Constraint) => TCvSubst -> [Type] -> [Type]
TCvSubst -> [Type] -> [Type]
substTys TCvSubst
subst ((Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Scaled Type -> Type
forall a. Scaled a -> a
scaledThing [Scaled Type]
arg_tys))
where
univ_subst :: TCvSubst
univ_subst = [TyVar] -> [Type] -> TCvSubst
(() :: Constraint) => [TyVar] -> [Type] -> TCvSubst
zipTvSubst [TyVar]
univ_tvs [Type]
univ_tys
(TCvSubst
subst, [TyVar]
ex_tvs') = (() :: Constraint) => TCvSubst -> [TyVar] -> (TCvSubst, [TyVar])
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 (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
[Type] -> Type -> Type
mkInvisFunTysMany [Type]
theta (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
[Scaled Type] -> Type -> Type
mkVisFunTys [Scaled Type]
arg_tys (Type -> Type) -> Type -> Type
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,
dcStupidTheta :: DataCon -> [Type]
dcStupidTheta = [Type]
stupid_theta })
= [InvisTVBinder] -> Type -> Type
mkInvisForAllTys [InvisTVBinder]
user_tvbs (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
[Type] -> Type -> Type
mkInvisFunTysMany ([Type]
stupid_theta [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Type]
theta) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
[Scaled Type] -> Type -> Type
mkVisFunTys [Scaled Type]
arg_tys' (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
Type
res_ty
where
arg_tys' :: [Scaled Type]
arg_tys' = (Scaled Type -> Scaled Type) -> [Scaled Type] -> [Scaled Type]
forall a b. (a -> b) -> [a] -> [b]
map (\(Scaled Type
w Type
t) -> Type -> Type -> Scaled Type
forall a. Type -> a -> Scaled a
Scaled (case Type
w of Type
One -> Type
Many; Type
_ -> Type
w) Type
t) [Scaled Type]
arg_tys
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
= Bool -> SDoc -> [Scaled Type] -> [Scaled Type]
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr ([TyVar]
univ_tvs [TyVar] -> [Type] -> Bool
forall a b. [a] -> [b] -> Bool
`equalLength` [Type]
inst_tys)
(String -> SDoc
text String
"dataConInstArgTys" SDoc -> SDoc -> SDoc
<+> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
$$ [TyVar] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyVar]
univ_tvs SDoc -> SDoc -> SDoc
$$ [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
inst_tys) ([Scaled Type] -> [Scaled Type]) -> [Scaled Type] -> [Scaled Type]
forall a b. (a -> b) -> a -> b
$
Bool -> SDoc -> [Scaled Type] -> [Scaled Type]
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr ([TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
ex_tvs) (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc) ([Scaled Type] -> [Scaled Type]) -> [Scaled Type] -> [Scaled Type]
forall a b. (a -> b) -> a -> b
$
(Scaled Type -> Scaled Type) -> [Scaled Type] -> [Scaled Type]
forall a b. (a -> b) -> [a] -> [b]
map ((Type -> Type) -> Scaled Type -> Scaled Type
mapScaledType ([TyVar] -> [Type] -> Type -> Type
(() :: Constraint) => [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
= Bool -> SDoc -> [Scaled Type] -> [Scaled Type]
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr ([TyVar]
tyvars [TyVar] -> [Type] -> Bool
forall a b. [a] -> [b] -> Bool
`equalLength` [Type]
inst_tys)
(String -> SDoc
text String
"dataConInstOrigArgTys" SDoc -> SDoc -> SDoc
<+> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
$$ [TyVar] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyVar]
tyvars SDoc -> SDoc -> SDoc
$$ [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
inst_tys) ([Scaled Type] -> [Scaled Type]) -> [Scaled Type] -> [Scaled Type]
forall a b. (a -> b) -> a -> b
$
(() :: Constraint) => TCvSubst -> [Scaled Type] -> [Scaled Type]
TCvSubst -> [Scaled Type] -> [Scaled Type]
substScaledTys TCvSubst
subst [Scaled Type]
arg_tys
where
tyvars :: [TyVar]
tyvars = [TyVar]
univ_tvs [TyVar] -> [TyVar] -> [TyVar]
forall a. [a] -> [a] -> [a]
++ [TyVar]
ex_tvs
subst :: TCvSubst
subst = [TyVar] -> [Type] -> TCvSubst
(() :: Constraint) => [TyVar] -> [Type] -> TCvSubst
zipTCvSubst [TyVar]
tyvars [Type]
inst_tys
dataConInstUnivs :: DataCon -> [Type] -> [Type]
dataConInstUnivs :: DataCon -> [Type] -> [Type]
dataConInstUnivs DataCon
dc [Type]
dc_args = [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
chkAppend [Type]
dc_args ([Type] -> [Type]) -> [Type] -> [Type]
forall a b. (a -> b) -> a -> b
$ (TyVar -> Type) -> [TyVar] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> Type
mkTyVarTy [TyVar]
dc_args_suffix
where
([TyVar]
dc_univs_prefix, [TyVar]
dc_univs_suffix)
=
Bool -> SDoc -> ([TyVar], [TyVar]) -> ([TyVar], [TyVar])
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr ([Type]
dc_args [Type] -> [TyVar] -> Bool
forall a b. [a] -> [b] -> Bool
`leLength` DataCon -> [TyVar]
dataConUnivTyVars DataCon
dc)
(String -> SDoc
text String
"dataConInstUnivs"
SDoc -> SDoc -> SDoc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
dc_args
SDoc -> SDoc -> SDoc
<+> [TyVar] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (DataCon -> [TyVar]
dataConUnivTyVars DataCon
dc)) (([TyVar], [TyVar]) -> ([TyVar], [TyVar]))
-> ([TyVar], [TyVar]) -> ([TyVar], [TyVar])
forall a b. (a -> b) -> a -> b
$
Arity -> [TyVar] -> ([TyVar], [TyVar])
forall a. Arity -> [a] -> ([a], [a])
splitAt ([Type] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Type]
dc_args) ([TyVar] -> ([TyVar], [TyVar])) -> [TyVar] -> ([TyVar], [TyVar])
forall a b. (a -> b) -> a -> b
$ DataCon -> [TyVar]
dataConUnivTyVars DataCon
dc
(TCvSubst
_, [TyVar]
dc_args_suffix) = (() :: Constraint) => TCvSubst -> [TyVar] -> (TCvSubst, [TyVar])
TCvSubst -> [TyVar] -> (TCvSubst, [TyVar])
substTyVarBndrs TCvSubst
prefix_subst [TyVar]
dc_univs_suffix
prefix_subst :: TCvSubst
prefix_subst = InScopeSet -> TvSubstEnv -> TCvSubst
mkTvSubst InScopeSet
prefix_in_scope TvSubstEnv
prefix_env
prefix_in_scope :: InScopeSet
prefix_in_scope = VarSet -> InScopeSet
mkInScopeSet (VarSet -> InScopeSet) -> VarSet -> InScopeSet
forall a b. (a -> b) -> a -> b
$ [Type] -> VarSet
tyCoVarsOfTypes [Type]
dc_args
prefix_env :: TvSubstEnv
prefix_env = [TyVar] -> [Type] -> TvSubstEnv
(() :: Constraint) => [TyVar] -> [Type] -> TvSubstEnv
zipTyEnv [TyVar]
dc_univs_prefix [Type]
dc_args
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 -> Bool -> [Scaled Type] -> [Scaled Type]
forall a. HasCallStack => Bool -> a -> a
assert ([EqSpec] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EqSpec]
eq_spec) ([Scaled Type] -> [Scaled Type]) -> [Scaled Type] -> [Scaled Type]
forall a b. (a -> b) -> a -> b
$ ((Type -> Scaled Type) -> [Type] -> [Scaled Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Scaled Type
forall a. a -> Scaled a
unrestricted [Type]
theta) [Scaled Type] -> [Scaled Type] -> [Scaled Type]
forall a. [a] -> [a] -> [a]
++ [Scaled Type]
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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ ShortByteString -> Builder
BSB.shortByteString (ShortByteString -> Builder) -> ShortByteString -> Builder
forall a b. (a -> b) -> a -> b
$ FieldLabelString -> ShortByteString
fastStringToShortByteString (FieldLabelString -> ShortByteString)
-> FieldLabelString -> ShortByteString
forall a b. (a -> b) -> a -> b
$
Unit -> FieldLabelString
forall u. IsUnitId u => u -> FieldLabelString
unitFS (Unit -> FieldLabelString) -> Unit -> FieldLabelString
forall a b. (a -> b) -> a -> b
$ GenModule Unit -> Unit
forall unit. GenModule unit -> unit
moduleUnit GenModule Unit
mod
, Int8 -> Builder
BSB.int8 (Int8 -> Builder) -> Int8 -> Builder
forall a b. (a -> b) -> a -> b
$ Arity -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Arity
ord Char
':')
, ShortByteString -> Builder
BSB.shortByteString (ShortByteString -> Builder) -> ShortByteString -> Builder
forall a b. (a -> b) -> a -> b
$ FieldLabelString -> ShortByteString
fastStringToShortByteString (FieldLabelString -> ShortByteString)
-> FieldLabelString -> ShortByteString
forall a b. (a -> b) -> a -> b
$
ModuleName -> FieldLabelString
moduleNameFS (ModuleName -> FieldLabelString) -> ModuleName -> FieldLabelString
forall a b. (a -> b) -> a -> b
$ GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName GenModule Unit
mod
, Int8 -> Builder
BSB.int8 (Int8 -> Builder) -> Int8 -> Builder
forall a b. (a -> b) -> a -> b
$ Arity -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Arity
ord Char
'.')
, ShortByteString -> Builder
BSB.shortByteString (ShortByteString -> Builder) -> ShortByteString -> Builder
forall a b. (a -> b) -> a -> b
$ FieldLabelString -> ShortByteString
fastStringToShortByteString (FieldLabelString -> ShortByteString)
-> FieldLabelString -> ShortByteString
forall a b. (a -> b) -> a -> b
$
OccName -> FieldLabelString
occNameFS (OccName -> FieldLabelString) -> OccName -> FieldLabelString
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
name
]
where name :: Name
name = DataCon -> Name
dataConName DataCon
dc
mod :: GenModule Unit
mod = Bool -> GenModule Unit -> GenModule Unit
forall a. HasCallStack => Bool -> a -> a
assert (Name -> Bool
isExternalName Name
name) (GenModule Unit -> GenModule Unit)
-> GenModule Unit -> GenModule Unit
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> GenModule Unit
Name -> GenModule Unit
nameModule Name
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 (TyCon -> Bool) -> (DataCon -> TyCon) -> DataCon -> Bool
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) -> Bool -> DataCon -> DataCon
forall a. HasCallStack => Bool -> a -> a
assert ([DataCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
no_more) DataCon
dict_constr
[] -> String -> DataCon
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 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
unsafeReflDataConName
= Bool
False
| [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
inst_theta = Bool
False
| (Type -> Bool) -> [Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Type -> Bool
isTyVarTy [Type]
tys = Bool
False
| Bool
otherwise = [(Type, Type)] -> Bool
typesCantMatch ((Type -> [(Type, Type)]) -> [Type] -> [(Type, Type)]
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 Class -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey
, [Type
_, Type
ty1, Type
ty2] <- [Type]
args -> [(Type
ty1, Type
ty2)]
| Class
eq Class -> Unique -> Bool
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 [TyVar] -> [TyVar] -> [TyVar]
forall a. [a] -> [a] -> [a]
++ [TyVar]
ex_tvs) [TyVar] -> [TyVar] -> Bool
forall a. Eq a => a -> a -> Bool
/= [InvisTVBinder] -> [TyVar]
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) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty
, Just DataCon
con <- TyCon -> Maybe DataCon
tyConSingleDataCon_maybe TyCon
tycon
, [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataCon -> [TyVar]
dataConExTyCoVars DataCon
con)
= (TyCon, [Type], DataCon, [Scaled Type])
-> Maybe (TyCon, [Type], DataCon, [Scaled Type])
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
= Maybe (TyCon, [Type], DataCon, [Scaled Type])
forall a. Maybe a
Nothing