{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module GHC.Core.DataCon (
DataCon, DataConRep(..),
SrcStrictness(..), SrcUnpackedness(..),
HsSrcBang(..), HsBang(..), HsImplBang(..),
StrictnessMark(..),
ConTag,
DataConEnv,
EqSpec, mkEqSpec, eqSpecTyVar, eqSpecType,
eqSpecPair, eqSpecPreds,
FieldLabel(..), flLabel, FieldLabelString,
mkHsSrcBang, mkDataCon, fIRST_TAG,
dataConRepType, dataConInstSig, dataConFullSig,
dataConName, dataConIdentity, dataConTag, dataConTagZ,
dataConTyCon, dataConOrigTyCon,
dataConWrapperType,
dataConNonlinearType,
dataConDisplayType,
dataConUnivTyVars, dataConExTyCoVars, dataConUnivAndExTyCoVars,
dataConConcreteTyVars,
dataConUserTyVars, dataConUserTyVarBinders,
dataConTheta,
dataConStupidTheta,
dataConOtherTheta,
dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
dataConInstOrigArgTys, dataConRepArgTys, dataConResRepTyArgs,
dataConInstUnivs,
dataConFieldLabels, dataConFieldType, dataConFieldType_maybe,
dataConSrcBangs,
dataConSourceArity, dataConRepArity,
dataConIsInfix,
dataConWorkId, dataConWrapId, dataConWrapId_maybe,
dataConImplicitTyThings,
dataConRepStrictness,
dataConImplBangs, dataConBoxer,
splitDataProductType_maybe,
isNullarySrcDataCon, isNullaryRepDataCon,
isLazyDataConRep,
isTupleDataCon, isBoxedTupleDataCon, isUnboxedTupleDataCon,
isUnboxedSumDataCon, isCovertGadtDataCon,
isVanillaDataCon, isNewDataCon, isTypeDataCon,
classDataCon, dataConCannotMatch,
dataConUserTyVarsNeedWrapper, checkDataConTyVars,
isBanged, isUnpacked, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked,
specialPromotedDc,
promoteDataCon
) where
import GHC.Prelude
import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Module.Name
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.TyCo.Compare( eqType )
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.Utils.Binary
import GHC.Types.Unique.FM ( UniqFM )
import GHC.Types.Unique.Set
import GHC.Builtin.Uniques( mkAlphaTyVarUnique )
import GHC.Data.Graph.UnVar
import {-# SOURCE #-} GHC.Tc.Utils.TcType ( ConcreteTyVars )
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 -> ConcreteTyVars
dcConcreteTyVars :: ConcreteTyVars,
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 -> [HsImplBang]
dcImplBangs :: [HsImplBang],
DataCon -> [StrictnessMark]
dcStricts :: [StrictnessMark],
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]
}
type DataConEnv a = UniqFM DataCon a
data HsSrcBang
= HsSrcBang SourceText HsBang
mkHsSrcBang :: SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
mkHsSrcBang :: SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
mkHsSrcBang SourceText
stext SrcUnpackedness
u SrcStrictness
s = SourceText -> HsBang -> HsSrcBang
HsSrcBang SourceText
stext (SrcUnpackedness -> SrcStrictness -> HsBang
HsBang SrcUnpackedness
u SrcStrictness
s)
data HsImplBang
= HsLazy
| HsStrict Bool
| 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 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
mkNomEqPred (TyVar -> Type
mkTyVarTy TyVar
tv) Type
ty
| EqSpec TyVar
tv Type
ty <- [EqSpec]
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 HsBang where
ppr :: HsBang -> SDoc
ppr (HsBang SrcUnpackedness
prag SrcStrictness
mark) = SrcUnpackedness -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcUnpackedness
prag SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcStrictness -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcStrictness
mark
instance Outputable HsImplBang where
ppr :: HsImplBang -> SDoc
ppr HsImplBang
HsLazy = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Lazy"
ppr (HsUnpack Maybe Coercion
Nothing) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unpacked"
ppr (HsUnpack (Just Coercion
co)) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unpacked" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Coercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr Coercion
co)
ppr (HsStrict Bool
b) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"StrictNotUnpacked" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
b)
instance Outputable SrcStrictness where
ppr :: SrcStrictness -> SDoc
ppr SrcStrictness
SrcLazy = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'~'
ppr SrcStrictness
SrcStrict = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'!'
ppr SrcStrictness
NoSrcStrict = SDoc
forall doc. IsOutput doc => doc
empty
instance Outputable SrcUnpackedness where
ppr :: SrcUnpackedness -> SDoc
ppr SrcUnpackedness
SrcUnpack = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{-# UNPACK #-}"
ppr SrcUnpackedness
SrcNoUnpack = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{-# NOUNPACK #-}"
ppr SrcUnpackedness
NoSrcUnpack = SDoc
forall doc. IsOutput doc => doc
empty
instance Outputable StrictnessMark where
ppr :: StrictnessMark -> SDoc
ppr StrictnessMark
MarkedStrict = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"!"
ppr StrictnessMark
NotMarkedStrict = SDoc
forall doc. IsOutput doc => doc
empty
instance Binary StrictnessMark where
put_ :: WriteBinHandle -> StrictnessMark -> IO ()
put_ WriteBinHandle
bh StrictnessMark
NotMarkedStrict = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
put_ WriteBinHandle
bh StrictnessMark
MarkedStrict = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
get :: ReadBinHandle -> IO StrictnessMark
get ReadBinHandle
bh =
do h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
case 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. HasCallStack => String -> a
panic String
"Invalid binary format"
instance Binary SrcStrictness where
put_ :: WriteBinHandle -> SrcStrictness -> IO ()
put_ WriteBinHandle
bh SrcStrictness
SrcLazy = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
put_ WriteBinHandle
bh SrcStrictness
SrcStrict = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
put_ WriteBinHandle
bh SrcStrictness
NoSrcStrict = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
get :: ReadBinHandle -> IO SrcStrictness
get ReadBinHandle
bh =
do h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
case 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_ :: WriteBinHandle -> SrcUnpackedness -> IO ()
put_ WriteBinHandle
bh SrcUnpackedness
SrcNoUnpack = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
put_ WriteBinHandle
bh SrcUnpackedness
SrcUnpack = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
put_ WriteBinHandle
bh SrcUnpackedness
NoSrcUnpack = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
get :: ReadBinHandle -> IO SrcUnpackedness
get ReadBinHandle
bh =
do h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
case 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 (HsStrict Bool
_) (HsStrict Bool
_) = Bool
True
eqHsBang (HsUnpack Maybe Coercion
Nothing) (HsUnpack Maybe Coercion
Nothing) = Bool
True
eqHsBang (HsUnpack (Just Coercion
c1)) (HsUnpack (Just Coercion
c2))
= HasCallStack => Type -> Type -> Bool
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
isUnpacked :: HsImplBang -> Bool
isUnpacked :: HsImplBang -> Bool
isUnpacked (HsUnpack {}) = Bool
True
isUnpacked (HsStrict {}) = Bool
False
isUnpacked 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]
-> [HsImplBang]
-> [StrictnessMark]
-> [FieldLabel]
-> [TyVar]
-> [TyCoVar]
-> ConcreteTyVars
-> [InvisTVBinder]
-> [EqSpec]
-> KnotTied ThetaType
-> [KnotTied (Scaled Type)]
-> KnotTied Type
-> PromDataConInfo
-> KnotTied TyCon
-> ConTag
-> ThetaType
-> Id
-> DataConRep
-> DataCon
mkDataCon :: Name
-> Bool
-> Name
-> [HsSrcBang]
-> [HsImplBang]
-> [StrictnessMark]
-> [FieldLabel]
-> [TyVar]
-> [TyVar]
-> ConcreteTyVars
-> [InvisTVBinder]
-> [EqSpec]
-> [Type]
-> [Scaled Type]
-> Type
-> PromDataConInfo
-> TyCon
-> Arity
-> [Type]
-> TyVar
-> DataConRep
-> DataCon
mkDataCon Name
name Bool
declared_infix Name
prom_info
[HsSrcBang]
arg_stricts
[HsImplBang]
impl_bangs
[StrictnessMark]
str_marks
[FieldLabel]
fields
[TyVar]
univ_tvs [TyVar]
ex_tvs ConcreteTyVars
conc_tvs [InvisTVBinder]
user_tvbs
[EqSpec]
eq_spec [Type]
theta
[Scaled Type]
orig_arg_tys Type
orig_res_ty PromDataConInfo
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
str_marks' :: [StrictnessMark]
str_marks' | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (StrictnessMark -> Bool) -> [StrictnessMark] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any StrictnessMark -> Bool
isMarkedStrict [StrictnessMark]
str_marks = []
| Bool
otherwise = [StrictnessMark]
str_marks
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,
dcConcreteTyVars :: ConcreteTyVars
dcConcreteTyVars = ConcreteTyVars
conc_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, dcImplBangs :: [HsImplBang]
dcImplBangs = [HsImplBang]
impl_bangs,
dcStricts :: [StrictnessMark]
dcStricts = [StrictnessMark]
str_marks',
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
mkScaledFunctionTys [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 = [ ForAllTyFlag -> TyVar -> TyConBinder
mkNamedTyConBinder (Specificity -> ForAllTyFlag
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_arg_bndrs :: [TyConBinder]
prom_arg_bndrs = [ TyVar -> TyConBinder
mkAnonTyConBinder (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_arg_bndrs
prom_res_kind :: Type
prom_res_kind = Type
orig_res_ty
promoted :: TyCon
promoted = DataCon
-> Name
-> Name
-> [TyConBinder]
-> Type
-> [Role]
-> PromDataConInfo
-> TyCon
mkPromotedDataCon DataCon
con Name
name Name
prom_info [TyConBinder]
prom_bndrs
Type
prom_res_kind [Role]
roles PromDataConInfo
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 = FastString -> OccName
mkTyVarOccFS (String -> FastString
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 -> UniqueSet -> Bool
`memberUniqueSet` UniqueSet
avoid_uniqs)
, Bool -> Bool
not (OccName
occ OccName -> OccSet -> Bool
`elemOccSet` OccSet
avoid_occs) ]
where
avoid_uniqs :: UniqueSet
avoid_uniqs :: UniqueSet
avoid_uniqs = [Unique] -> UniqueSet
fromListUniqueSet ((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
dataConConcreteTyVars :: DataCon -> ConcreteTyVars
dataConConcreteTyVars :: DataCon -> ConcreteTyVars
dataConConcreteTyVars (MkData { dcConcreteTyVars :: DataCon -> ConcreteTyVars
dcConcreteTyVars = ConcreteTyVars
concs }) = ConcreteTyVars
concs
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
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
ty1, Type
ty, Role
_) = HasDebugCallStack => TyVar -> (Type, Type, Role)
TyVar -> (Type, Type, Role)
coVarTypesRole TyVar
cv
tv :: TyVar
tv = HasDebugCallStack => Type -> TyVar
Type -> TyVar
getTyVar 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
forall doc. IsLine doc => doc -> doc -> doc
<+> 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
isLazyDataConRep :: DataCon -> Bool
isLazyDataConRep :: DataCon -> Bool
isLazyDataConRep DataCon
dc = [StrictnessMark] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataCon -> [StrictnessMark]
dcStricts DataCon
dc)
dataConRepStrictness :: DataCon -> [StrictnessMark]
dataConRepStrictness :: DataCon -> [StrictnessMark]
dataConRepStrictness DataCon
dc
| DataCon -> Bool
isLazyDataConRep DataCon
dc
= Arity -> StrictnessMark -> [StrictnessMark]
forall a. Arity -> a -> [a]
replicate (DataCon -> Arity
dataConRepArity DataCon
dc) StrictnessMark
NotMarkedStrict
| Bool
otherwise
= DataCon -> [StrictnessMark]
dcStricts DataCon
dc
dataConImplBangs :: DataCon -> [HsImplBang]
dataConImplBangs :: DataCon -> [HsImplBang]
dataConImplBangs DataCon
dc = DataCon -> [HsImplBang]
dcImplBangs DataCon
dc
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'
, HasDebugCallStack => Subst -> [Type] -> [Type]
Subst -> [Type] -> [Type]
substTheta Subst
subst (DataCon -> [Type]
dataConTheta DataCon
con)
, HasDebugCallStack => Subst -> [Type] -> [Type]
Subst -> [Type] -> [Type]
substTys Subst
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 :: Subst
univ_subst = [TyVar] -> [Type] -> Subst
HasDebugCallStack => [TyVar] -> [Type] -> Subst
zipTvSubst [TyVar]
univ_tvs [Type]
univ_tys
(Subst
subst, [TyVar]
ex_tvs') = HasDebugCallStack => Subst -> [TyVar] -> (Subst, [TyVar])
Subst -> [TyVar] -> (Subst, [TyVar])
Type.substVarBndrs Subst
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,
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
HasDebugCallStack => [Type] -> Type -> Type
mkInvisFunTys ([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
HasDebugCallStack => [Scaled Type] -> Type -> Type
mkScaledFunTys [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
HasDebugCallStack => [Type] -> Type -> Type
mkInvisFunTys ([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
HasDebugCallStack => [Scaled Type] -> Type -> Type
mkScaledFunTys [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
OneTy -> Type
ManyTy; 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
forall doc. IsLine doc => String -> doc
text String
"dataConInstArgTys" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [TyVar] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyVar]
univ_tvs SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [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
HasDebugCallStack => [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
forall doc. IsLine doc => String -> doc
text String
"dataConInstOrigArgTys" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [TyVar] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyVar]
tyvars SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [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
$
HasDebugCallStack => Subst -> [Scaled Type] -> [Scaled Type]
Subst -> [Scaled Type] -> [Scaled Type]
substScaledTys Subst
subst [Scaled Type]
arg_tys
where
tyvars :: [TyVar]
tyvars = [TyVar]
univ_tvs [TyVar] -> [TyVar] -> [TyVar]
forall a. [a] -> [a] -> [a]
++ [TyVar]
ex_tvs
subst :: Subst
subst = [TyVar] -> [Type] -> Subst
HasDebugCallStack => [TyVar] -> [Type] -> Subst
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
forall doc. IsLine doc => String -> doc
text String
"dataConInstUnivs"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
dc_args
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [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
$
[Type] -> [TyVar] -> ([TyVar], [TyVar])
forall b a. [b] -> [a] -> ([a], [a])
splitAtList [Type]
dc_args ([TyVar] -> ([TyVar], [TyVar])) -> [TyVar] -> ([TyVar], [TyVar])
forall a b. (a -> b) -> a -> b
$ DataCon -> [TyVar]
dataConUnivTyVars DataCon
dc
(Subst
_, [TyVar]
dc_args_suffix) = HasDebugCallStack => Subst -> [TyVar] -> (Subst, [TyVar])
Subst -> [TyVar] -> (Subst, [TyVar])
substTyVarBndrs Subst
prefix_subst [TyVar]
dc_univs_suffix
prefix_subst :: Subst
prefix_subst = InScopeSet -> TvSubstEnv -> Subst
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
HasDebugCallStack => [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
, dcRepTyCon :: DataCon -> TyCon
dcRepTyCon = TyCon
tc })
= case DataConRep
rep of
DCR { dcr_arg_tys :: DataConRep -> [Scaled Type]
dcr_arg_tys = [Scaled Type]
arg_tys } -> [Scaled Type]
arg_tys
DataConRep
NoDataConRep
| TyCon -> Bool
isTypeDataTyCon TyCon
tc -> Bool -> [Scaled Type] -> [Scaled Type]
forall a. HasCallStack => Bool -> a -> a
assert ([Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
theta) ([Scaled Type] -> [Scaled Type]) -> [Scaled Type] -> [Scaled Type]
forall a b. (a -> b) -> a -> b
$
[Scaled Type]
orig_arg_tys
| Bool
otherwise -> 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
dataConIdentity :: DataCon -> ByteString
dataConIdentity :: DataCon -> ByteString
dataConIdentity DataCon
dc = LazyByteString -> ByteString
LBS.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> LazyByteString
BSB.toLazyByteString (Builder -> LazyByteString) -> Builder -> LazyByteString
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
$ FastString -> ShortByteString
fastStringToShortByteString (FastString -> ShortByteString) -> FastString -> ShortByteString
forall a b. (a -> b) -> a -> b
$
Unit -> FastString
forall u. IsUnitId u => u -> FastString
unitFS (Unit -> FastString) -> Unit -> FastString
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
$ FastString -> ShortByteString
fastStringToShortByteString (FastString -> ShortByteString) -> FastString -> ShortByteString
forall a b. (a -> b) -> a -> b
$
ModuleName -> FastString
moduleNameFS (ModuleName -> FastString) -> ModuleName -> FastString
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
$ FastString -> ShortByteString
fastStringToShortByteString (FastString -> ShortByteString) -> FastString -> ShortByteString
forall a b. (a -> b) -> a -> b
$
OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
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
$ HasDebugCallStack => 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)
isTypeDataCon :: DataCon -> Bool
isTypeDataCon :: DataCon -> Bool
isTypeDataCon DataCon
dc = TyCon -> Bool
isTypeDataTyCon (DataCon -> TyCon
dataConTyCon DataCon
dc)
isCovertGadtDataCon :: DataCon -> Bool
isCovertGadtDataCon :: DataCon -> Bool
isCovertGadtDataCon (MkData { dcUnivTyVars :: DataCon -> [TyVar]
dcUnivTyVars = [TyVar]
univ_tvs
, dcEqSpec :: DataCon -> [EqSpec]
dcEqSpec = [EqSpec]
eq_spec
, dcRepTyCon :: DataCon -> TyCon
dcRepTyCon = TyCon
rep_tc })
= Bool -> Bool
not ([EqSpec] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EqSpec]
eq_spec)
Bool -> Bool -> Bool
&& Bool -> Bool
not ((EqSpec -> Bool) -> [EqSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any EqSpec -> Bool
is_visible_spec [EqSpec]
eq_spec)
where
visible_univ_tvs :: [TyVar]
visible_univ_tvs :: [TyVar]
visible_univ_tvs
= [ TyVar
univ_tv | (TyVar
univ_tv, TyConBinder
tcb) <- [TyVar]
univ_tvs [TyVar] -> [TyConBinder] -> [(TyVar, TyConBinder)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` TyCon -> [TyConBinder]
tyConBinders TyCon
rep_tc
, TyConBinder -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isVisibleTyConBinder TyConBinder
tcb ]
is_visible_spec :: EqSpec -> Bool
is_visible_spec :: EqSpec -> Bool
is_visible_spec (EqSpec TyVar
univ_tv Type
ty)
= TyVar
univ_tv TyVar -> [TyVar] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TyVar]
visible_univ_tvs
Bool -> Bool -> Bool
&& Bool -> Bool
not (Type -> Bool
isTyVarTy Type
ty)
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. HasCallStack => 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
_ -> []
dataConResRepTyArgs :: DataCon -> [Type]
dataConResRepTyArgs :: DataCon -> [Type]
dataConResRepTyArgs dc :: DataCon
dc@(MkData { dcRepTyCon :: DataCon -> TyCon
dcRepTyCon = TyCon
rep_tc, dcOrigResTy :: DataCon -> Type
dcOrigResTy = Type
orig_res_ty })
| Just (TyCon
fam_tc, [Type]
fam_args) <- TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe TyCon
rep_tc
=
case Type -> Type -> Maybe Subst
tcMatchTy (TyCon -> [Type] -> Type
mkTyConApp TyCon
fam_tc [Type]
fam_args) Type
orig_res_ty of
Just Subst
subst -> (TyVar -> Type) -> [TyVar] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (Subst -> TyVar -> Type
substTyVar Subst
subst) (TyCon -> [TyVar]
tyConTyVars TyCon
rep_tc)
Maybe Subst
Nothing -> String -> SDoc -> [Type]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"datacOnResRepTyArgs" (SDoc -> [Type]) -> SDoc -> [Type]
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc, TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
fam_tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
fam_args
, Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
orig_res_ty ]
| Bool
otherwise
= HasDebugCallStack => Type -> [Type]
Type -> [Type]
tyConAppArgs Type
orig_res_ty
checkDataConTyVars :: DataCon -> Bool
checkDataConTyVars :: DataCon -> Bool
checkDataConTyVars dc :: DataCon
dc@(MkData { dcUnivTyVars :: DataCon -> [TyVar]
dcUnivTyVars = [TyVar]
univ_tvs
, dcExTyCoVars :: DataCon -> [TyVar]
dcExTyCoVars = [TyVar]
ex_tvs
, dcEqSpec :: DataCon -> [EqSpec]
dcEqSpec = [EqSpec]
eq_spec })
= [TyVar] -> UnVarSet
mkUnVarSet [TyVar]
depleted_worker_vars UnVarSet -> UnVarSet -> Bool
forall a. Eq a => a -> a -> Bool
== [TyVar] -> UnVarSet
mkUnVarSet [TyVar]
wrapper_vars Bool -> Bool -> Bool
&&
(TyVar -> Bool) -> [TyVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (TyVar -> Bool) -> TyVar -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVar -> Bool
is_eq_spec_var) [TyVar]
wrapper_vars
where
worker_vars :: [TyVar]
worker_vars = [TyVar]
univ_tvs [TyVar] -> [TyVar] -> [TyVar]
forall a. [a] -> [a] -> [a]
++ [TyVar]
ex_tvs
eq_spec_tvs :: UnVarSet
eq_spec_tvs = [TyVar] -> UnVarSet
mkUnVarSet ((EqSpec -> TyVar) -> [EqSpec] -> [TyVar]
forall a b. (a -> b) -> [a] -> [b]
map EqSpec -> TyVar
eqSpecTyVar [EqSpec]
eq_spec)
is_eq_spec_var :: TyVar -> Bool
is_eq_spec_var = (TyVar -> UnVarSet -> Bool
`elemUnVarSet` UnVarSet
eq_spec_tvs)
depleted_worker_vars :: [TyVar]
depleted_worker_vars = (TyVar -> Bool) -> [TyVar] -> [TyVar]
forall a. (a -> Bool) -> [a] -> [a]
filterOut TyVar -> Bool
is_eq_spec_var [TyVar]
worker_vars
wrapper_vars :: [TyVar]
wrapper_vars = DataCon -> [TyVar]
dataConUserTyVars DataCon
dc
dataConUserTyVarsNeedWrapper :: DataCon -> Bool
dataConUserTyVarsNeedWrapper :: DataCon -> Bool
dataConUserTyVarsNeedWrapper dc :: DataCon
dc@(MkData { dcUnivTyVars :: DataCon -> [TyVar]
dcUnivTyVars = [TyVar]
univ_tvs
, dcExTyCoVars :: DataCon -> [TyVar]
dcExTyCoVars = [TyVar]
ex_tvs
, dcEqSpec :: DataCon -> [EqSpec]
dcEqSpec = [EqSpec]
eq_spec })
= Bool -> Bool -> Bool
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 Bool -> Bool -> Bool
|| Bool
answer)
Bool
answer
where
answer :: Bool
answer = ([TyVar]
univ_tvs [TyVar] -> [TyVar] -> [TyVar]
forall a. [a] -> [a] -> [a]
++ [TyVar]
ex_tvs) [TyVar] -> [TyVar] -> Bool
forall a. Eq a => a -> a -> Bool
/= DataCon -> [TyVar]
dataConUserTyVars DataCon
dc
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])
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