{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Core.TyCon(
TyCon,
AlgTyConRhs(..), visibleDataCons,
AlgTyConFlav(..), isNoParent,
FamTyConFlav(..), Role(..), Injectivity(..),
RuntimeRepInfo(..), TyConFlavour(..),
TyConBinder, TyConBndrVis(..), TyConTyCoBinder,
mkNamedTyConBinder, mkNamedTyConBinders,
mkRequiredTyConBinder,
mkAnonTyConBinder, mkAnonTyConBinders,
tyConBinderArgFlag, tyConBndrVisArgFlag, isNamedTyConBinder,
isVisibleTyConBinder, isInvisibleTyConBinder,
tyConFieldLabels, lookupTyConFieldLabel,
mkAlgTyCon,
mkClassTyCon,
mkFunTyCon,
mkPrimTyCon,
mkKindTyCon,
mkLiftedPrimTyCon,
mkTupleTyCon,
mkSumTyCon,
mkDataTyConRhs,
mkSynonymTyCon,
mkFamilyTyCon,
mkPromotedDataCon,
mkTcTyCon,
noTcTyConScopedTyVars,
isAlgTyCon, isVanillaAlgTyCon, isConstraintKindCon,
isClassTyCon, isFamInstTyCon,
isFunTyCon,
isPrimTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon,
isUnboxedSumTyCon, isPromotedTupleTyCon,
isLiftedAlgTyCon,
isTypeSynonymTyCon,
mustBeSaturated,
isPromotedDataCon, isPromotedDataCon_maybe,
isKindTyCon, isLiftedTypeKindTyConName,
isTauTyCon, isFamFreeTyCon, isForgetfulSynTyCon,
isDataTyCon,
isEnumerationTyCon,
isNewTyCon, isAbstractTyCon,
isFamilyTyCon, isOpenFamilyTyCon,
isTypeFamilyTyCon, isDataFamilyTyCon,
isOpenTypeFamilyTyCon, isClosedSynFamilyTyConWithAxiom_maybe,
tyConInjectivityInfo,
isBuiltInSynFamTyCon_maybe,
isUnliftedTyCon,
isGadtSyntaxTyCon, isInjectiveTyCon, isGenerativeTyCon, isGenInjAlgRhs,
isTyConAssoc, tyConAssoc_maybe, tyConFlavourAssoc_maybe,
isImplicitTyCon,
isTyConWithSrcDataCons,
isTcTyCon, setTcTyConKind,
isTcLevPoly,
tyConName,
tyConSkolem,
tyConKind,
tyConUnique,
tyConTyVars, tyConVisibleTyVars,
tyConCType, tyConCType_maybe,
tyConDataCons, tyConDataCons_maybe,
tyConSingleDataCon_maybe, tyConSingleDataCon,
tyConAlgDataCons_maybe,
tyConSingleAlgDataCon_maybe,
tyConFamilySize,
tyConStupidTheta,
tyConArity,
tyConNullaryTy,
tyConRoles,
tyConFlavour,
tyConTuple_maybe, tyConClass_maybe, tyConATs,
tyConFamInst_maybe, tyConFamInstSig_maybe, tyConFamilyCoercion_maybe,
tyConFamilyResVar_maybe,
synTyConDefn_maybe, synTyConRhs_maybe,
famTyConFlav_maybe, famTcResVar,
algTyConRhs,
newTyConRhs, newTyConEtadArity, newTyConEtadRhs,
unwrapNewTyCon_maybe, unwrapNewTyConEtad_maybe,
newTyConDataCon_maybe,
algTcFields,
tyConRuntimeRepInfo,
tyConBinders, tyConResKind, tyConInvisTVBinders,
tcTyConScopedTyVars, tcTyConIsPoly,
mkTyConTagMap,
expandSynTyCon_maybe,
newTyConCo, newTyConCo_maybe,
pprPromotionQuote, mkTyConKind,
tcFlavourIsOpen,
TyConRepName, tyConRepName_maybe,
mkPrelTyConRepName,
tyConRepModOcc,
PrimRep(..), PrimElemRep(..),
isVoidRep, isGcPtrRep,
primRepSizeB,
primElemRepSizeB,
primRepIsFloat,
primRepsCompatible,
primRepCompatible,
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Platform
import {-# SOURCE #-} GHC.Core.TyCo.Rep
( Kind, Type, PredType, mkForAllTy, mkFunTyMany, mkTyConTy_ )
import {-# SOURCE #-} GHC.Core.TyCo.Ppr
( pprType )
import {-# SOURCE #-} GHC.Builtin.Types
( runtimeRepTyCon, constraintKind, levityTyCon
, multiplicityTyCon
, vecCountTyCon, vecElemTyCon, liftedTypeKind )
import {-# SOURCE #-} GHC.Core.DataCon
( DataCon, dataConFieldLabels
, dataConTyCon, dataConFullSig
, isUnboxedSumDataCon )
import {-# SOURCE #-} GHC.Core.Type
( isLiftedTypeKind )
import GHC.Builtin.Uniques
( tyConRepNameUnique
, dataConTyRepNameUnique )
import GHC.Utils.Binary
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Core.Class
import GHC.Types.Basic
import GHC.Types.ForeignCall
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Core.Coercion.Axiom
import GHC.Builtin.Names
import GHC.Data.Maybe
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.FastString.Env
import GHC.Types.FieldLabel
import GHC.Settings.Constants
import GHC.Utils.Misc
import GHC.Types.Unique.Set
import GHC.Unit.Module
import qualified Data.Data as Data
type TyConBinder = VarBndr TyVar TyConBndrVis
type TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis
data TyConBndrVis
= NamedTCB ArgFlag
| AnonTCB AnonArgFlag
instance Outputable TyConBndrVis where
ppr :: TyConBndrVis -> SDoc
ppr (NamedTCB ArgFlag
flag) = String -> SDoc
text String
"NamedTCB" SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr ArgFlag
flag
ppr (AnonTCB AnonArgFlag
af) = String -> SDoc
text String
"AnonTCB" SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr AnonArgFlag
af
mkAnonTyConBinder :: AnonArgFlag -> TyVar -> TyConBinder
mkAnonTyConBinder :: AnonArgFlag -> TyVar -> TyConBinder
mkAnonTyConBinder AnonArgFlag
af TyVar
tv = ASSERT( isTyVar tv)
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv (AnonArgFlag -> TyConBndrVis
AnonTCB AnonArgFlag
af)
mkAnonTyConBinders :: AnonArgFlag -> [TyVar] -> [TyConBinder]
mkAnonTyConBinders :: AnonArgFlag -> [TyVar] -> [TyConBinder]
mkAnonTyConBinders AnonArgFlag
af [TyVar]
tvs = forall a b. (a -> b) -> [a] -> [b]
map (AnonArgFlag -> TyVar -> TyConBinder
mkAnonTyConBinder AnonArgFlag
af) [TyVar]
tvs
mkNamedTyConBinder :: ArgFlag -> TyVar -> TyConBinder
mkNamedTyConBinder :: ArgFlag -> TyVar -> TyConBinder
mkNamedTyConBinder ArgFlag
vis TyVar
tv = ASSERT( isTyVar tv )
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv (ArgFlag -> TyConBndrVis
NamedTCB ArgFlag
vis)
mkNamedTyConBinders :: ArgFlag -> [TyVar] -> [TyConBinder]
mkNamedTyConBinders :: ArgFlag -> [TyVar] -> [TyConBinder]
mkNamedTyConBinders ArgFlag
vis [TyVar]
tvs = forall a b. (a -> b) -> [a] -> [b]
map (ArgFlag -> TyVar -> TyConBinder
mkNamedTyConBinder ArgFlag
vis) [TyVar]
tvs
mkRequiredTyConBinder :: TyCoVarSet
-> TyVar
-> TyConBinder
mkRequiredTyConBinder :: TyCoVarSet -> TyVar -> TyConBinder
mkRequiredTyConBinder TyCoVarSet
dep_set TyVar
tv
| TyVar
tv TyVar -> TyCoVarSet -> Bool
`elemVarSet` TyCoVarSet
dep_set = ArgFlag -> TyVar -> TyConBinder
mkNamedTyConBinder ArgFlag
Required TyVar
tv
| Bool
otherwise = AnonArgFlag -> TyVar -> TyConBinder
mkAnonTyConBinder AnonArgFlag
VisArg TyVar
tv
tyConBinderArgFlag :: TyConBinder -> ArgFlag
tyConBinderArgFlag :: TyConBinder -> ArgFlag
tyConBinderArgFlag (Bndr TyVar
_ TyConBndrVis
vis) = TyConBndrVis -> ArgFlag
tyConBndrVisArgFlag TyConBndrVis
vis
tyConBndrVisArgFlag :: TyConBndrVis -> ArgFlag
tyConBndrVisArgFlag :: TyConBndrVis -> ArgFlag
tyConBndrVisArgFlag (NamedTCB ArgFlag
vis) = ArgFlag
vis
tyConBndrVisArgFlag (AnonTCB AnonArgFlag
VisArg) = ArgFlag
Required
tyConBndrVisArgFlag (AnonTCB AnonArgFlag
InvisArg) = ArgFlag
Inferred
isNamedTyConBinder :: TyConBinder -> Bool
isNamedTyConBinder :: TyConBinder -> Bool
isNamedTyConBinder (Bndr TyVar
_ (NamedTCB {})) = Bool
True
isNamedTyConBinder TyConBinder
_ = Bool
False
isVisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool
isVisibleTyConBinder :: forall tv. VarBndr tv TyConBndrVis -> Bool
isVisibleTyConBinder (Bndr tv
_ TyConBndrVis
tcb_vis) = TyConBndrVis -> Bool
isVisibleTcbVis TyConBndrVis
tcb_vis
isVisibleTcbVis :: TyConBndrVis -> Bool
isVisibleTcbVis :: TyConBndrVis -> Bool
isVisibleTcbVis (NamedTCB ArgFlag
vis) = ArgFlag -> Bool
isVisibleArgFlag ArgFlag
vis
isVisibleTcbVis (AnonTCB AnonArgFlag
VisArg) = Bool
True
isVisibleTcbVis (AnonTCB AnonArgFlag
InvisArg) = Bool
False
isInvisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder :: forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder VarBndr tv TyConBndrVis
tcb = Bool -> Bool
not (forall tv. VarBndr tv TyConBndrVis -> Bool
isVisibleTyConBinder VarBndr tv TyConBndrVis
tcb)
mkTyConKind :: [TyConBinder] -> Kind -> Kind
mkTyConKind :: [TyConBinder] -> Kind -> Kind
mkTyConKind [TyConBinder]
bndrs Kind
res_kind = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TyConBinder -> Kind -> Kind
mk Kind
res_kind [TyConBinder]
bndrs
where
mk :: TyConBinder -> Kind -> Kind
mk :: TyConBinder -> Kind -> Kind
mk (Bndr TyVar
tv (AnonTCB AnonArgFlag
af)) Kind
k = AnonArgFlag -> Kind -> Kind -> Kind
mkFunTyMany AnonArgFlag
af (TyVar -> Kind
varType TyVar
tv) Kind
k
mk (Bndr TyVar
tv (NamedTCB ArgFlag
vis)) Kind
k = TyVar -> ArgFlag -> Kind -> Kind
mkForAllTy TyVar
tv ArgFlag
vis Kind
k
tyConInvisTVBinders :: [TyConBinder]
-> [InvisTVBinder]
tyConInvisTVBinders :: [TyConBinder] -> [InvisTVBinder]
tyConInvisTVBinders [TyConBinder]
tc_bndrs
= forall a b. (a -> b) -> [a] -> [b]
map TyConBinder -> InvisTVBinder
mk_binder [TyConBinder]
tc_bndrs
where
mk_binder :: TyConBinder -> InvisTVBinder
mk_binder (Bndr TyVar
tv TyConBndrVis
tc_vis) = forall vis. vis -> TyVar -> VarBndr TyVar vis
mkTyVarBinder Specificity
vis TyVar
tv
where
vis :: Specificity
vis = case TyConBndrVis
tc_vis of
AnonTCB AnonArgFlag
VisArg -> Specificity
SpecifiedSpec
AnonTCB AnonArgFlag
InvisArg -> Specificity
InferredSpec
NamedTCB ArgFlag
Required -> Specificity
SpecifiedSpec
NamedTCB (Invisible Specificity
vis) -> Specificity
vis
tyConVisibleTyVars :: TyCon -> [TyVar]
tyConVisibleTyVars :: TyCon -> [TyVar]
tyConVisibleTyVars TyCon
tc
= [ TyVar
tv | Bndr TyVar
tv TyConBndrVis
vis <- TyCon -> [TyConBinder]
tyConBinders TyCon
tc
, TyConBndrVis -> Bool
isVisibleTcbVis TyConBndrVis
vis ]
instance OutputableBndr tv => Outputable (VarBndr tv TyConBndrVis) where
ppr :: VarBndr tv TyConBndrVis -> SDoc
ppr (Bndr tv
v TyConBndrVis
bi) = TyConBndrVis -> SDoc
ppr_bi TyConBndrVis
bi SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind tv
v)
where
ppr_bi :: TyConBndrVis -> SDoc
ppr_bi (AnonTCB AnonArgFlag
VisArg) = String -> SDoc
text String
"anon-vis"
ppr_bi (AnonTCB AnonArgFlag
InvisArg) = String -> SDoc
text String
"anon-invis"
ppr_bi (NamedTCB ArgFlag
Required) = String -> SDoc
text String
"req"
ppr_bi (NamedTCB (Invisible Specificity
spec)) = case Specificity
spec of
Specificity
SpecifiedSpec -> String -> SDoc
text String
"spec"
Specificity
InferredSpec -> String -> SDoc
text String
"inf"
instance Binary TyConBndrVis where
put_ :: BinHandle -> TyConBndrVis -> IO ()
put_ BinHandle
bh (AnonTCB AnonArgFlag
af) = do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh AnonArgFlag
af }
put_ BinHandle
bh (NamedTCB ArgFlag
vis) = do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ArgFlag
vis }
get :: BinHandle -> IO TyConBndrVis
get BinHandle
bh = do { Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
; case Word8
h of
Word8
0 -> do { AnonArgFlag
af <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; forall (m :: * -> *) a. Monad m => a -> m a
return (AnonArgFlag -> TyConBndrVis
AnonTCB AnonArgFlag
af) }
Word8
_ -> do { ArgFlag
vis <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; forall (m :: * -> *) a. Monad m => a -> m a
return (ArgFlag -> TyConBndrVis
NamedTCB ArgFlag
vis) } }
data TyCon
=
FunTyCon {
TyCon -> Unique
tyConUnique :: Unique,
TyCon -> Name
tyConName :: Name,
TyCon -> [TyConBinder]
tyConBinders :: [TyConBinder],
TyCon -> Kind
tyConResKind :: Kind,
TyCon -> Kind
tyConKind :: Kind,
TyCon -> ConTag
tyConArity :: Arity,
TyCon -> Kind
tyConNullaryTy :: Type,
TyCon -> Name
tcRepName :: TyConRepName
}
| AlgTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConBinders :: [TyConBinder],
TyCon -> [TyVar]
tyConTyVars :: [TyVar],
tyConResKind :: Kind,
tyConKind :: Kind,
tyConArity :: Arity,
tyConNullaryTy :: Type,
TyCon -> [Role]
tcRoles :: [Role],
TyCon -> Maybe CType
tyConCType :: Maybe CType,
TyCon -> Bool
algTcGadtSyntax :: Bool,
TyCon -> [Kind]
algTcStupidTheta :: [PredType],
TyCon -> AlgTyConRhs
algTcRhs :: AlgTyConRhs,
TyCon -> FieldLabelEnv
algTcFields :: FieldLabelEnv,
TyCon -> AlgTyConFlav
algTcParent :: AlgTyConFlav
}
| SynonymTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConBinders :: [TyConBinder],
tyConTyVars :: [TyVar],
tyConResKind :: Kind,
tyConKind :: Kind,
tyConArity :: Arity,
tyConNullaryTy :: Type,
tcRoles :: [Role],
TyCon -> Kind
synTcRhs :: Type,
TyCon -> Bool
synIsTau :: Bool,
TyCon -> Bool
synIsFamFree :: Bool,
TyCon -> Bool
synIsForgetful :: Bool
}
| FamilyTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConBinders :: [TyConBinder],
tyConTyVars :: [TyVar],
tyConResKind :: Kind,
tyConKind :: Kind,
tyConArity :: Arity,
tyConNullaryTy :: Type,
TyCon -> Maybe Name
famTcResVar :: Maybe Name,
TyCon -> FamTyConFlav
famTcFlav :: FamTyConFlav,
TyCon -> Maybe TyCon
famTcParent :: Maybe TyCon,
TyCon -> Injectivity
famTcInj :: Injectivity
}
| PrimTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConBinders :: [TyConBinder],
tyConResKind :: Kind,
tyConKind :: Kind,
tyConArity :: Arity,
tyConNullaryTy :: Type,
tcRoles :: [Role],
TyCon -> Bool
isUnlifted :: Bool,
TyCon -> Maybe Name
primRepName :: Maybe TyConRepName
}
| PromotedDataCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConBinders :: [TyConTyCoBinder],
tyConResKind :: Kind,
tyConKind :: Kind,
tyConArity :: Arity,
tyConNullaryTy :: Type,
tcRoles :: [Role],
TyCon -> DataCon
dataCon :: DataCon,
tcRepName :: TyConRepName,
TyCon -> RuntimeRepInfo
promDcRepInfo :: RuntimeRepInfo
}
| TcTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConBinders :: [TyConBinder],
tyConTyVars :: [TyVar],
tyConResKind :: Kind,
tyConKind :: Kind,
tyConArity :: Arity,
tyConNullaryTy :: Type,
TyCon -> [(Name, TyVar)]
tcTyConScopedTyVars :: [(Name,TyVar)],
TyCon -> Bool
tcTyConIsPoly :: Bool,
TyCon -> TyConFlavour
tcTyConFlavour :: TyConFlavour
}
data AlgTyConRhs
= AbstractTyCon
| DataTyCon {
AlgTyConRhs -> [DataCon]
data_cons :: [DataCon],
AlgTyConRhs -> ConTag
data_cons_size :: Int,
AlgTyConRhs -> Bool
is_enum :: Bool
}
| TupleTyCon {
AlgTyConRhs -> DataCon
data_con :: DataCon,
AlgTyConRhs -> TupleSort
tup_sort :: TupleSort
}
| SumTyCon {
data_cons :: [DataCon],
data_cons_size :: Int
}
| NewTyCon {
data_con :: DataCon,
AlgTyConRhs -> Kind
nt_rhs :: Type,
AlgTyConRhs -> ([TyVar], Kind)
nt_etad_rhs :: ([TyVar], Type),
AlgTyConRhs -> CoAxiom Unbranched
nt_co :: CoAxiom Unbranched,
AlgTyConRhs -> Bool
nt_lev_poly :: Bool
}
mkSumTyConRhs :: [DataCon] -> AlgTyConRhs
mkSumTyConRhs :: [DataCon] -> AlgTyConRhs
mkSumTyConRhs [DataCon]
data_cons = [DataCon] -> ConTag -> AlgTyConRhs
SumTyCon [DataCon]
data_cons (forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [DataCon]
data_cons)
mkDataTyConRhs :: [DataCon] -> AlgTyConRhs
mkDataTyConRhs :: [DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon]
cons
= DataTyCon {
data_cons :: [DataCon]
data_cons = [DataCon]
cons,
data_cons_size :: ConTag
data_cons_size = forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [DataCon]
cons,
is_enum :: Bool
is_enum = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
cons) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all DataCon -> Bool
is_enum_con [DataCon]
cons
}
where
is_enum_con :: DataCon -> Bool
is_enum_con DataCon
con
| ([TyVar]
_univ_tvs, [TyVar]
ex_tvs, [EqSpec]
eq_spec, [Kind]
theta, [Scaled Kind]
arg_tys, Kind
_res)
<- DataCon
-> ([TyVar], [TyVar], [EqSpec], [Kind], [Scaled Kind], Kind)
dataConFullSig DataCon
con
= forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
ex_tvs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EqSpec]
eq_spec Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Kind]
theta Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Scaled Kind]
arg_tys
data RuntimeRepInfo
= NoRRI
| RuntimeRep ([Type] -> [PrimRep])
| VecCount Int
| VecElem PrimElemRep
| LiftedInfo
| UnliftedInfo
visibleDataCons :: AlgTyConRhs -> [DataCon]
visibleDataCons :: AlgTyConRhs -> [DataCon]
visibleDataCons (AbstractTyCon {}) = []
visibleDataCons (DataTyCon{ data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon]
cs }) = [DataCon]
cs
visibleDataCons (NewTyCon{ data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
c }) = [DataCon
c]
visibleDataCons (TupleTyCon{ data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
c }) = [DataCon
c]
visibleDataCons (SumTyCon{ data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon]
cs }) = [DataCon]
cs
data AlgTyConFlav
=
VanillaAlgTyCon
TyConRepName
| UnboxedAlgTyCon
(Maybe TyConRepName)
| ClassTyCon
Class
TyConRepName
| DataFamInstTyCon
(CoAxiom Unbranched)
TyCon
[Type]
instance Outputable AlgTyConFlav where
ppr :: AlgTyConFlav -> SDoc
ppr (VanillaAlgTyCon {}) = String -> SDoc
text String
"Vanilla ADT"
ppr (UnboxedAlgTyCon {}) = String -> SDoc
text String
"Unboxed ADT"
ppr (ClassTyCon Class
cls Name
_) = String -> SDoc
text String
"Class parent" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Class
cls
ppr (DataFamInstTyCon CoAxiom Unbranched
_ TyCon
tc [Kind]
tys) = String -> SDoc
text String
"Family parent (family instance)"
SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr TyCon
tc SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
sep (forall a b. (a -> b) -> [a] -> [b]
map Kind -> SDoc
pprType [Kind]
tys)
okParent :: Name -> AlgTyConFlav -> Bool
okParent :: Name -> AlgTyConFlav -> Bool
okParent Name
_ (VanillaAlgTyCon {}) = Bool
True
okParent Name
_ (UnboxedAlgTyCon {}) = Bool
True
okParent Name
tc_name (ClassTyCon Class
cls Name
_) = Name
tc_name forall a. Eq a => a -> a -> Bool
== TyCon -> Name
tyConName (Class -> TyCon
classTyCon Class
cls)
okParent Name
_ (DataFamInstTyCon CoAxiom Unbranched
_ TyCon
fam_tc [Kind]
tys) = [Kind]
tys forall a. [a] -> ConTag -> Bool
`lengthAtLeast` TyCon -> ConTag
tyConArity TyCon
fam_tc
isNoParent :: AlgTyConFlav -> Bool
isNoParent :: AlgTyConFlav -> Bool
isNoParent (VanillaAlgTyCon {}) = Bool
True
isNoParent AlgTyConFlav
_ = Bool
False
data Injectivity
= NotInjective
| Injective [Bool]
deriving( Injectivity -> Injectivity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Injectivity -> Injectivity -> Bool
$c/= :: Injectivity -> Injectivity -> Bool
== :: Injectivity -> Injectivity -> Bool
$c== :: Injectivity -> Injectivity -> Bool
Eq )
data FamTyConFlav
=
DataFamilyTyCon
TyConRepName
| OpenSynFamilyTyCon
| ClosedSynFamilyTyCon (Maybe (CoAxiom Branched))
| AbstractClosedSynFamilyTyCon
| BuiltInSynFamTyCon BuiltInSynFamily
instance Outputable FamTyConFlav where
ppr :: FamTyConFlav -> SDoc
ppr (DataFamilyTyCon Name
n) = String -> SDoc
text String
"data family" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
n
ppr FamTyConFlav
OpenSynFamilyTyCon = String -> SDoc
text String
"open type family"
ppr (ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
Nothing) = String -> SDoc
text String
"closed type family"
ppr (ClosedSynFamilyTyCon (Just CoAxiom Branched
coax)) = String -> SDoc
text String
"closed type family" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr CoAxiom Branched
coax
ppr FamTyConFlav
AbstractClosedSynFamilyTyCon = String -> SDoc
text String
"abstract closed type family"
ppr (BuiltInSynFamTyCon BuiltInSynFamily
_) = String -> SDoc
text String
"built-in type family"
type TyConRepName = Name
tyConRepName_maybe :: TyCon -> Maybe TyConRepName
tyConRepName_maybe :: TyCon -> Maybe Name
tyConRepName_maybe (FunTyCon { tcRepName :: TyCon -> Name
tcRepName = Name
rep_nm })
= forall a. a -> Maybe a
Just Name
rep_nm
tyConRepName_maybe (PrimTyCon { primRepName :: TyCon -> Maybe Name
primRepName = Maybe Name
mb_rep_nm })
= Maybe Name
mb_rep_nm
tyConRepName_maybe (AlgTyCon { algTcParent :: TyCon -> AlgTyConFlav
algTcParent = AlgTyConFlav
parent })
| VanillaAlgTyCon Name
rep_nm <- AlgTyConFlav
parent = forall a. a -> Maybe a
Just Name
rep_nm
| ClassTyCon Class
_ Name
rep_nm <- AlgTyConFlav
parent = forall a. a -> Maybe a
Just Name
rep_nm
| UnboxedAlgTyCon Maybe Name
rep_nm <- AlgTyConFlav
parent = Maybe Name
rep_nm
tyConRepName_maybe (FamilyTyCon { famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = DataFamilyTyCon Name
rep_nm })
= forall a. a -> Maybe a
Just Name
rep_nm
tyConRepName_maybe (PromotedDataCon { dataCon :: TyCon -> DataCon
dataCon = DataCon
dc, tcRepName :: TyCon -> Name
tcRepName = Name
rep_nm })
| DataCon -> Bool
isUnboxedSumDataCon DataCon
dc
= forall a. Maybe a
Nothing
| Bool
otherwise
= forall a. a -> Maybe a
Just Name
rep_nm
tyConRepName_maybe TyCon
_ = forall a. Maybe a
Nothing
mkPrelTyConRepName :: Name -> TyConRepName
mkPrelTyConRepName :: Name -> Name
mkPrelTyConRepName Name
tc_name
= Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName Unique
rep_uniq Module
rep_mod OccName
rep_occ (Name -> SrcSpan
nameSrcSpan Name
tc_name)
where
name_occ :: OccName
name_occ = Name -> OccName
nameOccName Name
tc_name
name_mod :: Module
name_mod = HasDebugCallStack => Name -> Module
nameModule Name
tc_name
name_uniq :: Unique
name_uniq = Name -> Unique
nameUnique Name
tc_name
rep_uniq :: Unique
rep_uniq | OccName -> Bool
isTcOcc OccName
name_occ = Unique -> Unique
tyConRepNameUnique Unique
name_uniq
| Bool
otherwise = Unique -> Unique
dataConTyRepNameUnique Unique
name_uniq
(Module
rep_mod, OccName
rep_occ) = Module -> OccName -> (Module, OccName)
tyConRepModOcc Module
name_mod OccName
name_occ
tyConRepModOcc :: Module -> OccName -> (Module, OccName)
tyConRepModOcc :: Module -> OccName -> (Module, OccName)
tyConRepModOcc Module
tc_module OccName
tc_occ = (Module
rep_module, OccName -> OccName
mkTyConRepOcc OccName
tc_occ)
where
rep_module :: Module
rep_module
| Module
tc_module forall a. Eq a => a -> a -> Bool
== Module
gHC_PRIM = Module
gHC_TYPES
| Bool
otherwise = Module
tc_module
data PrimRep
= VoidRep
| LiftedRep
| UnliftedRep
| Int8Rep
| Int16Rep
| Int32Rep
| Int64Rep
| IntRep
| Word8Rep
| Word16Rep
| Word32Rep
| Word64Rep
| WordRep
| AddrRep
| FloatRep
| DoubleRep
| VecRep Int PrimElemRep
deriving( PrimRep -> PrimRep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimRep -> PrimRep -> Bool
$c/= :: PrimRep -> PrimRep -> Bool
== :: PrimRep -> PrimRep -> Bool
$c== :: PrimRep -> PrimRep -> Bool
Eq, ConTag -> PrimRep -> ShowS
[PrimRep] -> ShowS
PrimRep -> String
forall a.
(ConTag -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimRep] -> ShowS
$cshowList :: [PrimRep] -> ShowS
show :: PrimRep -> String
$cshow :: PrimRep -> String
showsPrec :: ConTag -> PrimRep -> ShowS
$cshowsPrec :: ConTag -> PrimRep -> ShowS
Show )
data PrimElemRep
= Int8ElemRep
| Int16ElemRep
| Int32ElemRep
| Int64ElemRep
| Word8ElemRep
| Word16ElemRep
| Word32ElemRep
| Word64ElemRep
| FloatElemRep
| DoubleElemRep
deriving( PrimElemRep -> PrimElemRep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimElemRep -> PrimElemRep -> Bool
$c/= :: PrimElemRep -> PrimElemRep -> Bool
== :: PrimElemRep -> PrimElemRep -> Bool
$c== :: PrimElemRep -> PrimElemRep -> Bool
Eq, ConTag -> PrimElemRep -> ShowS
[PrimElemRep] -> ShowS
PrimElemRep -> String
forall a.
(ConTag -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimElemRep] -> ShowS
$cshowList :: [PrimElemRep] -> ShowS
show :: PrimElemRep -> String
$cshow :: PrimElemRep -> String
showsPrec :: ConTag -> PrimElemRep -> ShowS
$cshowsPrec :: ConTag -> PrimElemRep -> ShowS
Show )
instance Outputable PrimRep where
ppr :: PrimRep -> SDoc
ppr PrimRep
r = String -> SDoc
text (forall a. Show a => a -> String
show PrimRep
r)
instance Outputable PrimElemRep where
ppr :: PrimElemRep -> SDoc
ppr PrimElemRep
r = String -> SDoc
text (forall a. Show a => a -> String
show PrimElemRep
r)
isVoidRep :: PrimRep -> Bool
isVoidRep :: PrimRep -> Bool
isVoidRep PrimRep
VoidRep = Bool
True
isVoidRep PrimRep
_other = Bool
False
isGcPtrRep :: PrimRep -> Bool
isGcPtrRep :: PrimRep -> Bool
isGcPtrRep PrimRep
LiftedRep = Bool
True
isGcPtrRep PrimRep
UnliftedRep = Bool
True
isGcPtrRep PrimRep
_ = Bool
False
primRepCompatible :: Platform -> PrimRep -> PrimRep -> Bool
primRepCompatible :: Platform -> PrimRep -> PrimRep -> Bool
primRepCompatible Platform
platform PrimRep
rep1 PrimRep
rep2 =
(PrimRep -> Bool
isUnboxed PrimRep
rep1 forall a. Eq a => a -> a -> Bool
== PrimRep -> Bool
isUnboxed PrimRep
rep2) Bool -> Bool -> Bool
&&
(Platform -> PrimRep -> ConTag
primRepSizeB Platform
platform PrimRep
rep1 forall a. Eq a => a -> a -> Bool
== Platform -> PrimRep -> ConTag
primRepSizeB Platform
platform PrimRep
rep2) Bool -> Bool -> Bool
&&
(PrimRep -> Maybe Bool
primRepIsFloat PrimRep
rep1 forall a. Eq a => a -> a -> Bool
== PrimRep -> Maybe Bool
primRepIsFloat PrimRep
rep2)
where
isUnboxed :: PrimRep -> Bool
isUnboxed = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimRep -> Bool
isGcPtrRep
primRepsCompatible :: Platform -> [PrimRep] -> [PrimRep] -> Bool
primRepsCompatible :: Platform -> [PrimRep] -> [PrimRep] -> Bool
primRepsCompatible Platform
platform [PrimRep]
reps1 [PrimRep]
reps2 =
forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [PrimRep]
reps1 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [PrimRep]
reps2 Bool -> Bool -> Bool
&&
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Platform -> PrimRep -> PrimRep -> Bool
primRepCompatible Platform
platform) [PrimRep]
reps1 [PrimRep]
reps2)
primRepSizeB :: Platform -> PrimRep -> Int
primRepSizeB :: Platform -> PrimRep -> ConTag
primRepSizeB Platform
platform = \case
PrimRep
IntRep -> Platform -> ConTag
platformWordSizeInBytes Platform
platform
PrimRep
WordRep -> Platform -> ConTag
platformWordSizeInBytes Platform
platform
PrimRep
Int8Rep -> ConTag
1
PrimRep
Int16Rep -> ConTag
2
PrimRep
Int32Rep -> ConTag
4
PrimRep
Int64Rep -> ConTag
8
PrimRep
Word8Rep -> ConTag
1
PrimRep
Word16Rep -> ConTag
2
PrimRep
Word32Rep -> ConTag
4
PrimRep
Word64Rep -> ConTag
8
PrimRep
FloatRep -> ConTag
fLOAT_SIZE
PrimRep
DoubleRep -> ConTag
dOUBLE_SIZE
PrimRep
AddrRep -> Platform -> ConTag
platformWordSizeInBytes Platform
platform
PrimRep
LiftedRep -> Platform -> ConTag
platformWordSizeInBytes Platform
platform
PrimRep
UnliftedRep -> Platform -> ConTag
platformWordSizeInBytes Platform
platform
PrimRep
VoidRep -> ConTag
0
(VecRep ConTag
len PrimElemRep
rep) -> ConTag
len forall a. Num a => a -> a -> a
* PrimElemRep -> ConTag
primElemRepSizeB PrimElemRep
rep
primElemRepSizeB :: PrimElemRep -> Int
primElemRepSizeB :: PrimElemRep -> ConTag
primElemRepSizeB PrimElemRep
Int8ElemRep = ConTag
1
primElemRepSizeB PrimElemRep
Int16ElemRep = ConTag
2
primElemRepSizeB PrimElemRep
Int32ElemRep = ConTag
4
primElemRepSizeB PrimElemRep
Int64ElemRep = ConTag
8
primElemRepSizeB PrimElemRep
Word8ElemRep = ConTag
1
primElemRepSizeB PrimElemRep
Word16ElemRep = ConTag
2
primElemRepSizeB PrimElemRep
Word32ElemRep = ConTag
4
primElemRepSizeB PrimElemRep
Word64ElemRep = ConTag
8
primElemRepSizeB PrimElemRep
FloatElemRep = ConTag
4
primElemRepSizeB PrimElemRep
DoubleElemRep = ConTag
8
primRepIsFloat :: PrimRep -> Maybe Bool
primRepIsFloat :: PrimRep -> Maybe Bool
primRepIsFloat PrimRep
FloatRep = forall a. a -> Maybe a
Just Bool
True
primRepIsFloat PrimRep
DoubleRep = forall a. a -> Maybe a
Just Bool
True
primRepIsFloat (VecRep ConTag
_ PrimElemRep
_) = forall a. Maybe a
Nothing
primRepIsFloat PrimRep
_ = forall a. a -> Maybe a
Just Bool
False
tyConFieldLabels :: TyCon -> [FieldLabel]
tyConFieldLabels :: TyCon -> [FieldLabel]
tyConFieldLabels TyCon
tc = forall a. DFastStringEnv a -> [a]
dFsEnvElts forall a b. (a -> b) -> a -> b
$ TyCon -> FieldLabelEnv
tyConFieldLabelEnv TyCon
tc
tyConFieldLabelEnv :: TyCon -> FieldLabelEnv
tyConFieldLabelEnv :: TyCon -> FieldLabelEnv
tyConFieldLabelEnv TyCon
tc
| TyCon -> Bool
isAlgTyCon TyCon
tc = TyCon -> FieldLabelEnv
algTcFields TyCon
tc
| Bool
otherwise = forall a. DFastStringEnv a
emptyDFsEnv
lookupTyConFieldLabel :: FieldLabelString -> TyCon -> Maybe FieldLabel
lookupTyConFieldLabel :: FieldLabelString -> TyCon -> Maybe FieldLabel
lookupTyConFieldLabel FieldLabelString
lbl TyCon
tc = forall a. DFastStringEnv a -> FieldLabelString -> Maybe a
lookupDFsEnv (TyCon -> FieldLabelEnv
tyConFieldLabelEnv TyCon
tc) FieldLabelString
lbl
fieldsOfAlgTcRhs :: AlgTyConRhs -> FieldLabelEnv
fieldsOfAlgTcRhs :: AlgTyConRhs -> FieldLabelEnv
fieldsOfAlgTcRhs AlgTyConRhs
rhs = forall a. [(FieldLabelString, a)] -> DFastStringEnv a
mkDFsEnv [ (FieldLabel -> FieldLabelString
flLabel FieldLabel
fl, FieldLabel
fl)
| FieldLabel
fl <- forall {t :: * -> *}. Foldable t => t DataCon -> [FieldLabel]
dataConsFields (AlgTyConRhs -> [DataCon]
visibleDataCons AlgTyConRhs
rhs) ]
where
dataConsFields :: t DataCon -> [FieldLabel]
dataConsFields t DataCon
dcs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DataCon -> [FieldLabel]
dataConFieldLabels t DataCon
dcs
mkFunTyCon :: Name -> [TyConBinder] -> Name -> TyCon
mkFunTyCon :: Name -> [TyConBinder] -> Name -> TyCon
mkFunTyCon Name
name [TyConBinder]
binders Name
rep_nm
= let tc :: TyCon
tc =
FunTyCon {
tyConUnique :: Unique
tyConUnique = Name -> Unique
nameUnique Name
name,
tyConName :: Name
tyConName = Name
name,
tyConBinders :: [TyConBinder]
tyConBinders = [TyConBinder]
binders,
tyConResKind :: Kind
tyConResKind = Kind
liftedTypeKind,
tyConKind :: Kind
tyConKind = [TyConBinder] -> Kind -> Kind
mkTyConKind [TyConBinder]
binders Kind
liftedTypeKind,
tyConArity :: ConTag
tyConArity = forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [TyConBinder]
binders,
tyConNullaryTy :: Kind
tyConNullaryTy = TyCon -> Kind
mkTyConTy_ TyCon
tc,
tcRepName :: Name
tcRepName = Name
rep_nm
}
in TyCon
tc
mkAlgTyCon :: Name
-> [TyConBinder]
-> Kind
-> [Role]
-> Maybe CType
-> [PredType]
-> AlgTyConRhs
-> AlgTyConFlav
-> Bool
-> TyCon
mkAlgTyCon :: Name
-> [TyConBinder]
-> Kind
-> [Role]
-> Maybe CType
-> [Kind]
-> AlgTyConRhs
-> AlgTyConFlav
-> Bool
-> TyCon
mkAlgTyCon Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles Maybe CType
cType [Kind]
stupid AlgTyConRhs
rhs AlgTyConFlav
parent Bool
gadt_syn
= let tc :: TyCon
tc =
AlgTyCon {
tyConName :: Name
tyConName = Name
name,
tyConUnique :: Unique
tyConUnique = Name -> Unique
nameUnique Name
name,
tyConBinders :: [TyConBinder]
tyConBinders = [TyConBinder]
binders,
tyConResKind :: Kind
tyConResKind = Kind
res_kind,
tyConKind :: Kind
tyConKind = [TyConBinder] -> Kind -> Kind
mkTyConKind [TyConBinder]
binders Kind
res_kind,
tyConArity :: ConTag
tyConArity = forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [TyConBinder]
binders,
tyConNullaryTy :: Kind
tyConNullaryTy = TyCon -> Kind
mkTyConTy_ TyCon
tc,
tyConTyVars :: [TyVar]
tyConTyVars = forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders,
tcRoles :: [Role]
tcRoles = [Role]
roles,
tyConCType :: Maybe CType
tyConCType = Maybe CType
cType,
algTcStupidTheta :: [Kind]
algTcStupidTheta = [Kind]
stupid,
algTcRhs :: AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs,
algTcFields :: FieldLabelEnv
algTcFields = AlgTyConRhs -> FieldLabelEnv
fieldsOfAlgTcRhs AlgTyConRhs
rhs,
algTcParent :: AlgTyConFlav
algTcParent = ASSERT2( okParent name parent, ppr name $$ ppr parent ) parent,
algTcGadtSyntax :: Bool
algTcGadtSyntax = Bool
gadt_syn
}
in TyCon
tc
mkClassTyCon :: Name -> [TyConBinder]
-> [Role] -> AlgTyConRhs -> Class
-> Name -> TyCon
mkClassTyCon :: Name
-> [TyConBinder] -> [Role] -> AlgTyConRhs -> Class -> Name -> TyCon
mkClassTyCon Name
name [TyConBinder]
binders [Role]
roles AlgTyConRhs
rhs Class
clas Name
tc_rep_name
= Name
-> [TyConBinder]
-> Kind
-> [Role]
-> Maybe CType
-> [Kind]
-> AlgTyConRhs
-> AlgTyConFlav
-> Bool
-> TyCon
mkAlgTyCon Name
name [TyConBinder]
binders Kind
constraintKind [Role]
roles forall a. Maybe a
Nothing [] AlgTyConRhs
rhs
(Class -> Name -> AlgTyConFlav
ClassTyCon Class
clas Name
tc_rep_name)
Bool
False
mkTupleTyCon :: Name
-> [TyConBinder]
-> Kind
-> Arity
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon :: Name
-> [TyConBinder]
-> Kind
-> ConTag
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon Name
name [TyConBinder]
binders Kind
res_kind ConTag
arity DataCon
con TupleSort
sort AlgTyConFlav
parent
= let tc :: TyCon
tc =
AlgTyCon {
tyConUnique :: Unique
tyConUnique = Name -> Unique
nameUnique Name
name,
tyConName :: Name
tyConName = Name
name,
tyConBinders :: [TyConBinder]
tyConBinders = [TyConBinder]
binders,
tyConTyVars :: [TyVar]
tyConTyVars = forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders,
tyConResKind :: Kind
tyConResKind = Kind
res_kind,
tyConKind :: Kind
tyConKind = [TyConBinder] -> Kind -> Kind
mkTyConKind [TyConBinder]
binders Kind
res_kind,
tyConArity :: ConTag
tyConArity = ConTag
arity,
tyConNullaryTy :: Kind
tyConNullaryTy = TyCon -> Kind
mkTyConTy_ TyCon
tc,
tcRoles :: [Role]
tcRoles = forall a. ConTag -> a -> [a]
replicate ConTag
arity Role
Representational,
tyConCType :: Maybe CType
tyConCType = forall a. Maybe a
Nothing,
algTcGadtSyntax :: Bool
algTcGadtSyntax = Bool
False,
algTcStupidTheta :: [Kind]
algTcStupidTheta = [],
algTcRhs :: AlgTyConRhs
algTcRhs = TupleTyCon { data_con :: DataCon
data_con = DataCon
con,
tup_sort :: TupleSort
tup_sort = TupleSort
sort },
algTcFields :: FieldLabelEnv
algTcFields = forall a. DFastStringEnv a
emptyDFsEnv,
algTcParent :: AlgTyConFlav
algTcParent = AlgTyConFlav
parent
}
in TyCon
tc
mkSumTyCon :: Name
-> [TyConBinder]
-> Kind
-> Arity
-> [TyVar]
-> [DataCon]
-> AlgTyConFlav
-> TyCon
mkSumTyCon :: Name
-> [TyConBinder]
-> Kind
-> ConTag
-> [TyVar]
-> [DataCon]
-> AlgTyConFlav
-> TyCon
mkSumTyCon Name
name [TyConBinder]
binders Kind
res_kind ConTag
arity [TyVar]
tyvars [DataCon]
cons AlgTyConFlav
parent
= let tc :: TyCon
tc =
AlgTyCon {
tyConUnique :: Unique
tyConUnique = Name -> Unique
nameUnique Name
name,
tyConName :: Name
tyConName = Name
name,
tyConBinders :: [TyConBinder]
tyConBinders = [TyConBinder]
binders,
tyConTyVars :: [TyVar]
tyConTyVars = [TyVar]
tyvars,
tyConResKind :: Kind
tyConResKind = Kind
res_kind,
tyConKind :: Kind
tyConKind = [TyConBinder] -> Kind -> Kind
mkTyConKind [TyConBinder]
binders Kind
res_kind,
tyConArity :: ConTag
tyConArity = ConTag
arity,
tyConNullaryTy :: Kind
tyConNullaryTy = TyCon -> Kind
mkTyConTy_ TyCon
tc,
tcRoles :: [Role]
tcRoles = forall a. ConTag -> a -> [a]
replicate ConTag
arity Role
Representational,
tyConCType :: Maybe CType
tyConCType = forall a. Maybe a
Nothing,
algTcGadtSyntax :: Bool
algTcGadtSyntax = Bool
False,
algTcStupidTheta :: [Kind]
algTcStupidTheta = [],
algTcRhs :: AlgTyConRhs
algTcRhs = [DataCon] -> AlgTyConRhs
mkSumTyConRhs [DataCon]
cons,
algTcFields :: FieldLabelEnv
algTcFields = forall a. DFastStringEnv a
emptyDFsEnv,
algTcParent :: AlgTyConFlav
algTcParent = AlgTyConFlav
parent
}
in TyCon
tc
mkTcTyCon :: Name
-> [TyConBinder]
-> Kind
-> [(Name,TcTyVar)]
-> Bool
-> TyConFlavour
-> TyCon
mkTcTyCon :: Name
-> [TyConBinder]
-> Kind
-> [(Name, TyVar)]
-> Bool
-> TyConFlavour
-> TyCon
mkTcTyCon Name
name [TyConBinder]
binders Kind
res_kind [(Name, TyVar)]
scoped_tvs Bool
poly TyConFlavour
flav
= let tc :: TyCon
tc =
TcTyCon { tyConUnique :: Unique
tyConUnique = forall a. Uniquable a => a -> Unique
getUnique Name
name
, tyConName :: Name
tyConName = Name
name
, tyConTyVars :: [TyVar]
tyConTyVars = forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders
, tyConBinders :: [TyConBinder]
tyConBinders = [TyConBinder]
binders
, tyConResKind :: Kind
tyConResKind = Kind
res_kind
, tyConKind :: Kind
tyConKind = [TyConBinder] -> Kind -> Kind
mkTyConKind [TyConBinder]
binders Kind
res_kind
, tyConArity :: ConTag
tyConArity = forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [TyConBinder]
binders
, tyConNullaryTy :: Kind
tyConNullaryTy = TyCon -> Kind
mkTyConTy_ TyCon
tc
, tcTyConScopedTyVars :: [(Name, TyVar)]
tcTyConScopedTyVars = [(Name, TyVar)]
scoped_tvs
, tcTyConIsPoly :: Bool
tcTyConIsPoly = Bool
poly
, tcTyConFlavour :: TyConFlavour
tcTyConFlavour = TyConFlavour
flav }
in TyCon
tc
noTcTyConScopedTyVars :: [(Name, TcTyVar)]
noTcTyConScopedTyVars :: [(Name, TyVar)]
noTcTyConScopedTyVars = []
mkPrimTyCon :: Name -> [TyConBinder]
-> Kind
-> [Role] -> TyCon
mkPrimTyCon :: Name -> [TyConBinder] -> Kind -> [Role] -> TyCon
mkPrimTyCon Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles
= Name
-> [TyConBinder] -> Kind -> [Role] -> Bool -> Maybe Name -> TyCon
mkPrimTyCon' Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles Bool
True (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Name
mkPrelTyConRepName Name
name)
mkKindTyCon :: Name -> [TyConBinder]
-> Kind
-> [Role] -> Name -> TyCon
mkKindTyCon :: Name -> [TyConBinder] -> Kind -> [Role] -> Name -> TyCon
mkKindTyCon Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles Name
rep_nm
= TyCon
tc
where
tc :: TyCon
tc = Name
-> [TyConBinder] -> Kind -> [Role] -> Bool -> Maybe Name -> TyCon
mkPrimTyCon' Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles Bool
False (forall a. a -> Maybe a
Just Name
rep_nm)
mkLiftedPrimTyCon :: Name -> [TyConBinder]
-> Kind
-> [Role] -> TyCon
mkLiftedPrimTyCon :: Name -> [TyConBinder] -> Kind -> [Role] -> TyCon
mkLiftedPrimTyCon Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles
= Name
-> [TyConBinder] -> Kind -> [Role] -> Bool -> Maybe Name -> TyCon
mkPrimTyCon' Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles Bool
False (forall a. a -> Maybe a
Just Name
rep_nm)
where rep_nm :: Name
rep_nm = Name -> Name
mkPrelTyConRepName Name
name
mkPrimTyCon' :: Name -> [TyConBinder]
-> Kind
-> [Role]
-> Bool -> Maybe TyConRepName -> TyCon
mkPrimTyCon' :: Name
-> [TyConBinder] -> Kind -> [Role] -> Bool -> Maybe Name -> TyCon
mkPrimTyCon' Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles Bool
is_unlifted Maybe Name
rep_nm
= let tc :: TyCon
tc =
PrimTyCon {
tyConName :: Name
tyConName = Name
name,
tyConUnique :: Unique
tyConUnique = Name -> Unique
nameUnique Name
name,
tyConBinders :: [TyConBinder]
tyConBinders = [TyConBinder]
binders,
tyConResKind :: Kind
tyConResKind = Kind
res_kind,
tyConKind :: Kind
tyConKind = [TyConBinder] -> Kind -> Kind
mkTyConKind [TyConBinder]
binders Kind
res_kind,
tyConArity :: ConTag
tyConArity = forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [Role]
roles,
tyConNullaryTy :: Kind
tyConNullaryTy = TyCon -> Kind
mkTyConTy_ TyCon
tc,
tcRoles :: [Role]
tcRoles = [Role]
roles,
isUnlifted :: Bool
isUnlifted = Bool
is_unlifted,
primRepName :: Maybe Name
primRepName = Maybe Name
rep_nm
}
in TyCon
tc
mkSynonymTyCon :: Name -> [TyConBinder] -> Kind
-> [Role] -> Type -> Bool -> Bool -> Bool -> TyCon
mkSynonymTyCon :: Name
-> [TyConBinder]
-> Kind
-> [Role]
-> Kind
-> Bool
-> Bool
-> Bool
-> TyCon
mkSynonymTyCon Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles Kind
rhs Bool
is_tau Bool
is_fam_free Bool
is_forgetful
= let tc :: TyCon
tc =
SynonymTyCon {
tyConName :: Name
tyConName = Name
name,
tyConUnique :: Unique
tyConUnique = Name -> Unique
nameUnique Name
name,
tyConBinders :: [TyConBinder]
tyConBinders = [TyConBinder]
binders,
tyConResKind :: Kind
tyConResKind = Kind
res_kind,
tyConKind :: Kind
tyConKind = [TyConBinder] -> Kind -> Kind
mkTyConKind [TyConBinder]
binders Kind
res_kind,
tyConArity :: ConTag
tyConArity = forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [TyConBinder]
binders,
tyConNullaryTy :: Kind
tyConNullaryTy = TyCon -> Kind
mkTyConTy_ TyCon
tc,
tyConTyVars :: [TyVar]
tyConTyVars = forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders,
tcRoles :: [Role]
tcRoles = [Role]
roles,
synTcRhs :: Kind
synTcRhs = Kind
rhs,
synIsTau :: Bool
synIsTau = Bool
is_tau,
synIsFamFree :: Bool
synIsFamFree = Bool
is_fam_free,
synIsForgetful :: Bool
synIsForgetful = Bool
is_forgetful
}
in TyCon
tc
mkFamilyTyCon :: Name -> [TyConBinder] -> Kind
-> Maybe Name -> FamTyConFlav
-> Maybe Class -> Injectivity -> TyCon
mkFamilyTyCon :: Name
-> [TyConBinder]
-> Kind
-> Maybe Name
-> FamTyConFlav
-> Maybe Class
-> Injectivity
-> TyCon
mkFamilyTyCon Name
name [TyConBinder]
binders Kind
res_kind Maybe Name
resVar FamTyConFlav
flav Maybe Class
parent Injectivity
inj
= let tc :: TyCon
tc =
FamilyTyCon
{ tyConUnique :: Unique
tyConUnique = Name -> Unique
nameUnique Name
name
, tyConName :: Name
tyConName = Name
name
, tyConBinders :: [TyConBinder]
tyConBinders = [TyConBinder]
binders
, tyConResKind :: Kind
tyConResKind = Kind
res_kind
, tyConKind :: Kind
tyConKind = [TyConBinder] -> Kind -> Kind
mkTyConKind [TyConBinder]
binders Kind
res_kind
, tyConArity :: ConTag
tyConArity = forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [TyConBinder]
binders
, tyConNullaryTy :: Kind
tyConNullaryTy = TyCon -> Kind
mkTyConTy_ TyCon
tc
, tyConTyVars :: [TyVar]
tyConTyVars = forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders
, famTcResVar :: Maybe Name
famTcResVar = Maybe Name
resVar
, famTcFlav :: FamTyConFlav
famTcFlav = FamTyConFlav
flav
, famTcParent :: Maybe TyCon
famTcParent = Class -> TyCon
classTyCon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Class
parent
, famTcInj :: Injectivity
famTcInj = Injectivity
inj
}
in TyCon
tc
mkPromotedDataCon :: DataCon -> Name -> TyConRepName
-> [TyConTyCoBinder] -> Kind -> [Role]
-> RuntimeRepInfo -> TyCon
mkPromotedDataCon :: DataCon
-> Name
-> Name
-> [TyConBinder]
-> Kind
-> [Role]
-> RuntimeRepInfo
-> TyCon
mkPromotedDataCon DataCon
con Name
name Name
rep_name [TyConBinder]
binders Kind
res_kind [Role]
roles RuntimeRepInfo
rep_info
= let tc :: TyCon
tc =
PromotedDataCon {
tyConUnique :: Unique
tyConUnique = Name -> Unique
nameUnique Name
name,
tyConName :: Name
tyConName = Name
name,
tyConArity :: ConTag
tyConArity = forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [Role]
roles,
tyConNullaryTy :: Kind
tyConNullaryTy = TyCon -> Kind
mkTyConTy_ TyCon
tc,
tcRoles :: [Role]
tcRoles = [Role]
roles,
tyConBinders :: [TyConBinder]
tyConBinders = [TyConBinder]
binders,
tyConResKind :: Kind
tyConResKind = Kind
res_kind,
tyConKind :: Kind
tyConKind = [TyConBinder] -> Kind -> Kind
mkTyConKind [TyConBinder]
binders Kind
res_kind,
dataCon :: DataCon
dataCon = DataCon
con,
tcRepName :: Name
tcRepName = Name
rep_name,
promDcRepInfo :: RuntimeRepInfo
promDcRepInfo = RuntimeRepInfo
rep_info
}
in TyCon
tc
isFunTyCon :: TyCon -> Bool
isFunTyCon :: TyCon -> Bool
isFunTyCon (FunTyCon {}) = Bool
True
isFunTyCon TyCon
_ = Bool
False
isAbstractTyCon :: TyCon -> Bool
isAbstractTyCon :: TyCon -> Bool
isAbstractTyCon (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
AbstractTyCon }) = Bool
True
isAbstractTyCon TyCon
_ = Bool
False
isPrimTyCon :: TyCon -> Bool
isPrimTyCon :: TyCon -> Bool
isPrimTyCon (PrimTyCon {}) = Bool
True
isPrimTyCon TyCon
_ = Bool
False
isUnliftedTyCon :: TyCon -> Bool
isUnliftedTyCon :: TyCon -> Bool
isUnliftedTyCon (PrimTyCon {isUnlifted :: TyCon -> Bool
isUnlifted = Bool
is_unlifted})
= Bool
is_unlifted
isUnliftedTyCon (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs } )
| TupleTyCon { tup_sort :: AlgTyConRhs -> TupleSort
tup_sort = TupleSort
sort } <- AlgTyConRhs
rhs
= Bool -> Bool
not (Boxity -> Bool
isBoxed (TupleSort -> Boxity
tupleSortBoxity TupleSort
sort))
isUnliftedTyCon (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs } )
| SumTyCon {} <- AlgTyConRhs
rhs
= Bool
True
isUnliftedTyCon TyCon
_ = Bool
False
isAlgTyCon :: TyCon -> Bool
isAlgTyCon :: TyCon -> Bool
isAlgTyCon (AlgTyCon {}) = Bool
True
isAlgTyCon TyCon
_ = Bool
False
isVanillaAlgTyCon :: TyCon -> Bool
isVanillaAlgTyCon :: TyCon -> Bool
isVanillaAlgTyCon (AlgTyCon { algTcParent :: TyCon -> AlgTyConFlav
algTcParent = VanillaAlgTyCon Name
_ }) = Bool
True
isVanillaAlgTyCon TyCon
_ = Bool
False
{-# INLINE isConstraintKindCon #-}
isConstraintKindCon :: TyCon -> Bool
isConstraintKindCon :: TyCon -> Bool
isConstraintKindCon AlgTyCon { tyConUnique :: TyCon -> Unique
tyConUnique = Unique
u } = Unique
u forall a. Eq a => a -> a -> Bool
== Unique
constraintKindTyConKey
isConstraintKindCon TyCon
_ = Bool
False
isDataTyCon :: TyCon -> Bool
isDataTyCon :: TyCon -> Bool
isDataTyCon (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs})
= case AlgTyConRhs
rhs of
TupleTyCon { tup_sort :: AlgTyConRhs -> TupleSort
tup_sort = TupleSort
sort }
-> Boxity -> Bool
isBoxed (TupleSort -> Boxity
tupleSortBoxity TupleSort
sort)
SumTyCon {} -> Bool
False
DataTyCon {} -> Bool
True
NewTyCon {} -> Bool
False
AbstractTyCon {} -> Bool
False
isDataTyCon TyCon
_ = Bool
False
isInjectiveTyCon :: TyCon -> Role -> Bool
isInjectiveTyCon :: TyCon -> Role -> Bool
isInjectiveTyCon TyCon
_ Role
Phantom = Bool
False
isInjectiveTyCon (FunTyCon {}) Role
_ = Bool
True
isInjectiveTyCon (AlgTyCon {}) Role
Nominal = Bool
True
isInjectiveTyCon (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs}) Role
Representational
= AlgTyConRhs -> Bool
isGenInjAlgRhs AlgTyConRhs
rhs
isInjectiveTyCon (SynonymTyCon {}) Role
_ = Bool
False
isInjectiveTyCon (FamilyTyCon { famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = DataFamilyTyCon Name
_ })
Role
Nominal = Bool
True
isInjectiveTyCon (FamilyTyCon { famTcInj :: TyCon -> Injectivity
famTcInj = Injective [Bool]
inj }) Role
Nominal = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
inj
isInjectiveTyCon (FamilyTyCon {}) Role
_ = Bool
False
isInjectiveTyCon (PrimTyCon {}) Role
_ = Bool
True
isInjectiveTyCon (PromotedDataCon {}) Role
_ = Bool
True
isInjectiveTyCon (TcTyCon {}) Role
_ = Bool
True
isGenerativeTyCon :: TyCon -> Role -> Bool
isGenerativeTyCon :: TyCon -> Role -> Bool
isGenerativeTyCon (FamilyTyCon { famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = DataFamilyTyCon Name
_ }) Role
Nominal = Bool
True
isGenerativeTyCon (FamilyTyCon {}) Role
_ = Bool
False
isGenerativeTyCon TyCon
tc Role
r = TyCon -> Role -> Bool
isInjectiveTyCon TyCon
tc Role
r
isGenInjAlgRhs :: AlgTyConRhs -> Bool
isGenInjAlgRhs :: AlgTyConRhs -> Bool
isGenInjAlgRhs (TupleTyCon {}) = Bool
True
isGenInjAlgRhs (SumTyCon {}) = Bool
True
isGenInjAlgRhs (DataTyCon {}) = Bool
True
isGenInjAlgRhs (AbstractTyCon {}) = Bool
False
isGenInjAlgRhs (NewTyCon {}) = Bool
False
isNewTyCon :: TyCon -> Bool
isNewTyCon :: TyCon -> Bool
isNewTyCon (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = NewTyCon {}}) = Bool
True
isNewTyCon TyCon
_ = Bool
False
unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, CoAxiom Unbranched)
unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Kind, CoAxiom Unbranched)
unwrapNewTyCon_maybe (AlgTyCon { tyConTyVars :: TyCon -> [TyVar]
tyConTyVars = [TyVar]
tvs,
algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = NewTyCon { nt_co :: AlgTyConRhs -> CoAxiom Unbranched
nt_co = CoAxiom Unbranched
co,
nt_rhs :: AlgTyConRhs -> Kind
nt_rhs = Kind
rhs }})
= forall a. a -> Maybe a
Just ([TyVar]
tvs, Kind
rhs, CoAxiom Unbranched
co)
unwrapNewTyCon_maybe TyCon
_ = forall a. Maybe a
Nothing
unwrapNewTyConEtad_maybe :: TyCon -> Maybe ([TyVar], Type, CoAxiom Unbranched)
unwrapNewTyConEtad_maybe :: TyCon -> Maybe ([TyVar], Kind, CoAxiom Unbranched)
unwrapNewTyConEtad_maybe (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = NewTyCon { nt_co :: AlgTyConRhs -> CoAxiom Unbranched
nt_co = CoAxiom Unbranched
co,
nt_etad_rhs :: AlgTyConRhs -> ([TyVar], Kind)
nt_etad_rhs = ([TyVar]
tvs,Kind
rhs) }})
= forall a. a -> Maybe a
Just ([TyVar]
tvs, Kind
rhs, CoAxiom Unbranched
co)
unwrapNewTyConEtad_maybe TyCon
_ = forall a. Maybe a
Nothing
{-# INLINE isTypeSynonymTyCon #-}
isTypeSynonymTyCon :: TyCon -> Bool
isTypeSynonymTyCon :: TyCon -> Bool
isTypeSynonymTyCon (SynonymTyCon {}) = Bool
True
isTypeSynonymTyCon TyCon
_ = Bool
False
isTauTyCon :: TyCon -> Bool
isTauTyCon :: TyCon -> Bool
isTauTyCon (SynonymTyCon { synIsTau :: TyCon -> Bool
synIsTau = Bool
is_tau }) = Bool
is_tau
isTauTyCon TyCon
_ = Bool
True
isFamFreeTyCon :: TyCon -> Bool
isFamFreeTyCon :: TyCon -> Bool
isFamFreeTyCon (SynonymTyCon { synIsFamFree :: TyCon -> Bool
synIsFamFree = Bool
fam_free }) = Bool
fam_free
isFamFreeTyCon (FamilyTyCon { famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = FamTyConFlav
flav }) = FamTyConFlav -> Bool
isDataFamFlav FamTyConFlav
flav
isFamFreeTyCon TyCon
_ = Bool
True
isForgetfulSynTyCon :: TyCon -> Bool
isForgetfulSynTyCon :: TyCon -> Bool
isForgetfulSynTyCon (SynonymTyCon { synIsForgetful :: TyCon -> Bool
synIsForgetful = Bool
forget }) = Bool
forget
isForgetfulSynTyCon TyCon
_ = Bool
False
mustBeSaturated :: TyCon -> Bool
mustBeSaturated :: TyCon -> Bool
mustBeSaturated = TyConFlavour -> Bool
tcFlavourMustBeSaturated forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> TyConFlavour
tyConFlavour
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax :: TyCon -> Bool
algTcGadtSyntax = Bool
res }) = Bool
res
isGadtSyntaxTyCon TyCon
_ = Bool
False
isEnumerationTyCon :: TyCon -> Bool
isEnumerationTyCon :: TyCon -> Bool
isEnumerationTyCon (AlgTyCon { tyConArity :: TyCon -> ConTag
tyConArity = ConTag
arity, algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs })
= case AlgTyConRhs
rhs of
DataTyCon { is_enum :: AlgTyConRhs -> Bool
is_enum = Bool
res } -> Bool
res
TupleTyCon {} -> ConTag
arity forall a. Eq a => a -> a -> Bool
== ConTag
0
AlgTyConRhs
_ -> Bool
False
isEnumerationTyCon TyCon
_ = Bool
False
isFamilyTyCon :: TyCon -> Bool
isFamilyTyCon :: TyCon -> Bool
isFamilyTyCon (FamilyTyCon {}) = Bool
True
isFamilyTyCon TyCon
_ = Bool
False
isOpenFamilyTyCon :: TyCon -> Bool
isOpenFamilyTyCon :: TyCon -> Bool
isOpenFamilyTyCon (FamilyTyCon {famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = FamTyConFlav
flav })
| FamTyConFlav
OpenSynFamilyTyCon <- FamTyConFlav
flav = Bool
True
| DataFamilyTyCon {} <- FamTyConFlav
flav = Bool
True
isOpenFamilyTyCon TyCon
_ = Bool
False
isTypeFamilyTyCon :: TyCon -> Bool
isTypeFamilyTyCon :: TyCon -> Bool
isTypeFamilyTyCon (FamilyTyCon { famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = FamTyConFlav
flav }) = Bool -> Bool
not (FamTyConFlav -> Bool
isDataFamFlav FamTyConFlav
flav)
isTypeFamilyTyCon TyCon
_ = Bool
False
isDataFamilyTyCon :: TyCon -> Bool
isDataFamilyTyCon :: TyCon -> Bool
isDataFamilyTyCon (FamilyTyCon { famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = FamTyConFlav
flav }) = FamTyConFlav -> Bool
isDataFamFlav FamTyConFlav
flav
isDataFamilyTyCon TyCon
_ = Bool
False
isOpenTypeFamilyTyCon :: TyCon -> Bool
isOpenTypeFamilyTyCon :: TyCon -> Bool
isOpenTypeFamilyTyCon (FamilyTyCon {famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = FamTyConFlav
OpenSynFamilyTyCon }) = Bool
True
isOpenTypeFamilyTyCon TyCon
_ = Bool
False
isClosedSynFamilyTyConWithAxiom_maybe :: TyCon -> Maybe (CoAxiom Branched)
isClosedSynFamilyTyConWithAxiom_maybe :: TyCon -> Maybe (CoAxiom Branched)
isClosedSynFamilyTyConWithAxiom_maybe
(FamilyTyCon {famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
mb}) = Maybe (CoAxiom Branched)
mb
isClosedSynFamilyTyConWithAxiom_maybe TyCon
_ = forall a. Maybe a
Nothing
tyConInjectivityInfo :: TyCon -> Injectivity
tyConInjectivityInfo :: TyCon -> Injectivity
tyConInjectivityInfo TyCon
tc
| FamilyTyCon { famTcInj :: TyCon -> Injectivity
famTcInj = Injectivity
inj } <- TyCon
tc
= Injectivity
inj
| TyCon -> Role -> Bool
isInjectiveTyCon TyCon
tc Role
Nominal
= [Bool] -> Injectivity
Injective (forall a. ConTag -> a -> [a]
replicate (TyCon -> ConTag
tyConArity TyCon
tc) Bool
True)
| Bool
otherwise
= Injectivity
NotInjective
isBuiltInSynFamTyCon_maybe :: TyCon -> Maybe BuiltInSynFamily
isBuiltInSynFamTyCon_maybe :: TyCon -> Maybe BuiltInSynFamily
isBuiltInSynFamTyCon_maybe
(FamilyTyCon {famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = BuiltInSynFamTyCon BuiltInSynFamily
ops }) = forall a. a -> Maybe a
Just BuiltInSynFamily
ops
isBuiltInSynFamTyCon_maybe TyCon
_ = forall a. Maybe a
Nothing
isDataFamFlav :: FamTyConFlav -> Bool
isDataFamFlav :: FamTyConFlav -> Bool
isDataFamFlav (DataFamilyTyCon {}) = Bool
True
isDataFamFlav FamTyConFlav
_ = Bool
False
isTyConAssoc :: TyCon -> Bool
isTyConAssoc :: TyCon -> Bool
isTyConAssoc = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Maybe TyCon
tyConAssoc_maybe
tyConAssoc_maybe :: TyCon -> Maybe TyCon
tyConAssoc_maybe :: TyCon -> Maybe TyCon
tyConAssoc_maybe = TyConFlavour -> Maybe TyCon
tyConFlavourAssoc_maybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> TyConFlavour
tyConFlavour
tyConFlavourAssoc_maybe :: TyConFlavour -> Maybe TyCon
tyConFlavourAssoc_maybe :: TyConFlavour -> Maybe TyCon
tyConFlavourAssoc_maybe (DataFamilyFlavour Maybe TyCon
mb_parent) = Maybe TyCon
mb_parent
tyConFlavourAssoc_maybe (OpenTypeFamilyFlavour Maybe TyCon
mb_parent) = Maybe TyCon
mb_parent
tyConFlavourAssoc_maybe TyConFlavour
_ = forall a. Maybe a
Nothing
isTupleTyCon :: TyCon -> Bool
isTupleTyCon :: TyCon -> Bool
isTupleTyCon (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = TupleTyCon {} }) = Bool
True
isTupleTyCon TyCon
_ = Bool
False
tyConTuple_maybe :: TyCon -> Maybe TupleSort
tyConTuple_maybe :: TyCon -> Maybe TupleSort
tyConTuple_maybe (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs })
| TupleTyCon { tup_sort :: AlgTyConRhs -> TupleSort
tup_sort = TupleSort
sort} <- AlgTyConRhs
rhs = forall a. a -> Maybe a
Just TupleSort
sort
tyConTuple_maybe TyCon
_ = forall a. Maybe a
Nothing
isUnboxedTupleTyCon :: TyCon -> Bool
isUnboxedTupleTyCon :: TyCon -> Bool
isUnboxedTupleTyCon (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs })
| TupleTyCon { tup_sort :: AlgTyConRhs -> TupleSort
tup_sort = TupleSort
sort } <- AlgTyConRhs
rhs
= Bool -> Bool
not (Boxity -> Bool
isBoxed (TupleSort -> Boxity
tupleSortBoxity TupleSort
sort))
isUnboxedTupleTyCon TyCon
_ = Bool
False
isBoxedTupleTyCon :: TyCon -> Bool
isBoxedTupleTyCon :: TyCon -> Bool
isBoxedTupleTyCon (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs })
| TupleTyCon { tup_sort :: AlgTyConRhs -> TupleSort
tup_sort = TupleSort
sort } <- AlgTyConRhs
rhs
= Boxity -> Bool
isBoxed (TupleSort -> Boxity
tupleSortBoxity TupleSort
sort)
isBoxedTupleTyCon TyCon
_ = Bool
False
isUnboxedSumTyCon :: TyCon -> Bool
isUnboxedSumTyCon :: TyCon -> Bool
isUnboxedSumTyCon (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs })
| SumTyCon {} <- AlgTyConRhs
rhs
= Bool
True
isUnboxedSumTyCon TyCon
_ = Bool
False
isLiftedAlgTyCon :: TyCon -> Bool
isLiftedAlgTyCon :: TyCon -> Bool
isLiftedAlgTyCon (AlgTyCon { tyConResKind :: TyCon -> Kind
tyConResKind = Kind
res_kind })
= Kind -> Bool
isLiftedTypeKind Kind
res_kind
isLiftedAlgTyCon TyCon
_ = Bool
False
isPromotedTupleTyCon :: TyCon -> Bool
isPromotedTupleTyCon :: TyCon -> Bool
isPromotedTupleTyCon TyCon
tyCon
| Just DataCon
dataCon <- TyCon -> Maybe DataCon
isPromotedDataCon_maybe TyCon
tyCon
, TyCon -> Bool
isTupleTyCon (DataCon -> TyCon
dataConTyCon DataCon
dataCon) = Bool
True
| Bool
otherwise = Bool
False
isPromotedDataCon :: TyCon -> Bool
isPromotedDataCon :: TyCon -> Bool
isPromotedDataCon (PromotedDataCon {}) = Bool
True
isPromotedDataCon TyCon
_ = Bool
False
isPromotedDataCon_maybe :: TyCon -> Maybe DataCon
isPromotedDataCon_maybe :: TyCon -> Maybe DataCon
isPromotedDataCon_maybe (PromotedDataCon { dataCon :: TyCon -> DataCon
dataCon = DataCon
dc }) = forall a. a -> Maybe a
Just DataCon
dc
isPromotedDataCon_maybe TyCon
_ = forall a. Maybe a
Nothing
isKindTyCon :: TyCon -> Bool
isKindTyCon :: TyCon -> Bool
isKindTyCon TyCon
tc = forall a. Uniquable a => a -> Unique
getUnique TyCon
tc forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` UniqSet Unique
kindTyConKeys
kindTyConKeys :: UniqSet Unique
kindTyConKeys :: UniqSet Unique
kindTyConKeys = forall a. [UniqSet a] -> UniqSet a
unionManyUniqSets
( forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet [ Unique
liftedTypeKindTyConKey, Unique
liftedRepTyConKey, Unique
constraintKindTyConKey, Unique
tYPETyConKey ]
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> [Unique]
tycon_with_datacons) [ TyCon
runtimeRepTyCon, TyCon
levityTyCon
, TyCon
multiplicityTyCon
, TyCon
vecCountTyCon, TyCon
vecElemTyCon ] )
where
tycon_with_datacons :: TyCon -> [Unique]
tycon_with_datacons TyCon
tc = forall a. Uniquable a => a -> Unique
getUnique TyCon
tc forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Uniquable a => a -> Unique
getUnique (TyCon -> [DataCon]
tyConDataCons TyCon
tc)
isLiftedTypeKindTyConName :: Name -> Bool
isLiftedTypeKindTyConName :: Name -> Bool
isLiftedTypeKindTyConName = (forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
liftedTypeKindTyConKey)
isImplicitTyCon :: TyCon -> Bool
isImplicitTyCon :: TyCon -> Bool
isImplicitTyCon (FunTyCon {}) = Bool
True
isImplicitTyCon (PrimTyCon {}) = Bool
True
isImplicitTyCon (PromotedDataCon {}) = Bool
True
isImplicitTyCon (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs, tyConName :: TyCon -> Name
tyConName = Name
name })
| TupleTyCon {} <- AlgTyConRhs
rhs = Name -> Bool
isWiredInName Name
name
| SumTyCon {} <- AlgTyConRhs
rhs = Bool
True
| Bool
otherwise = Bool
False
isImplicitTyCon (FamilyTyCon { famTcParent :: TyCon -> Maybe TyCon
famTcParent = Maybe TyCon
parent }) = forall a. Maybe a -> Bool
isJust Maybe TyCon
parent
isImplicitTyCon (SynonymTyCon {}) = Bool
False
isImplicitTyCon (TcTyCon {}) = Bool
False
tyConCType_maybe :: TyCon -> Maybe CType
tyConCType_maybe :: TyCon -> Maybe CType
tyConCType_maybe tc :: TyCon
tc@(AlgTyCon {}) = TyCon -> Maybe CType
tyConCType TyCon
tc
tyConCType_maybe TyCon
_ = forall a. Maybe a
Nothing
isTcTyCon :: TyCon -> Bool
isTcTyCon :: TyCon -> Bool
isTcTyCon (TcTyCon {}) = Bool
True
isTcTyCon TyCon
_ = Bool
False
setTcTyConKind :: TyCon -> Kind -> TyCon
setTcTyConKind :: TyCon -> Kind -> TyCon
setTcTyConKind tc :: TyCon
tc@(TcTyCon {}) Kind
kind = let tc' :: TyCon
tc' = TyCon
tc { tyConKind :: Kind
tyConKind = Kind
kind
, tyConNullaryTy :: Kind
tyConNullaryTy = TyCon -> Kind
mkTyConTy_ TyCon
tc'
}
in TyCon
tc'
setTcTyConKind TyCon
tc Kind
_ = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"setTcTyConKind" (forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
isTcLevPoly :: TyCon -> Bool
isTcLevPoly :: TyCon -> Bool
isTcLevPoly FunTyCon{} = Bool
False
isTcLevPoly (AlgTyCon { algTcParent :: TyCon -> AlgTyConFlav
algTcParent = AlgTyConFlav
parent, algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs })
| UnboxedAlgTyCon Maybe Name
_ <- AlgTyConFlav
parent
= Bool
True
| NewTyCon { nt_lev_poly :: AlgTyConRhs -> Bool
nt_lev_poly = Bool
lev_poly } <- AlgTyConRhs
rhs
= Bool
lev_poly
| Bool
otherwise
= Bool
False
isTcLevPoly SynonymTyCon{} = Bool
True
isTcLevPoly FamilyTyCon{} = Bool
True
isTcLevPoly PrimTyCon{} = Bool
False
isTcLevPoly TcTyCon{} = Bool
False
isTcLevPoly tc :: TyCon
tc@PromotedDataCon{} = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"isTcLevPoly datacon" (forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
expandSynTyCon_maybe
:: TyCon
-> [tyco]
-> Maybe ([(TyVar,tyco)],
Type,
[tyco])
expandSynTyCon_maybe :: forall tyco.
TyCon -> [tyco] -> Maybe ([(TyVar, tyco)], Kind, [tyco])
expandSynTyCon_maybe TyCon
tc [tyco]
tys
| SynonymTyCon { tyConTyVars :: TyCon -> [TyVar]
tyConTyVars = [TyVar]
tvs, synTcRhs :: TyCon -> Kind
synTcRhs = Kind
rhs, tyConArity :: TyCon -> ConTag
tyConArity = ConTag
arity } <- TyCon
tc
= if ConTag
arity forall a. Eq a => a -> a -> Bool
== ConTag
0
then forall a. a -> Maybe a
Just ([], Kind
rhs, [tyco]
tys)
else case [tyco]
tys forall a. [a] -> ConTag -> Ordering
`listLengthCmp` ConTag
arity of
Ordering
GT -> forall a. a -> Maybe a
Just ([TyVar]
tvs forall a b. [a] -> [b] -> [(a, b)]
`zip` [tyco]
tys, Kind
rhs, forall a. ConTag -> [a] -> [a]
drop ConTag
arity [tyco]
tys)
Ordering
EQ -> forall a. a -> Maybe a
Just ([TyVar]
tvs forall a b. [a] -> [b] -> [(a, b)]
`zip` [tyco]
tys, Kind
rhs, [])
Ordering
LT -> forall a. Maybe a
Nothing
| Bool
otherwise
= forall a. Maybe a
Nothing
isTyConWithSrcDataCons :: TyCon -> Bool
isTyConWithSrcDataCons :: TyCon -> Bool
isTyConWithSrcDataCons (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs, algTcParent :: TyCon -> AlgTyConFlav
algTcParent = AlgTyConFlav
parent }) =
case AlgTyConRhs
rhs of
DataTyCon {} -> Bool
isSrcParent
NewTyCon {} -> Bool
isSrcParent
TupleTyCon {} -> Bool
isSrcParent
AlgTyConRhs
_ -> Bool
False
where
isSrcParent :: Bool
isSrcParent = AlgTyConFlav -> Bool
isNoParent AlgTyConFlav
parent
isTyConWithSrcDataCons (FamilyTyCon { famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = DataFamilyTyCon {} })
= Bool
True
isTyConWithSrcDataCons TyCon
_ = Bool
False
tyConDataCons :: TyCon -> [DataCon]
tyConDataCons :: TyCon -> [DataCon]
tyConDataCons TyCon
tycon = TyCon -> Maybe [DataCon]
tyConDataCons_maybe TyCon
tycon forall a. Maybe a -> a -> a
`orElse` []
tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
tyConDataCons_maybe (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs})
= case AlgTyConRhs
rhs of
DataTyCon { data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon]
cons } -> forall a. a -> Maybe a
Just [DataCon]
cons
NewTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
con } -> forall a. a -> Maybe a
Just [DataCon
con]
TupleTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
con } -> forall a. a -> Maybe a
Just [DataCon
con]
SumTyCon { data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon]
cons } -> forall a. a -> Maybe a
Just [DataCon]
cons
AlgTyConRhs
_ -> forall a. Maybe a
Nothing
tyConDataCons_maybe TyCon
_ = forall a. Maybe a
Nothing
tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon
tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon
tyConSingleDataCon_maybe (AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs })
= case AlgTyConRhs
rhs of
DataTyCon { data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon
c] } -> forall a. a -> Maybe a
Just DataCon
c
TupleTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
c } -> forall a. a -> Maybe a
Just DataCon
c
NewTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
c } -> forall a. a -> Maybe a
Just DataCon
c
AlgTyConRhs
_ -> forall a. Maybe a
Nothing
tyConSingleDataCon_maybe TyCon
_ = forall a. Maybe a
Nothing
tyConSingleDataCon :: TyCon -> DataCon
tyConSingleDataCon :: TyCon -> DataCon
tyConSingleDataCon TyCon
tc
= case TyCon -> Maybe DataCon
tyConSingleDataCon_maybe TyCon
tc of
Just DataCon
c -> DataCon
c
Maybe DataCon
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConDataCon" (forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon
tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon
tyConSingleAlgDataCon_maybe TyCon
tycon
| TyCon -> Bool
isNewTyCon TyCon
tycon = forall a. Maybe a
Nothing
| Bool
otherwise = TyCon -> Maybe DataCon
tyConSingleDataCon_maybe TyCon
tycon
tyConAlgDataCons_maybe :: TyCon -> Maybe [DataCon]
tyConAlgDataCons_maybe :: TyCon -> Maybe [DataCon]
tyConAlgDataCons_maybe TyCon
tycon
| TyCon -> Bool
isNewTyCon TyCon
tycon = forall a. Maybe a
Nothing
| Bool
otherwise = TyCon -> Maybe [DataCon]
tyConDataCons_maybe TyCon
tycon
tyConFamilySize :: TyCon -> Int
tyConFamilySize :: TyCon -> ConTag
tyConFamilySize tc :: TyCon
tc@(AlgTyCon { algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs })
= case AlgTyConRhs
rhs of
DataTyCon { data_cons_size :: AlgTyConRhs -> ConTag
data_cons_size = ConTag
size } -> ConTag
size
NewTyCon {} -> ConTag
1
TupleTyCon {} -> ConTag
1
SumTyCon { data_cons_size :: AlgTyConRhs -> ConTag
data_cons_size = ConTag
size } -> ConTag
size
AlgTyConRhs
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConFamilySize 1" (forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
tyConFamilySize TyCon
tc = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConFamilySize 2" (forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
algTyConRhs :: TyCon -> AlgTyConRhs
algTyConRhs :: TyCon -> AlgTyConRhs
algTyConRhs (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs}) = AlgTyConRhs
rhs
algTyConRhs TyCon
other = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"algTyConRhs" (forall a. Outputable a => a -> SDoc
ppr TyCon
other)
tyConFamilyResVar_maybe :: TyCon -> Maybe Name
tyConFamilyResVar_maybe :: TyCon -> Maybe Name
tyConFamilyResVar_maybe (FamilyTyCon {famTcResVar :: TyCon -> Maybe Name
famTcResVar = Maybe Name
res}) = Maybe Name
res
tyConFamilyResVar_maybe TyCon
_ = forall a. Maybe a
Nothing
tyConRoles :: TyCon -> [Role]
tyConRoles :: TyCon -> [Role]
tyConRoles TyCon
tc
= case TyCon
tc of
{ FunTyCon {} -> [Role
Nominal, Role
Nominal, Role
Nominal, Role
Representational, Role
Representational]
; AlgTyCon { tcRoles :: TyCon -> [Role]
tcRoles = [Role]
roles } -> [Role]
roles
; SynonymTyCon { tcRoles :: TyCon -> [Role]
tcRoles = [Role]
roles } -> [Role]
roles
; FamilyTyCon {} -> Role -> [Role]
const_role Role
Nominal
; PrimTyCon { tcRoles :: TyCon -> [Role]
tcRoles = [Role]
roles } -> [Role]
roles
; PromotedDataCon { tcRoles :: TyCon -> [Role]
tcRoles = [Role]
roles } -> [Role]
roles
; TcTyCon {} -> Role -> [Role]
const_role Role
Nominal
}
where
const_role :: Role -> [Role]
const_role Role
r = forall a. ConTag -> a -> [a]
replicate (TyCon -> ConTag
tyConArity TyCon
tc) Role
r
newTyConRhs :: TyCon -> ([TyVar], Type)
newTyConRhs :: TyCon -> ([TyVar], Kind)
newTyConRhs (AlgTyCon {tyConTyVars :: TyCon -> [TyVar]
tyConTyVars = [TyVar]
tvs, algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = NewTyCon { nt_rhs :: AlgTyConRhs -> Kind
nt_rhs = Kind
rhs }})
= ([TyVar]
tvs, Kind
rhs)
newTyConRhs TyCon
tycon = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"newTyConRhs" (forall a. Outputable a => a -> SDoc
ppr TyCon
tycon)
newTyConEtadArity :: TyCon -> Int
newTyConEtadArity :: TyCon -> ConTag
newTyConEtadArity (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = NewTyCon { nt_etad_rhs :: AlgTyConRhs -> ([TyVar], Kind)
nt_etad_rhs = ([TyVar], Kind)
tvs_rhs }})
= forall (t :: * -> *) a. Foldable t => t a -> ConTag
length (forall a b. (a, b) -> a
fst ([TyVar], Kind)
tvs_rhs)
newTyConEtadArity TyCon
tycon = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"newTyConEtadArity" (forall a. Outputable a => a -> SDoc
ppr TyCon
tycon)
newTyConEtadRhs :: TyCon -> ([TyVar], Type)
newTyConEtadRhs :: TyCon -> ([TyVar], Kind)
newTyConEtadRhs (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = NewTyCon { nt_etad_rhs :: AlgTyConRhs -> ([TyVar], Kind)
nt_etad_rhs = ([TyVar], Kind)
tvs_rhs }}) = ([TyVar], Kind)
tvs_rhs
newTyConEtadRhs TyCon
tycon = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"newTyConEtadRhs" (forall a. Outputable a => a -> SDoc
ppr TyCon
tycon)
newTyConCo_maybe :: TyCon -> Maybe (CoAxiom Unbranched)
newTyConCo_maybe :: TyCon -> Maybe (CoAxiom Unbranched)
newTyConCo_maybe (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = NewTyCon { nt_co :: AlgTyConRhs -> CoAxiom Unbranched
nt_co = CoAxiom Unbranched
co }}) = forall a. a -> Maybe a
Just CoAxiom Unbranched
co
newTyConCo_maybe TyCon
_ = forall a. Maybe a
Nothing
newTyConCo :: TyCon -> CoAxiom Unbranched
newTyConCo :: TyCon -> CoAxiom Unbranched
newTyConCo TyCon
tc = case TyCon -> Maybe (CoAxiom Unbranched)
newTyConCo_maybe TyCon
tc of
Just CoAxiom Unbranched
co -> CoAxiom Unbranched
co
Maybe (CoAxiom Unbranched)
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"newTyConCo" (forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
newTyConDataCon_maybe :: TyCon -> Maybe DataCon
newTyConDataCon_maybe :: TyCon -> Maybe DataCon
newTyConDataCon_maybe (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = NewTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
con }}) = forall a. a -> Maybe a
Just DataCon
con
newTyConDataCon_maybe TyCon
_ = forall a. Maybe a
Nothing
tyConStupidTheta :: TyCon -> [PredType]
tyConStupidTheta :: TyCon -> [Kind]
tyConStupidTheta (AlgTyCon {algTcStupidTheta :: TyCon -> [Kind]
algTcStupidTheta = [Kind]
stupid}) = [Kind]
stupid
tyConStupidTheta (FunTyCon {}) = []
tyConStupidTheta TyCon
tycon = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConStupidTheta" (forall a. Outputable a => a -> SDoc
ppr TyCon
tycon)
synTyConDefn_maybe :: TyCon -> Maybe ([TyVar], Type)
synTyConDefn_maybe :: TyCon -> Maybe ([TyVar], Kind)
synTyConDefn_maybe (SynonymTyCon {tyConTyVars :: TyCon -> [TyVar]
tyConTyVars = [TyVar]
tyvars, synTcRhs :: TyCon -> Kind
synTcRhs = Kind
ty})
= forall a. a -> Maybe a
Just ([TyVar]
tyvars, Kind
ty)
synTyConDefn_maybe TyCon
_ = forall a. Maybe a
Nothing
synTyConRhs_maybe :: TyCon -> Maybe Type
synTyConRhs_maybe :: TyCon -> Maybe Kind
synTyConRhs_maybe (SynonymTyCon {synTcRhs :: TyCon -> Kind
synTcRhs = Kind
rhs}) = forall a. a -> Maybe a
Just Kind
rhs
synTyConRhs_maybe TyCon
_ = forall a. Maybe a
Nothing
famTyConFlav_maybe :: TyCon -> Maybe FamTyConFlav
famTyConFlav_maybe :: TyCon -> Maybe FamTyConFlav
famTyConFlav_maybe (FamilyTyCon {famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = FamTyConFlav
flav}) = forall a. a -> Maybe a
Just FamTyConFlav
flav
famTyConFlav_maybe TyCon
_ = forall a. Maybe a
Nothing
isClassTyCon :: TyCon -> Bool
isClassTyCon :: TyCon -> Bool
isClassTyCon (AlgTyCon {algTcParent :: TyCon -> AlgTyConFlav
algTcParent = ClassTyCon {}}) = Bool
True
isClassTyCon TyCon
_ = Bool
False
tyConClass_maybe :: TyCon -> Maybe Class
tyConClass_maybe :: TyCon -> Maybe Class
tyConClass_maybe (AlgTyCon {algTcParent :: TyCon -> AlgTyConFlav
algTcParent = ClassTyCon Class
clas Name
_}) = forall a. a -> Maybe a
Just Class
clas
tyConClass_maybe TyCon
_ = forall a. Maybe a
Nothing
tyConATs :: TyCon -> [TyCon]
tyConATs :: TyCon -> [TyCon]
tyConATs (AlgTyCon {algTcParent :: TyCon -> AlgTyConFlav
algTcParent = ClassTyCon Class
clas Name
_}) = Class -> [TyCon]
classATs Class
clas
tyConATs TyCon
_ = []
isFamInstTyCon :: TyCon -> Bool
isFamInstTyCon :: TyCon -> Bool
isFamInstTyCon (AlgTyCon {algTcParent :: TyCon -> AlgTyConFlav
algTcParent = DataFamInstTyCon {} })
= Bool
True
isFamInstTyCon TyCon
_ = Bool
False
tyConFamInstSig_maybe :: TyCon -> Maybe (TyCon, [Type], CoAxiom Unbranched)
tyConFamInstSig_maybe :: TyCon -> Maybe (TyCon, [Kind], CoAxiom Unbranched)
tyConFamInstSig_maybe (AlgTyCon {algTcParent :: TyCon -> AlgTyConFlav
algTcParent = DataFamInstTyCon CoAxiom Unbranched
ax TyCon
f [Kind]
ts })
= forall a. a -> Maybe a
Just (TyCon
f, [Kind]
ts, CoAxiom Unbranched
ax)
tyConFamInstSig_maybe TyCon
_ = forall a. Maybe a
Nothing
tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Kind])
tyConFamInst_maybe (AlgTyCon {algTcParent :: TyCon -> AlgTyConFlav
algTcParent = DataFamInstTyCon CoAxiom Unbranched
_ TyCon
f [Kind]
ts })
= forall a. a -> Maybe a
Just (TyCon
f, [Kind]
ts)
tyConFamInst_maybe TyCon
_ = forall a. Maybe a
Nothing
tyConFamilyCoercion_maybe :: TyCon -> Maybe (CoAxiom Unbranched)
tyConFamilyCoercion_maybe :: TyCon -> Maybe (CoAxiom Unbranched)
tyConFamilyCoercion_maybe (AlgTyCon {algTcParent :: TyCon -> AlgTyConFlav
algTcParent = DataFamInstTyCon CoAxiom Unbranched
ax TyCon
_ [Kind]
_ })
= forall a. a -> Maybe a
Just CoAxiom Unbranched
ax
tyConFamilyCoercion_maybe TyCon
_ = forall a. Maybe a
Nothing
tyConRuntimeRepInfo :: TyCon -> RuntimeRepInfo
tyConRuntimeRepInfo :: TyCon -> RuntimeRepInfo
tyConRuntimeRepInfo (PromotedDataCon { promDcRepInfo :: TyCon -> RuntimeRepInfo
promDcRepInfo = RuntimeRepInfo
rri }) = RuntimeRepInfo
rri
tyConRuntimeRepInfo TyCon
_ = RuntimeRepInfo
NoRRI
mkTyConTagMap :: TyCon -> NameEnv ConTag
mkTyConTagMap :: TyCon -> NameEnv ConTag
mkTyConTagMap TyCon
tycon =
forall a. [(Name, a)] -> NameEnv a
mkNameEnv forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. NamedThing a => a -> Name
getName (TyCon -> [DataCon]
tyConDataCons TyCon
tycon) forall a b. [a] -> [b] -> [(a, b)]
`zip` [ConTag
fIRST_TAG..]
instance Eq TyCon where
TyCon
a == :: TyCon -> TyCon -> Bool
== TyCon
b = forall a. Uniquable a => a -> Unique
getUnique TyCon
a forall a. Eq a => a -> a -> Bool
== forall a. Uniquable a => a -> Unique
getUnique TyCon
b
TyCon
a /= :: TyCon -> TyCon -> Bool
/= TyCon
b = forall a. Uniquable a => a -> Unique
getUnique TyCon
a forall a. Eq a => a -> a -> Bool
/= forall a. Uniquable a => a -> Unique
getUnique TyCon
b
instance Uniquable TyCon where
getUnique :: TyCon -> Unique
getUnique TyCon
tc = TyCon -> Unique
tyConUnique TyCon
tc
instance Outputable TyCon where
ppr :: TyCon -> SDoc
ppr TyCon
tc = TyCon -> SDoc
pprPromotionQuote TyCon
tc SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr (TyCon -> Name
tyConName TyCon
tc) SDoc -> SDoc -> SDoc
<> SDoc
pp_tc
where
pp_tc :: SDoc
pp_tc = (PprStyle -> SDoc) -> SDoc
getPprStyle forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
(Bool -> SDoc) -> SDoc
getPprDebug forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
if ((Bool
debug Bool -> Bool -> Bool
|| PprStyle -> Bool
dumpStyle PprStyle
sty) Bool -> Bool -> Bool
&& TyCon -> Bool
isTcTyCon TyCon
tc)
then String -> SDoc
text String
"[tc]"
else SDoc
empty
data TyConFlavour
= ClassFlavour
| TupleFlavour Boxity
| SumFlavour
| DataTypeFlavour
| NewtypeFlavour
| AbstractTypeFlavour
| DataFamilyFlavour (Maybe TyCon)
| OpenTypeFamilyFlavour (Maybe TyCon)
| ClosedTypeFamilyFlavour
| TypeSynonymFlavour
| BuiltInTypeFlavour
| PromotedDataConFlavour
deriving TyConFlavour -> TyConFlavour -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TyConFlavour -> TyConFlavour -> Bool
$c/= :: TyConFlavour -> TyConFlavour -> Bool
== :: TyConFlavour -> TyConFlavour -> Bool
$c== :: TyConFlavour -> TyConFlavour -> Bool
Eq
instance Outputable TyConFlavour where
ppr :: TyConFlavour -> SDoc
ppr = String -> SDoc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyConFlavour -> String
go
where
go :: TyConFlavour -> String
go TyConFlavour
ClassFlavour = String
"class"
go (TupleFlavour Boxity
boxed) | Boxity -> Bool
isBoxed Boxity
boxed = String
"tuple"
| Bool
otherwise = String
"unboxed tuple"
go TyConFlavour
SumFlavour = String
"unboxed sum"
go TyConFlavour
DataTypeFlavour = String
"data type"
go TyConFlavour
NewtypeFlavour = String
"newtype"
go TyConFlavour
AbstractTypeFlavour = String
"abstract type"
go (DataFamilyFlavour (Just TyCon
_)) = String
"associated data family"
go (DataFamilyFlavour Maybe TyCon
Nothing) = String
"data family"
go (OpenTypeFamilyFlavour (Just TyCon
_)) = String
"associated type family"
go (OpenTypeFamilyFlavour Maybe TyCon
Nothing) = String
"type family"
go TyConFlavour
ClosedTypeFamilyFlavour = String
"type family"
go TyConFlavour
TypeSynonymFlavour = String
"type synonym"
go TyConFlavour
BuiltInTypeFlavour = String
"built-in type"
go TyConFlavour
PromotedDataConFlavour = String
"promoted data constructor"
tyConFlavour :: TyCon -> TyConFlavour
tyConFlavour :: TyCon -> TyConFlavour
tyConFlavour (AlgTyCon { algTcParent :: TyCon -> AlgTyConFlav
algTcParent = AlgTyConFlav
parent, algTcRhs :: TyCon -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs })
| ClassTyCon Class
_ Name
_ <- AlgTyConFlav
parent = TyConFlavour
ClassFlavour
| Bool
otherwise = case AlgTyConRhs
rhs of
TupleTyCon { tup_sort :: AlgTyConRhs -> TupleSort
tup_sort = TupleSort
sort }
-> Boxity -> TyConFlavour
TupleFlavour (TupleSort -> Boxity
tupleSortBoxity TupleSort
sort)
SumTyCon {} -> TyConFlavour
SumFlavour
DataTyCon {} -> TyConFlavour
DataTypeFlavour
NewTyCon {} -> TyConFlavour
NewtypeFlavour
AbstractTyCon {} -> TyConFlavour
AbstractTypeFlavour
tyConFlavour (FamilyTyCon { famTcFlav :: TyCon -> FamTyConFlav
famTcFlav = FamTyConFlav
flav, famTcParent :: TyCon -> Maybe TyCon
famTcParent = Maybe TyCon
parent })
= case FamTyConFlav
flav of
DataFamilyTyCon{} -> Maybe TyCon -> TyConFlavour
DataFamilyFlavour Maybe TyCon
parent
FamTyConFlav
OpenSynFamilyTyCon -> Maybe TyCon -> TyConFlavour
OpenTypeFamilyFlavour Maybe TyCon
parent
ClosedSynFamilyTyCon{} -> TyConFlavour
ClosedTypeFamilyFlavour
FamTyConFlav
AbstractClosedSynFamilyTyCon -> TyConFlavour
ClosedTypeFamilyFlavour
BuiltInSynFamTyCon{} -> TyConFlavour
ClosedTypeFamilyFlavour
tyConFlavour (SynonymTyCon {}) = TyConFlavour
TypeSynonymFlavour
tyConFlavour (FunTyCon {}) = TyConFlavour
BuiltInTypeFlavour
tyConFlavour (PrimTyCon {}) = TyConFlavour
BuiltInTypeFlavour
tyConFlavour (PromotedDataCon {}) = TyConFlavour
PromotedDataConFlavour
tyConFlavour (TcTyCon { tcTyConFlavour :: TyCon -> TyConFlavour
tcTyConFlavour = TyConFlavour
flav }) = TyConFlavour
flav
tcFlavourMustBeSaturated :: TyConFlavour -> Bool
tcFlavourMustBeSaturated :: TyConFlavour -> Bool
tcFlavourMustBeSaturated TyConFlavour
ClassFlavour = Bool
False
tcFlavourMustBeSaturated TyConFlavour
DataTypeFlavour = Bool
False
tcFlavourMustBeSaturated TyConFlavour
NewtypeFlavour = Bool
False
tcFlavourMustBeSaturated DataFamilyFlavour{} = Bool
False
tcFlavourMustBeSaturated TupleFlavour{} = Bool
False
tcFlavourMustBeSaturated TyConFlavour
SumFlavour = Bool
False
tcFlavourMustBeSaturated TyConFlavour
AbstractTypeFlavour = Bool
False
tcFlavourMustBeSaturated TyConFlavour
BuiltInTypeFlavour = Bool
False
tcFlavourMustBeSaturated TyConFlavour
PromotedDataConFlavour = Bool
False
tcFlavourMustBeSaturated TyConFlavour
TypeSynonymFlavour = Bool
True
tcFlavourMustBeSaturated OpenTypeFamilyFlavour{} = Bool
True
tcFlavourMustBeSaturated TyConFlavour
ClosedTypeFamilyFlavour = Bool
True
tcFlavourIsOpen :: TyConFlavour -> Bool
tcFlavourIsOpen :: TyConFlavour -> Bool
tcFlavourIsOpen DataFamilyFlavour{} = Bool
True
tcFlavourIsOpen OpenTypeFamilyFlavour{} = Bool
True
tcFlavourIsOpen TyConFlavour
ClosedTypeFamilyFlavour = Bool
False
tcFlavourIsOpen TyConFlavour
ClassFlavour = Bool
False
tcFlavourIsOpen TyConFlavour
DataTypeFlavour = Bool
False
tcFlavourIsOpen TyConFlavour
NewtypeFlavour = Bool
False
tcFlavourIsOpen TupleFlavour{} = Bool
False
tcFlavourIsOpen TyConFlavour
SumFlavour = Bool
False
tcFlavourIsOpen TyConFlavour
AbstractTypeFlavour = Bool
False
tcFlavourIsOpen TyConFlavour
BuiltInTypeFlavour = Bool
False
tcFlavourIsOpen TyConFlavour
PromotedDataConFlavour = Bool
False
tcFlavourIsOpen TyConFlavour
TypeSynonymFlavour = Bool
False
pprPromotionQuote :: TyCon -> SDoc
pprPromotionQuote :: TyCon -> SDoc
pprPromotionQuote TyCon
tc
= case TyCon
tc of
PromotedDataCon {} -> Char -> SDoc
char Char
'\''
TyCon
_ -> SDoc
empty
instance NamedThing TyCon where
getName :: TyCon -> Name
getName = TyCon -> Name
tyConName
instance Data.Data TyCon where
toConstr :: TyCon -> Constr
toConstr TyCon
_ = String -> Constr
abstractConstr String
"TyCon"
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TyCon
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: TyCon -> DataType
dataTypeOf TyCon
_ = String -> DataType
mkNoRepType String
"TyCon"
instance Binary Injectivity where
put_ :: BinHandle -> Injectivity -> IO ()
put_ BinHandle
bh Injectivity
NotInjective = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh (Injective [Bool]
xs) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Bool]
xs
get :: BinHandle -> IO Injectivity
get BinHandle
bh = do { Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
; case Word8
h of
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return Injectivity
NotInjective
Word8
_ -> do { [Bool]
xs <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; forall (m :: * -> *) a. Monad m => a -> m a
return ([Bool] -> Injectivity
Injective [Bool]
xs) } }
tyConSkolem :: TyCon -> Bool
tyConSkolem :: TyCon -> Bool
tyConSkolem = Name -> Bool
isHoleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Name
tyConName