{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveDataTypeable #-}
module GHC.Core.TyCon(
TyCon,
AlgTyConRhs(..), visibleDataCons,
AlgTyConFlav(..), isNoParent,
FamTyConFlav(..), Role(..), Injectivity(..),
PromDataConInfo(..), TyConFlavour(..),
TyConBinder, TyConBndrVis(..), TyConPiTyBinder,
mkNamedTyConBinder, mkNamedTyConBinders,
mkRequiredTyConBinder,
mkAnonTyConBinder, mkAnonTyConBinders, mkInvisAnonTyConBinder,
tyConBinderForAllTyFlag, tyConBndrVisForAllTyFlag, isNamedTyConBinder,
isVisibleTyConBinder, isInvisibleTyConBinder, isVisibleTcbVis,
tyConFieldLabels, lookupTyConFieldLabel,
mkAlgTyCon,
mkClassTyCon,
mkPrimTyCon,
mkTupleTyCon,
mkSumTyCon,
mkDataTyConRhs,
mkLevPolyDataTyConRhs,
mkSynonymTyCon,
mkFamilyTyCon,
mkPromotedDataCon,
mkTcTyCon,
noTcTyConScopedTyVars,
isAlgTyCon, isVanillaAlgTyCon,
isClassTyCon, isFamInstTyCon,
isPrimTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon,
isUnboxedSumTyCon, isPromotedTupleTyCon,
isLiftedAlgTyCon,
isTypeSynonymTyCon,
tyConMustBeSaturated,
isPromotedDataCon, isPromotedDataCon_maybe,
isDataKindsPromotedDataCon,
isKindTyCon, isLiftedTypeKindTyConName,
isTauTyCon, isFamFreeTyCon, isForgetfulSynTyCon,
isDataTyCon,
isTypeDataTyCon,
isEnumerationTyCon,
isNewTyCon, isAbstractTyCon,
isFamilyTyCon, isOpenFamilyTyCon,
isTypeFamilyTyCon, isDataFamilyTyCon,
isOpenTypeFamilyTyCon, isClosedSynFamilyTyConWithAxiom_maybe,
tyConInjectivityInfo,
isBuiltInSynFamTyCon_maybe,
isGadtSyntaxTyCon, isInjectiveTyCon, isGenerativeTyCon, isGenInjAlgRhs,
isTyConAssoc, tyConAssoc_maybe, tyConFlavourAssoc_maybe,
isImplicitTyCon,
isTyConWithSrcDataCons,
isTcTyCon, setTcTyConKind,
tcHasFixedRuntimeRep,
isConcreteTyCon,
tyConName,
tyConSkolem,
tyConKind,
tyConUnique,
tyConTyVars, tyConVisibleTyVars,
tyConCType_maybe,
tyConDataCons, tyConDataCons_maybe,
tyConSingleDataCon_maybe, tyConSingleDataCon,
tyConAlgDataCons_maybe,
tyConSingleAlgDataCon_maybe,
tyConFamilySize,
tyConStupidTheta,
tyConArity,
tyConNullaryTy, mkTyConTy,
tyConRoles,
tyConFlavour,
tyConTuple_maybe, tyConClass_maybe, tyConATs,
tyConFamInst_maybe, tyConFamInstSig_maybe, tyConFamilyCoercion_maybe,
tyConFamilyResVar_maybe,
synTyConDefn_maybe, synTyConRhs_maybe,
famTyConFlav_maybe,
algTyConRhs,
newTyConRhs, newTyConEtadArity, newTyConEtadRhs,
unwrapNewTyCon_maybe, unwrapNewTyConEtad_maybe,
newTyConDataCon_maybe,
algTcFields,
tyConPromDataConInfo,
tyConBinders, tyConResKind, tyConInvisTVBinders,
tcTyConScopedTyVars, isMonoTcTyCon,
tyConHasClosedResKind,
mkTyConTagMap,
ExpandSynResult(..),
expandSynTyCon_maybe,
newTyConCo, newTyConCo_maybe,
pprPromotionQuote, mkTyConKind,
tcFlavourIsOpen,
TyConRepName, tyConRepName_maybe,
mkPrelTyConRepName,
tyConRepModOcc,
PrimRep(..), PrimElemRep(..),
primElemRepToPrimRep,
isVoidRep, isGcPtrRep,
primRepSizeB,
primElemRepSizeB,
primRepIsFloat,
primRepsCompatible,
primRepCompatible,
primRepIsWord,
primRepIsInt,
) where
import GHC.Prelude
import GHC.Platform
import {-# SOURCE #-} GHC.Core.TyCo.Rep
( Kind, Type, PredType, mkForAllTy, mkNakedFunTy, mkNakedTyConTy )
import {-# SOURCE #-} GHC.Core.TyCo.FVs
( noFreeVarsOfType )
import {-# SOURCE #-} GHC.Core.TyCo.Ppr
( pprType )
import {-# SOURCE #-} GHC.Builtin.Types
( runtimeRepTyCon, constraintKind, levityTyCon
, multiplicityTyCon
, vecCountTyCon, vecElemTyCon )
import {-# SOURCE #-} GHC.Core.DataCon
( DataCon, dataConFieldLabels
, dataConTyCon, dataConFullSig
, isUnboxedSumDataCon, isTypeDataCon )
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.Utils.Panic.Plain
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 Language.Haskell.Syntax.Basic (FieldLabelString(..))
import qualified Data.Data as Data
type TyConBinder = VarBndr TyVar TyConBndrVis
type TyConPiTyBinder = VarBndr TyCoVar TyConBndrVis
data TyConBndrVis
= NamedTCB ForAllTyFlag
| AnonTCB FunTyFlag
instance Outputable TyConBndrVis where
ppr :: TyConBndrVis -> SDoc
ppr (NamedTCB ForAllTyFlag
flag) = ForAllTyFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr ForAllTyFlag
flag
ppr (AnonTCB FunTyFlag
af) = FunTyFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr FunTyFlag
af
mkAnonTyConBinder :: TyVar -> TyConBinder
mkAnonTyConBinder :: TyVar -> TyConBinder
mkAnonTyConBinder TyVar
tv = Bool -> TyConBinder -> TyConBinder
forall a. HasCallStack => Bool -> a -> a
assert (TyVar -> Bool
isTyVar TyVar
tv) (TyConBinder -> TyConBinder) -> TyConBinder -> TyConBinder
forall a b. (a -> b) -> a -> b
$
TyVar -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv (FunTyFlag -> TyConBndrVis
AnonTCB FunTyFlag
visArgTypeLike)
mkAnonTyConBinders :: [TyVar] -> [TyConBinder]
mkAnonTyConBinders :: [TyVar] -> [TyConBinder]
mkAnonTyConBinders [TyVar]
tvs = (TyVar -> TyConBinder) -> [TyVar] -> [TyConBinder]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> TyConBinder
mkAnonTyConBinder [TyVar]
tvs
mkInvisAnonTyConBinder :: TyVar -> TyConBinder
mkInvisAnonTyConBinder :: TyVar -> TyConBinder
mkInvisAnonTyConBinder TyVar
tv = Bool -> TyConBinder -> TyConBinder
forall a. HasCallStack => Bool -> a -> a
assert (TyVar -> Bool
isTyVar TyVar
tv) (TyConBinder -> TyConBinder) -> TyConBinder -> TyConBinder
forall a b. (a -> b) -> a -> b
$
TyVar -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv (FunTyFlag -> TyConBndrVis
AnonTCB FunTyFlag
invisArgTypeLike)
mkNamedTyConBinder :: ForAllTyFlag -> TyVar -> TyConBinder
mkNamedTyConBinder :: ForAllTyFlag -> TyVar -> TyConBinder
mkNamedTyConBinder ForAllTyFlag
vis TyVar
tv = Bool -> TyConBinder -> TyConBinder
forall a. HasCallStack => Bool -> a -> a
assert (TyVar -> Bool
isTyVar TyVar
tv) (TyConBinder -> TyConBinder) -> TyConBinder -> TyConBinder
forall a b. (a -> b) -> a -> b
$
TyVar -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv (ForAllTyFlag -> TyConBndrVis
NamedTCB ForAllTyFlag
vis)
mkNamedTyConBinders :: ForAllTyFlag -> [TyVar] -> [TyConBinder]
mkNamedTyConBinders :: ForAllTyFlag -> [TyVar] -> [TyConBinder]
mkNamedTyConBinders ForAllTyFlag
vis [TyVar]
tvs = (TyVar -> TyConBinder) -> [TyVar] -> [TyConBinder]
forall a b. (a -> b) -> [a] -> [b]
map (ForAllTyFlag -> TyVar -> TyConBinder
mkNamedTyConBinder ForAllTyFlag
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 = ForAllTyFlag -> TyVar -> TyConBinder
mkNamedTyConBinder ForAllTyFlag
Required TyVar
tv
| Bool
otherwise = TyVar -> TyConBinder
mkAnonTyConBinder TyVar
tv
tyConBinderForAllTyFlag :: TyConBinder -> ForAllTyFlag
tyConBinderForAllTyFlag :: TyConBinder -> ForAllTyFlag
tyConBinderForAllTyFlag (Bndr TyVar
_ TyConBndrVis
vis) = TyConBndrVis -> ForAllTyFlag
tyConBndrVisForAllTyFlag TyConBndrVis
vis
tyConBndrVisForAllTyFlag :: TyConBndrVis -> ForAllTyFlag
tyConBndrVisForAllTyFlag :: TyConBndrVis -> ForAllTyFlag
tyConBndrVisForAllTyFlag (NamedTCB ForAllTyFlag
vis) = ForAllTyFlag
vis
tyConBndrVisForAllTyFlag (AnonTCB FunTyFlag
af)
| FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af = ForAllTyFlag
Required
| Bool
otherwise = ForAllTyFlag
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 ForAllTyFlag
vis) = ForAllTyFlag -> Bool
isVisibleForAllTyFlag ForAllTyFlag
vis
isVisibleTcbVis (AnonTCB FunTyFlag
af) = FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af
isInvisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder :: forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder VarBndr tv TyConBndrVis
tcb = Bool -> Bool
not (VarBndr tv TyConBndrVis -> Bool
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 = (TyConBinder -> Kind -> Kind) -> Kind -> [TyConBinder] -> Kind
forall a b. (a -> b -> b) -> b -> [a] -> b
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 (NamedTCB ForAllTyFlag
vis)) Kind
k = VarBndr TyVar ForAllTyFlag -> Kind -> Kind
mkForAllTy (TyVar -> ForAllTyFlag -> VarBndr TyVar ForAllTyFlag
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv ForAllTyFlag
vis) Kind
k
mk (Bndr TyVar
tv (AnonTCB FunTyFlag
af)) Kind
k = FunTyFlag -> Kind -> Kind -> Kind
mkNakedFunTy FunTyFlag
af (TyVar -> Kind
varType TyVar
tv) Kind
k
mkTyConTy :: TyCon -> Type
mkTyConTy :: TyCon -> Kind
mkTyConTy TyCon
tycon = TyCon -> Kind
tyConNullaryTy TyCon
tycon
tyConInvisTVBinders :: [TyConBinder]
-> [InvisTVBinder]
tyConInvisTVBinders :: [TyConBinder] -> [InvisTVBinder]
tyConInvisTVBinders [TyConBinder]
tc_bndrs
= (TyConBinder -> InvisTVBinder) -> [TyConBinder] -> [InvisTVBinder]
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) = Specificity -> TyVar -> InvisTVBinder
forall vis. vis -> TyVar -> VarBndr TyVar vis
mkTyVarBinder Specificity
vis TyVar
tv
where
vis :: Specificity
vis = case TyConBndrVis
tc_vis of
AnonTCB FunTyFlag
af
| FunTyFlag -> Bool
isInvisibleFunArg FunTyFlag
af -> Specificity
InferredSpec
| Bool
otherwise -> Specificity
SpecifiedSpec
NamedTCB ForAllTyFlag
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
forall a. Outputable a => a -> SDoc
ppr TyConBndrVis
bi SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (BindingSite -> tv -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind tv
v)
instance Binary TyConBndrVis where
put_ :: BinHandle -> TyConBndrVis -> IO ()
put_ BinHandle
bh (AnonTCB FunTyFlag
af) = do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0; BinHandle -> FunTyFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FunTyFlag
af }
put_ BinHandle
bh (NamedTCB ForAllTyFlag
vis) = do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1; BinHandle -> ForAllTyFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ForAllTyFlag
vis }
get :: BinHandle -> IO TyConBndrVis
get BinHandle
bh = do { Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
; case Word8
h of
Word8
0 -> do { FunTyFlag
af <- BinHandle -> IO FunTyFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; TyConBndrVis -> IO TyConBndrVis
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FunTyFlag -> TyConBndrVis
AnonTCB FunTyFlag
af) }
Word8
_ -> do { ForAllTyFlag
vis <- BinHandle -> IO ForAllTyFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; TyConBndrVis -> IO TyConBndrVis
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForAllTyFlag -> TyConBndrVis
NamedTCB ForAllTyFlag
vis) } }
data TyCon = TyCon {
TyCon -> Unique
tyConUnique :: !Unique,
TyCon -> Name
tyConName :: !Name,
TyCon -> [TyConBinder]
tyConBinders :: [TyConBinder],
TyCon -> Kind
tyConResKind :: Kind,
TyCon -> Bool
tyConHasClosedResKind :: Bool,
TyCon -> [TyVar]
tyConTyVars :: [TyVar],
TyCon -> Kind
tyConKind :: Kind,
TyCon -> Int
tyConArity :: Arity,
TyCon -> Kind
tyConNullaryTy :: Type,
TyCon -> [Role]
tyConRoles :: [Role],
TyCon -> TyConDetails
tyConDetails :: !TyConDetails }
data TyConDetails =
AlgTyCon {
TyConDetails -> Maybe CType
tyConCType :: Maybe CType,
TyConDetails -> Bool
algTcGadtSyntax :: Bool,
TyConDetails -> [Kind]
algTcStupidTheta :: [PredType],
TyConDetails -> AlgTyConRhs
algTcRhs :: AlgTyConRhs,
TyConDetails -> FieldLabelEnv
algTcFields :: FieldLabelEnv,
TyConDetails -> AlgTyConFlav
algTcFlavour :: AlgTyConFlav
}
| SynonymTyCon {
TyConDetails -> Kind
synTcRhs :: Type,
TyConDetails -> Bool
synIsTau :: Bool,
TyConDetails -> Bool
synIsFamFree :: Bool,
TyConDetails -> Bool
synIsForgetful :: Bool
}
| FamilyTyCon {
TyConDetails -> Maybe Name
famTcResVar :: Maybe Name,
TyConDetails -> FamTyConFlav
famTcFlav :: FamTyConFlav,
TyConDetails -> Maybe TyCon
famTcParent :: Maybe TyCon,
TyConDetails -> Injectivity
famTcInj :: Injectivity
}
| PrimTyCon {
TyConDetails -> Name
primRepName :: TyConRepName
}
| PromotedDataCon {
TyConDetails -> DataCon
dataCon :: DataCon,
TyConDetails -> Name
tcRepName :: TyConRepName,
TyConDetails -> PromDataConInfo
promDcInfo :: PromDataConInfo
}
| TcTyCon {
TyConDetails -> [(Name, TyVar)]
tctc_scoped_tvs :: [(Name,TcTyVar)],
TyConDetails -> Bool
tctc_is_poly :: Bool,
TyConDetails -> TyConFlavour
tctc_flavour :: TyConFlavour
}
data AlgTyConRhs
= AbstractTyCon
| DataTyCon {
AlgTyConRhs -> [DataCon]
data_cons :: [DataCon],
AlgTyConRhs -> Int
data_cons_size :: Int,
AlgTyConRhs -> Bool
is_enum :: Bool,
AlgTyConRhs -> Bool
is_type_data :: Bool,
AlgTyConRhs -> Bool
data_fixed_lev :: 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_fixed_rep :: Bool
}
mkSumTyConRhs :: [DataCon] -> AlgTyConRhs
mkSumTyConRhs :: [DataCon] -> AlgTyConRhs
mkSumTyConRhs [DataCon]
data_cons = [DataCon] -> Int -> AlgTyConRhs
SumTyCon [DataCon]
data_cons ([DataCon] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataCon]
data_cons)
mkLevPolyDataTyConRhs :: Bool
-> Bool
-> [DataCon]
-> AlgTyConRhs
mkLevPolyDataTyConRhs :: Bool -> Bool -> [DataCon] -> AlgTyConRhs
mkLevPolyDataTyConRhs Bool
fixed_lev Bool
type_data [DataCon]
cons
= DataTyCon {
data_cons :: [DataCon]
data_cons = [DataCon]
cons,
data_cons_size :: Int
data_cons_size = [DataCon] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataCon]
cons,
is_enum :: Bool
is_enum = Bool -> Bool
not ([DataCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
cons) Bool -> Bool -> Bool
&& (DataCon -> Bool) -> [DataCon] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all DataCon -> Bool
is_enum_con [DataCon]
cons,
is_type_data :: Bool
is_type_data = Bool
type_data,
data_fixed_lev :: Bool
data_fixed_lev = Bool
fixed_lev
}
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
= [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
&& [Kind] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Kind]
theta Bool -> Bool -> Bool
&& [Scaled Kind] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Scaled Kind]
arg_tys
mkDataTyConRhs :: [DataCon] -> AlgTyConRhs
mkDataTyConRhs :: [DataCon] -> AlgTyConRhs
mkDataTyConRhs = Bool -> Bool -> [DataCon] -> AlgTyConRhs
mkLevPolyDataTyConRhs Bool
True Bool
False
data PromDataConInfo
= NoPromInfo
| RuntimeRep ([Type] -> [PrimRep])
| VecCount Int
| VecElem PrimElemRep
| Levity Levity
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
| UnboxedSumTyCon
| ClassTyCon
Class
TyConRepName
| DataFamInstTyCon
(CoAxiom Unbranched)
TyCon
[Type]
instance Outputable AlgTyConFlav where
ppr :: AlgTyConFlav -> SDoc
ppr (VanillaAlgTyCon {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Vanilla ADT"
ppr (UnboxedSumTyCon {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unboxed sum"
ppr (ClassTyCon Class
cls Name
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class parent" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls
ppr (DataFamInstTyCon CoAxiom Unbranched
_ TyCon
tc [Kind]
tys) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Family parent (family instance)"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((Kind -> SDoc) -> [Kind] -> [SDoc]
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
_ (UnboxedSumTyCon {}) = Bool
True
okParent Name
tc_name (ClassTyCon Class
cls Name
_) = Name
tc_name Name -> Name -> Bool
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 [Kind] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthAtLeast` TyCon -> Int
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
(Injectivity -> Injectivity -> Bool)
-> (Injectivity -> Injectivity -> Bool) -> Eq Injectivity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Injectivity -> Injectivity -> Bool
== :: Injectivity -> Injectivity -> Bool
$c/= :: Injectivity -> Injectivity -> Bool
/= :: 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
forall doc. IsLine doc => String -> doc
text String
"data family" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
ppr FamTyConFlav
OpenSynFamilyTyCon = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"open type family"
ppr (ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
Nothing) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"closed type family"
ppr (ClosedSynFamilyTyCon (Just CoAxiom Branched
coax)) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"closed type family" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> CoAxiom Branched -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoAxiom Branched
coax
ppr FamTyConFlav
AbstractClosedSynFamilyTyCon = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"abstract closed type family"
ppr (BuiltInSynFamTyCon BuiltInSynFamily
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"built-in type family"
type TyConRepName = Name
tyConRepName_maybe :: TyCon -> Maybe TyConRepName
tyConRepName_maybe :: TyCon -> Maybe Name
tyConRepName_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details }) = TyConDetails -> Maybe Name
get_rep_nm TyConDetails
details
where
get_rep_nm :: TyConDetails -> Maybe Name
get_rep_nm (PrimTyCon { primRepName :: TyConDetails -> Name
primRepName = Name
rep_nm })
= Name -> Maybe Name
forall a. a -> Maybe a
Just Name
rep_nm
get_rep_nm (AlgTyCon { algTcFlavour :: TyConDetails -> AlgTyConFlav
algTcFlavour = AlgTyConFlav
parent })
= case AlgTyConFlav
parent of
VanillaAlgTyCon Name
rep_nm -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
rep_nm
AlgTyConFlav
UnboxedSumTyCon -> Maybe Name
forall a. Maybe a
Nothing
ClassTyCon Class
_ Name
rep_nm -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
rep_nm
DataFamInstTyCon {} -> Maybe Name
forall a. Maybe a
Nothing
get_rep_nm (FamilyTyCon { famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = DataFamilyTyCon Name
rep_nm })
= Name -> Maybe Name
forall a. a -> Maybe a
Just Name
rep_nm
get_rep_nm (PromotedDataCon { dataCon :: TyConDetails -> DataCon
dataCon = DataCon
dc, tcRepName :: TyConDetails -> Name
tcRepName = Name
rep_nm })
| DataCon -> Bool
isUnboxedSumDataCon DataCon
dc
= Maybe Name
forall a. Maybe a
Nothing
| Bool
otherwise
= Name -> Maybe Name
forall a. a -> Maybe a
Just Name
rep_nm
get_rep_nm TyConDetails
_ = Maybe Name
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 = (() :: Constraint) => Name -> Module
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 Module -> Module -> Bool
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( Typeable PrimRep
Typeable PrimRep =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrimRep -> c PrimRep)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimRep)
-> (PrimRep -> Constr)
-> (PrimRep -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrimRep))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PrimRep))
-> ((forall b. Data b => b -> b) -> PrimRep -> PrimRep)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrimRep -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrimRep -> r)
-> (forall u. (forall d. Data d => d -> u) -> PrimRep -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PrimRep -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrimRep -> m PrimRep)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimRep -> m PrimRep)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimRep -> m PrimRep)
-> Data PrimRep
PrimRep -> Constr
PrimRep -> DataType
(forall b. Data b => b -> b) -> PrimRep -> PrimRep
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. Int -> (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. Int -> (forall d. Data d => d -> u) -> PrimRep -> u
forall u. (forall d. Data d => d -> u) -> PrimRep -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrimRep -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrimRep -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrimRep -> m PrimRep
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimRep -> m PrimRep
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimRep
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrimRep -> c PrimRep
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrimRep)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PrimRep)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrimRep -> c PrimRep
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrimRep -> c PrimRep
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimRep
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimRep
$ctoConstr :: PrimRep -> Constr
toConstr :: PrimRep -> Constr
$cdataTypeOf :: PrimRep -> DataType
dataTypeOf :: PrimRep -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrimRep)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrimRep)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PrimRep)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PrimRep)
$cgmapT :: (forall b. Data b => b -> b) -> PrimRep -> PrimRep
gmapT :: (forall b. Data b => b -> b) -> PrimRep -> PrimRep
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrimRep -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrimRep -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrimRep -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrimRep -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PrimRep -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PrimRep -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PrimRep -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PrimRep -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrimRep -> m PrimRep
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrimRep -> m PrimRep
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimRep -> m PrimRep
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimRep -> m PrimRep
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimRep -> m PrimRep
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimRep -> m PrimRep
Data.Data, PrimRep -> PrimRep -> Bool
(PrimRep -> PrimRep -> Bool)
-> (PrimRep -> PrimRep -> Bool) -> Eq PrimRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrimRep -> PrimRep -> Bool
== :: PrimRep -> PrimRep -> Bool
$c/= :: PrimRep -> PrimRep -> Bool
/= :: PrimRep -> PrimRep -> Bool
Eq, Eq PrimRep
Eq PrimRep =>
(PrimRep -> PrimRep -> Ordering)
-> (PrimRep -> PrimRep -> Bool)
-> (PrimRep -> PrimRep -> Bool)
-> (PrimRep -> PrimRep -> Bool)
-> (PrimRep -> PrimRep -> Bool)
-> (PrimRep -> PrimRep -> PrimRep)
-> (PrimRep -> PrimRep -> PrimRep)
-> Ord PrimRep
PrimRep -> PrimRep -> Bool
PrimRep -> PrimRep -> Ordering
PrimRep -> PrimRep -> PrimRep
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PrimRep -> PrimRep -> Ordering
compare :: PrimRep -> PrimRep -> Ordering
$c< :: PrimRep -> PrimRep -> Bool
< :: PrimRep -> PrimRep -> Bool
$c<= :: PrimRep -> PrimRep -> Bool
<= :: PrimRep -> PrimRep -> Bool
$c> :: PrimRep -> PrimRep -> Bool
> :: PrimRep -> PrimRep -> Bool
$c>= :: PrimRep -> PrimRep -> Bool
>= :: PrimRep -> PrimRep -> Bool
$cmax :: PrimRep -> PrimRep -> PrimRep
max :: PrimRep -> PrimRep -> PrimRep
$cmin :: PrimRep -> PrimRep -> PrimRep
min :: PrimRep -> PrimRep -> PrimRep
Ord, Int -> PrimRep -> ShowS
[PrimRep] -> ShowS
PrimRep -> String
(Int -> PrimRep -> ShowS)
-> (PrimRep -> String) -> ([PrimRep] -> ShowS) -> Show PrimRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrimRep -> ShowS
showsPrec :: Int -> PrimRep -> ShowS
$cshow :: PrimRep -> String
show :: PrimRep -> String
$cshowList :: [PrimRep] -> ShowS
showList :: [PrimRep] -> ShowS
Show )
data PrimElemRep
= Int8ElemRep
| Int16ElemRep
| Int32ElemRep
| Int64ElemRep
| Word8ElemRep
| Word16ElemRep
| Word32ElemRep
| Word64ElemRep
| FloatElemRep
| DoubleElemRep
deriving( Typeable PrimElemRep
Typeable PrimElemRep =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrimElemRep -> c PrimElemRep)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimElemRep)
-> (PrimElemRep -> Constr)
-> (PrimElemRep -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrimElemRep))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrimElemRep))
-> ((forall b. Data b => b -> b) -> PrimElemRep -> PrimElemRep)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrimElemRep -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrimElemRep -> r)
-> (forall u. (forall d. Data d => d -> u) -> PrimElemRep -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> PrimElemRep -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrimElemRep -> m PrimElemRep)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimElemRep -> m PrimElemRep)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimElemRep -> m PrimElemRep)
-> Data PrimElemRep
PrimElemRep -> Constr
PrimElemRep -> DataType
(forall b. Data b => b -> b) -> PrimElemRep -> PrimElemRep
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. Int -> (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. Int -> (forall d. Data d => d -> u) -> PrimElemRep -> u
forall u. (forall d. Data d => d -> u) -> PrimElemRep -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrimElemRep -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrimElemRep -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrimElemRep -> m PrimElemRep
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimElemRep -> m PrimElemRep
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimElemRep
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrimElemRep -> c PrimElemRep
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrimElemRep)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrimElemRep)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrimElemRep -> c PrimElemRep
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrimElemRep -> c PrimElemRep
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimElemRep
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrimElemRep
$ctoConstr :: PrimElemRep -> Constr
toConstr :: PrimElemRep -> Constr
$cdataTypeOf :: PrimElemRep -> DataType
dataTypeOf :: PrimElemRep -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrimElemRep)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrimElemRep)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrimElemRep)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrimElemRep)
$cgmapT :: (forall b. Data b => b -> b) -> PrimElemRep -> PrimElemRep
gmapT :: (forall b. Data b => b -> b) -> PrimElemRep -> PrimElemRep
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrimElemRep -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrimElemRep -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrimElemRep -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrimElemRep -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PrimElemRep -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PrimElemRep -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PrimElemRep -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PrimElemRep -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrimElemRep -> m PrimElemRep
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrimElemRep -> m PrimElemRep
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimElemRep -> m PrimElemRep
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimElemRep -> m PrimElemRep
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimElemRep -> m PrimElemRep
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrimElemRep -> m PrimElemRep
Data.Data, PrimElemRep -> PrimElemRep -> Bool
(PrimElemRep -> PrimElemRep -> Bool)
-> (PrimElemRep -> PrimElemRep -> Bool) -> Eq PrimElemRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrimElemRep -> PrimElemRep -> Bool
== :: PrimElemRep -> PrimElemRep -> Bool
$c/= :: PrimElemRep -> PrimElemRep -> Bool
/= :: PrimElemRep -> PrimElemRep -> Bool
Eq, Eq PrimElemRep
Eq PrimElemRep =>
(PrimElemRep -> PrimElemRep -> Ordering)
-> (PrimElemRep -> PrimElemRep -> Bool)
-> (PrimElemRep -> PrimElemRep -> Bool)
-> (PrimElemRep -> PrimElemRep -> Bool)
-> (PrimElemRep -> PrimElemRep -> Bool)
-> (PrimElemRep -> PrimElemRep -> PrimElemRep)
-> (PrimElemRep -> PrimElemRep -> PrimElemRep)
-> Ord PrimElemRep
PrimElemRep -> PrimElemRep -> Bool
PrimElemRep -> PrimElemRep -> Ordering
PrimElemRep -> PrimElemRep -> PrimElemRep
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PrimElemRep -> PrimElemRep -> Ordering
compare :: PrimElemRep -> PrimElemRep -> Ordering
$c< :: PrimElemRep -> PrimElemRep -> Bool
< :: PrimElemRep -> PrimElemRep -> Bool
$c<= :: PrimElemRep -> PrimElemRep -> Bool
<= :: PrimElemRep -> PrimElemRep -> Bool
$c> :: PrimElemRep -> PrimElemRep -> Bool
> :: PrimElemRep -> PrimElemRep -> Bool
$c>= :: PrimElemRep -> PrimElemRep -> Bool
>= :: PrimElemRep -> PrimElemRep -> Bool
$cmax :: PrimElemRep -> PrimElemRep -> PrimElemRep
max :: PrimElemRep -> PrimElemRep -> PrimElemRep
$cmin :: PrimElemRep -> PrimElemRep -> PrimElemRep
min :: PrimElemRep -> PrimElemRep -> PrimElemRep
Ord, Int -> PrimElemRep -> ShowS
[PrimElemRep] -> ShowS
PrimElemRep -> String
(Int -> PrimElemRep -> ShowS)
-> (PrimElemRep -> String)
-> ([PrimElemRep] -> ShowS)
-> Show PrimElemRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrimElemRep -> ShowS
showsPrec :: Int -> PrimElemRep -> ShowS
$cshow :: PrimElemRep -> String
show :: PrimElemRep -> String
$cshowList :: [PrimElemRep] -> ShowS
showList :: [PrimElemRep] -> ShowS
Show, Int -> PrimElemRep
PrimElemRep -> Int
PrimElemRep -> [PrimElemRep]
PrimElemRep -> PrimElemRep
PrimElemRep -> PrimElemRep -> [PrimElemRep]
PrimElemRep -> PrimElemRep -> PrimElemRep -> [PrimElemRep]
(PrimElemRep -> PrimElemRep)
-> (PrimElemRep -> PrimElemRep)
-> (Int -> PrimElemRep)
-> (PrimElemRep -> Int)
-> (PrimElemRep -> [PrimElemRep])
-> (PrimElemRep -> PrimElemRep -> [PrimElemRep])
-> (PrimElemRep -> PrimElemRep -> [PrimElemRep])
-> (PrimElemRep -> PrimElemRep -> PrimElemRep -> [PrimElemRep])
-> Enum PrimElemRep
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PrimElemRep -> PrimElemRep
succ :: PrimElemRep -> PrimElemRep
$cpred :: PrimElemRep -> PrimElemRep
pred :: PrimElemRep -> PrimElemRep
$ctoEnum :: Int -> PrimElemRep
toEnum :: Int -> PrimElemRep
$cfromEnum :: PrimElemRep -> Int
fromEnum :: PrimElemRep -> Int
$cenumFrom :: PrimElemRep -> [PrimElemRep]
enumFrom :: PrimElemRep -> [PrimElemRep]
$cenumFromThen :: PrimElemRep -> PrimElemRep -> [PrimElemRep]
enumFromThen :: PrimElemRep -> PrimElemRep -> [PrimElemRep]
$cenumFromTo :: PrimElemRep -> PrimElemRep -> [PrimElemRep]
enumFromTo :: PrimElemRep -> PrimElemRep -> [PrimElemRep]
$cenumFromThenTo :: PrimElemRep -> PrimElemRep -> PrimElemRep -> [PrimElemRep]
enumFromThenTo :: PrimElemRep -> PrimElemRep -> PrimElemRep -> [PrimElemRep]
Enum )
instance Outputable PrimRep where
ppr :: PrimRep -> SDoc
ppr PrimRep
r = String -> SDoc
forall doc. IsLine doc => String -> doc
text (PrimRep -> String
forall a. Show a => a -> String
show PrimRep
r)
instance Outputable PrimElemRep where
ppr :: PrimElemRep -> SDoc
ppr PrimElemRep
r = String -> SDoc
forall doc. IsLine doc => String -> doc
text (PrimElemRep -> String
forall a. Show a => a -> String
show PrimElemRep
r)
instance Binary PrimRep where
put_ :: BinHandle -> PrimRep -> IO ()
put_ BinHandle
bh PrimRep
VoidRep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh PrimRep
LiftedRep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
put_ BinHandle
bh PrimRep
UnliftedRep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
put_ BinHandle
bh PrimRep
Int8Rep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
put_ BinHandle
bh PrimRep
Int16Rep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
put_ BinHandle
bh PrimRep
Int32Rep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
put_ BinHandle
bh PrimRep
Int64Rep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6
put_ BinHandle
bh PrimRep
IntRep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7
put_ BinHandle
bh PrimRep
Word8Rep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8
put_ BinHandle
bh PrimRep
Word16Rep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
9
put_ BinHandle
bh PrimRep
Word32Rep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
10
put_ BinHandle
bh PrimRep
Word64Rep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
11
put_ BinHandle
bh PrimRep
WordRep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
12
put_ BinHandle
bh PrimRep
AddrRep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
13
put_ BinHandle
bh PrimRep
FloatRep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
14
put_ BinHandle
bh PrimRep
DoubleRep = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
15
put_ BinHandle
bh (VecRep Int
n PrimElemRep
per) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
16 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
n IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BinHandle -> PrimElemRep -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh PrimElemRep
per
get :: BinHandle -> IO PrimRep
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
VoidRep
Word8
1 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
LiftedRep
Word8
2 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
UnliftedRep
Word8
3 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
Int8Rep
Word8
4 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
Int16Rep
Word8
5 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
Int32Rep
Word8
6 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
Int64Rep
Word8
7 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
IntRep
Word8
8 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
Word8Rep
Word8
9 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
Word16Rep
Word8
10 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
Word32Rep
Word8
11 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
Word64Rep
Word8
12 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
WordRep
Word8
13 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
AddrRep
Word8
14 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
FloatRep
Word8
15 -> PrimRep -> IO PrimRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimRep
DoubleRep
Word8
16 -> Int -> PrimElemRep -> PrimRep
VecRep (Int -> PrimElemRep -> PrimRep)
-> IO Int -> IO (PrimElemRep -> PrimRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (PrimElemRep -> PrimRep) -> IO PrimElemRep -> IO PrimRep
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO PrimElemRep
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
_ -> String -> SDoc -> IO PrimRep
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Binary:PrimRep" (Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
h))
instance Binary PrimElemRep where
put_ :: BinHandle -> PrimElemRep -> IO ()
put_ BinHandle
bh PrimElemRep
per = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PrimElemRep -> Int
forall a. Enum a => a -> Int
fromEnum PrimElemRep
per))
get :: BinHandle -> IO PrimElemRep
get BinHandle
bh = Int -> PrimElemRep
forall a. Enum a => Int -> a
toEnum (Int -> PrimElemRep) -> (Word8 -> Int) -> Word8 -> PrimElemRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> PrimElemRep) -> IO Word8 -> IO PrimElemRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Word8
getByte BinHandle
bh
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 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== PrimRep -> Bool
isUnboxed PrimRep
rep2) Bool -> Bool -> Bool
&&
(Platform -> PrimRep -> Int
primRepSizeB Platform
platform PrimRep
rep1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Platform -> PrimRep -> Int
primRepSizeB Platform
platform PrimRep
rep2) Bool -> Bool -> Bool
&&
(PrimRep -> Maybe Bool
primRepIsFloat PrimRep
rep1 Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== PrimRep -> Maybe Bool
primRepIsFloat PrimRep
rep2)
where
isUnboxed :: PrimRep -> Bool
isUnboxed = Bool -> Bool
not (Bool -> Bool) -> (PrimRep -> Bool) -> PrimRep -> Bool
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 =
[PrimRep] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PrimRep]
reps1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [PrimRep] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PrimRep]
reps2 Bool -> Bool -> Bool
&&
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((PrimRep -> PrimRep -> Bool) -> [PrimRep] -> [PrimRep] -> [Bool]
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 -> Int
primRepSizeB Platform
platform = \case
PrimRep
IntRep -> Platform -> Int
platformWordSizeInBytes Platform
platform
PrimRep
WordRep -> Platform -> Int
platformWordSizeInBytes Platform
platform
PrimRep
Int8Rep -> Int
1
PrimRep
Int16Rep -> Int
2
PrimRep
Int32Rep -> Int
4
PrimRep
Int64Rep -> Int
8
PrimRep
Word8Rep -> Int
1
PrimRep
Word16Rep -> Int
2
PrimRep
Word32Rep -> Int
4
PrimRep
Word64Rep -> Int
8
PrimRep
FloatRep -> Int
fLOAT_SIZE
PrimRep
DoubleRep -> Int
dOUBLE_SIZE
PrimRep
AddrRep -> Platform -> Int
platformWordSizeInBytes Platform
platform
PrimRep
LiftedRep -> Platform -> Int
platformWordSizeInBytes Platform
platform
PrimRep
UnliftedRep -> Platform -> Int
platformWordSizeInBytes Platform
platform
PrimRep
VoidRep -> Int
0
(VecRep Int
len PrimElemRep
rep) -> Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Platform -> PrimElemRep -> Int
primElemRepSizeB Platform
platform PrimElemRep
rep
primElemRepSizeB :: Platform -> PrimElemRep -> Int
primElemRepSizeB :: Platform -> PrimElemRep -> Int
primElemRepSizeB Platform
platform = Platform -> PrimRep -> Int
primRepSizeB Platform
platform (PrimRep -> Int) -> (PrimElemRep -> PrimRep) -> PrimElemRep -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimElemRep -> PrimRep
primElemRepToPrimRep
primElemRepToPrimRep :: PrimElemRep -> PrimRep
primElemRepToPrimRep :: PrimElemRep -> PrimRep
primElemRepToPrimRep PrimElemRep
Int8ElemRep = PrimRep
Int8Rep
primElemRepToPrimRep PrimElemRep
Int16ElemRep = PrimRep
Int16Rep
primElemRepToPrimRep PrimElemRep
Int32ElemRep = PrimRep
Int32Rep
primElemRepToPrimRep PrimElemRep
Int64ElemRep = PrimRep
Int64Rep
primElemRepToPrimRep PrimElemRep
Word8ElemRep = PrimRep
Word8Rep
primElemRepToPrimRep PrimElemRep
Word16ElemRep = PrimRep
Word16Rep
primElemRepToPrimRep PrimElemRep
Word32ElemRep = PrimRep
Word32Rep
primElemRepToPrimRep PrimElemRep
Word64ElemRep = PrimRep
Word64Rep
primElemRepToPrimRep PrimElemRep
FloatElemRep = PrimRep
FloatRep
primElemRepToPrimRep PrimElemRep
DoubleElemRep = PrimRep
DoubleRep
primRepIsFloat :: PrimRep -> Maybe Bool
primRepIsFloat :: PrimRep -> Maybe Bool
primRepIsFloat PrimRep
FloatRep = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
primRepIsFloat PrimRep
DoubleRep = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
primRepIsFloat (VecRep Int
_ PrimElemRep
_) = Maybe Bool
forall a. Maybe a
Nothing
primRepIsFloat PrimRep
_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
primRepIsWord :: PrimRep -> Bool
primRepIsWord :: PrimRep -> Bool
primRepIsWord PrimRep
WordRep = Bool
True
primRepIsWord (PrimRep
Word8Rep) = Bool
True
primRepIsWord (PrimRep
Word16Rep) = Bool
True
primRepIsWord (PrimRep
Word32Rep) = Bool
True
primRepIsWord (PrimRep
Word64Rep) = Bool
True
primRepIsWord PrimRep
_ = Bool
False
primRepIsInt :: PrimRep -> Bool
primRepIsInt :: PrimRep -> Bool
primRepIsInt (PrimRep
IntRep) = Bool
True
primRepIsInt (PrimRep
Int8Rep) = Bool
True
primRepIsInt (PrimRep
Int16Rep) = Bool
True
primRepIsInt (PrimRep
Int32Rep) = Bool
True
primRepIsInt (PrimRep
Int64Rep) = Bool
True
primRepIsInt PrimRep
_ = Bool
False
tyConFieldLabels :: TyCon -> [FieldLabel]
tyConFieldLabels :: TyCon -> [FieldLabel]
tyConFieldLabels TyCon
tc = FieldLabelEnv -> [FieldLabel]
forall a. DFastStringEnv a -> [a]
dFsEnvElts (FieldLabelEnv -> [FieldLabel]) -> FieldLabelEnv -> [FieldLabel]
forall a b. (a -> b) -> a -> b
$ TyCon -> FieldLabelEnv
tyConFieldLabelEnv TyCon
tc
tyConFieldLabelEnv :: TyCon -> FieldLabelEnv
tyConFieldLabelEnv :: TyCon -> FieldLabelEnv
tyConFieldLabelEnv (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcFields :: TyConDetails -> FieldLabelEnv
algTcFields = FieldLabelEnv
fields } <- TyConDetails
details = FieldLabelEnv
fields
| Bool
otherwise = FieldLabelEnv
forall a. DFastStringEnv a
emptyDFsEnv
lookupTyConFieldLabel :: FieldLabelString -> TyCon -> Maybe FieldLabel
lookupTyConFieldLabel :: FieldLabelString -> TyCon -> Maybe FieldLabel
lookupTyConFieldLabel FieldLabelString
lbl TyCon
tc = FieldLabelEnv -> FastString -> Maybe FieldLabel
forall a. DFastStringEnv a -> FastString -> Maybe a
lookupDFsEnv (TyCon -> FieldLabelEnv
tyConFieldLabelEnv TyCon
tc) (FieldLabelString -> FastString
field_label FieldLabelString
lbl)
fieldsOfAlgTcRhs :: AlgTyConRhs -> FieldLabelEnv
fieldsOfAlgTcRhs :: AlgTyConRhs -> FieldLabelEnv
fieldsOfAlgTcRhs AlgTyConRhs
rhs = [(FastString, FieldLabel)] -> FieldLabelEnv
forall a. [(FastString, a)] -> DFastStringEnv a
mkDFsEnv [ (FieldLabelString -> FastString
field_label (FieldLabelString -> FastString) -> FieldLabelString -> FastString
forall a b. (a -> b) -> a -> b
$ FieldLabel -> FieldLabelString
flLabel FieldLabel
fl, FieldLabel
fl)
| FieldLabel
fl <- [DataCon] -> [FieldLabel]
forall {t :: * -> *}. Foldable t => t DataCon -> [FieldLabel]
dataConsFields (AlgTyConRhs -> [DataCon]
visibleDataCons AlgTyConRhs
rhs) ]
where
dataConsFields :: t DataCon -> [FieldLabel]
dataConsFields t DataCon
dcs = (DataCon -> [FieldLabel]) -> t DataCon -> [FieldLabel]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DataCon -> [FieldLabel]
dataConFieldLabels t DataCon
dcs
mkTyCon :: Name -> [TyConBinder] -> Kind -> [Role] -> TyConDetails -> TyCon
mkTyCon :: Name -> [TyConBinder] -> Kind -> [Role] -> TyConDetails -> TyCon
mkTyCon Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles TyConDetails
details
= TyCon
tc
where
tc :: TyCon
tc = TyCon { tyConName :: Name
tyConName = Name
name
, tyConUnique :: Unique
tyConUnique = Name -> Unique
nameUnique Name
name
, tyConBinders :: [TyConBinder]
tyConBinders = [TyConBinder]
binders
, tyConResKind :: Kind
tyConResKind = Kind
res_kind
, tyConRoles :: [Role]
tyConRoles = [Role]
roles
, tyConDetails :: TyConDetails
tyConDetails = TyConDetails
details
, tyConKind :: Kind
tyConKind = [TyConBinder] -> Kind -> Kind
mkTyConKind [TyConBinder]
binders Kind
res_kind
, tyConArity :: Int
tyConArity = [TyConBinder] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TyConBinder]
binders
, tyConNullaryTy :: Kind
tyConNullaryTy = TyCon -> Kind
mkNakedTyConTy TyCon
tc
, tyConHasClosedResKind :: Bool
tyConHasClosedResKind = Kind -> Bool
noFreeVarsOfType Kind
res_kind
, tyConTyVars :: [TyVar]
tyConTyVars = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders }
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
= Name -> [TyConBinder] -> Kind -> [Role] -> TyConDetails -> TyCon
mkTyCon Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles (TyConDetails -> TyCon) -> TyConDetails -> TyCon
forall a b. (a -> b) -> a -> b
$
AlgTyCon { 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
, algTcFlavour :: AlgTyConFlav
algTcFlavour = Bool -> SDoc -> AlgTyConFlav -> AlgTyConFlav
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> AlgTyConFlav -> Bool
okParent Name
name AlgTyConFlav
parent)
(Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ AlgTyConFlav -> SDoc
forall a. Outputable a => a -> SDoc
ppr AlgTyConFlav
parent) AlgTyConFlav
parent
, algTcGadtSyntax :: Bool
algTcGadtSyntax = Bool
gadt_syn }
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 Maybe CType
forall a. Maybe a
Nothing [] AlgTyConRhs
rhs
(Class -> Name -> AlgTyConFlav
ClassTyCon Class
clas Name
tc_rep_name)
Bool
False
mkTupleTyCon :: Name
-> [TyConBinder]
-> Kind
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon :: Name
-> [TyConBinder]
-> Kind
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon Name
name [TyConBinder]
binders Kind
res_kind DataCon
con TupleSort
sort AlgTyConFlav
parent
= Name -> [TyConBinder] -> Kind -> [Role] -> TyConDetails -> TyCon
mkTyCon Name
name [TyConBinder]
binders Kind
res_kind ([TyConBinder] -> Role -> [Role]
constRoles [TyConBinder]
binders Role
Representational) (TyConDetails -> TyCon) -> TyConDetails -> TyCon
forall a b. (a -> b) -> a -> b
$
AlgTyCon { tyConCType :: Maybe CType
tyConCType = Maybe CType
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 = FieldLabelEnv
forall a. DFastStringEnv a
emptyDFsEnv
, algTcFlavour :: AlgTyConFlav
algTcFlavour = AlgTyConFlav
parent }
constRoles :: [TyConBinder] -> Role -> [Role]
constRoles :: [TyConBinder] -> Role -> [Role]
constRoles [TyConBinder]
bndrs Role
role = [Role
role | TyConBinder
_ <- [TyConBinder]
bndrs]
mkSumTyCon :: Name
-> [TyConBinder]
-> Kind
-> [DataCon]
-> AlgTyConFlav
-> TyCon
mkSumTyCon :: Name -> [TyConBinder] -> Kind -> [DataCon] -> AlgTyConFlav -> TyCon
mkSumTyCon Name
name [TyConBinder]
binders Kind
res_kind [DataCon]
cons AlgTyConFlav
parent
= Name -> [TyConBinder] -> Kind -> [Role] -> TyConDetails -> TyCon
mkTyCon Name
name [TyConBinder]
binders Kind
res_kind ([TyConBinder] -> Role -> [Role]
constRoles [TyConBinder]
binders Role
Representational) (TyConDetails -> TyCon) -> TyConDetails -> TyCon
forall a b. (a -> b) -> a -> b
$
AlgTyCon { tyConCType :: Maybe CType
tyConCType = Maybe CType
forall a. Maybe a
Nothing
, algTcGadtSyntax :: Bool
algTcGadtSyntax = Bool
False
, algTcStupidTheta :: [Kind]
algTcStupidTheta = []
, algTcRhs :: AlgTyConRhs
algTcRhs = [DataCon] -> AlgTyConRhs
mkSumTyConRhs [DataCon]
cons
, algTcFields :: FieldLabelEnv
algTcFields = FieldLabelEnv
forall a. DFastStringEnv a
emptyDFsEnv
, algTcFlavour :: AlgTyConFlav
algTcFlavour = AlgTyConFlav
parent }
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
= Name -> [TyConBinder] -> Kind -> [Role] -> TyConDetails -> TyCon
mkTyCon Name
name [TyConBinder]
binders Kind
res_kind ([TyConBinder] -> Role -> [Role]
constRoles [TyConBinder]
binders Role
Nominal) (TyConDetails -> TyCon) -> TyConDetails -> TyCon
forall a b. (a -> b) -> a -> b
$
TcTyCon { tctc_scoped_tvs :: [(Name, TyVar)]
tctc_scoped_tvs = [(Name, TyVar)]
scoped_tvs
, tctc_is_poly :: Bool
tctc_is_poly = Bool
poly
, tctc_flavour :: TyConFlavour
tctc_flavour = TyConFlavour
flav }
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] -> TyConDetails -> TyCon
mkTyCon Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles (TyConDetails -> TyCon) -> TyConDetails -> TyCon
forall a b. (a -> b) -> a -> b
$
PrimTyCon { primRepName :: Name
primRepName = Name -> Name
mkPrelTyConRepName Name
name }
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
= Name -> [TyConBinder] -> Kind -> [Role] -> TyConDetails -> TyCon
mkTyCon Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles (TyConDetails -> TyCon) -> TyConDetails -> TyCon
forall a b. (a -> b) -> a -> b
$
SynonymTyCon { synTcRhs :: Kind
synTcRhs = Kind
rhs
, synIsTau :: Bool
synIsTau = Bool
is_tau
, synIsFamFree :: Bool
synIsFamFree = Bool
is_fam_free
, synIsForgetful :: Bool
synIsForgetful = Bool
is_forgetful }
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
= Name -> [TyConBinder] -> Kind -> [Role] -> TyConDetails -> TyCon
mkTyCon Name
name [TyConBinder]
binders Kind
res_kind ([TyConBinder] -> Role -> [Role]
constRoles [TyConBinder]
binders Role
Nominal) (TyConDetails -> TyCon) -> TyConDetails -> TyCon
forall a b. (a -> b) -> a -> b
$
FamilyTyCon { famTcResVar :: Maybe Name
famTcResVar = Maybe Name
resVar
, famTcFlav :: FamTyConFlav
famTcFlav = FamTyConFlav
flav
, famTcParent :: Maybe TyCon
famTcParent = Class -> TyCon
classTyCon (Class -> TyCon) -> Maybe Class -> Maybe TyCon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Class
parent
, famTcInj :: Injectivity
famTcInj = Injectivity
inj }
mkPromotedDataCon :: DataCon -> Name -> TyConRepName
-> [TyConPiTyBinder] -> Kind -> [Role]
-> PromDataConInfo -> TyCon
mkPromotedDataCon :: DataCon
-> Name
-> Name
-> [TyConBinder]
-> Kind
-> [Role]
-> PromDataConInfo
-> TyCon
mkPromotedDataCon DataCon
con Name
name Name
rep_name [TyConBinder]
binders Kind
res_kind [Role]
roles PromDataConInfo
rep_info
= Name -> [TyConBinder] -> Kind -> [Role] -> TyConDetails -> TyCon
mkTyCon Name
name [TyConBinder]
binders Kind
res_kind [Role]
roles (TyConDetails -> TyCon) -> TyConDetails -> TyCon
forall a b. (a -> b) -> a -> b
$
PromotedDataCon { dataCon :: DataCon
dataCon = DataCon
con
, tcRepName :: Name
tcRepName = Name
rep_name
, promDcInfo :: PromDataConInfo
promDcInfo = PromDataConInfo
rep_info }
isAbstractTyCon :: TyCon -> Bool
isAbstractTyCon :: TyCon -> Bool
isAbstractTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AbstractTyCon {} } <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
isPrimTyCon :: TyCon -> Bool
isPrimTyCon :: TyCon -> Bool
isPrimTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| PrimTyCon {} <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
isAlgTyCon :: TyCon -> Bool
isAlgTyCon :: TyCon -> Bool
isAlgTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {} <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
isVanillaAlgTyCon :: TyCon -> Bool
isVanillaAlgTyCon :: TyCon -> Bool
isVanillaAlgTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcFlavour :: TyConDetails -> AlgTyConFlav
algTcFlavour = VanillaAlgTyCon Name
_ } <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
isDataTyCon :: TyCon -> Bool
isDataTyCon :: TyCon -> Bool
isDataTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs} <- TyConDetails
details
= 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 { is_type_data :: AlgTyConRhs -> Bool
is_type_data = Bool
type_data } -> Bool -> Bool
not Bool
type_data
NewTyCon {} -> Bool
False
AbstractTyCon {} -> Bool
False
isDataTyCon TyCon
_ = Bool
False
isTypeDataTyCon :: TyCon -> Bool
isTypeDataTyCon :: TyCon -> Bool
isTypeDataTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = DataTyCon {is_type_data :: AlgTyConRhs -> Bool
is_type_data = Bool
type_data }} <- TyConDetails
details
= Bool
type_data
| Bool
otherwise = Bool
False
isInjectiveTyCon :: TyCon -> Role -> Bool
isInjectiveTyCon :: TyCon -> Role -> Bool
isInjectiveTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details }) Role
role
= TyConDetails -> Role -> Bool
go TyConDetails
details Role
role
where
go :: TyConDetails -> Role -> Bool
go TyConDetails
_ Role
Phantom = Bool
True
go (AlgTyCon {}) Role
Nominal = Bool
True
go (AlgTyCon {algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs}) Role
Representational
= AlgTyConRhs -> Bool
isGenInjAlgRhs AlgTyConRhs
rhs
go (SynonymTyCon {}) Role
_ = Bool
False
go (FamilyTyCon { famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = DataFamilyTyCon Name
_ })
Role
Nominal = Bool
True
go (FamilyTyCon { famTcInj :: TyConDetails -> Injectivity
famTcInj = Injective [Bool]
inj }) Role
Nominal = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
inj
go (FamilyTyCon {}) Role
_ = Bool
False
go (PrimTyCon {}) Role
_ = Bool
True
go (PromotedDataCon {}) Role
_ = Bool
True
go (TcTyCon {}) Role
_ = Bool
True
isGenerativeTyCon :: TyCon -> Role -> Bool
isGenerativeTyCon :: TyCon -> Role -> Bool
isGenerativeTyCon tc :: TyCon
tc@(TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details }) Role
role
= Role -> TyConDetails -> Bool
go Role
role TyConDetails
details
where
go :: Role -> TyConDetails -> Bool
go Role
Nominal (FamilyTyCon { famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = DataFamilyTyCon Name
_ }) = Bool
True
go Role
_ (FamilyTyCon {}) = Bool
False
go Role
r TyConDetails
_ = 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 (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = NewTyCon {}} <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, CoAxiom Unbranched)
unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Kind, CoAxiom Unbranched)
unwrapNewTyCon_maybe (TyCon { tyConTyVars :: TyCon -> [TyVar]
tyConTyVars = [TyVar]
tvs, tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = NewTyCon { nt_co :: AlgTyConRhs -> CoAxiom Unbranched
nt_co = CoAxiom Unbranched
co, nt_rhs :: AlgTyConRhs -> Kind
nt_rhs = Kind
rhs }} <- TyConDetails
details
= ([TyVar], Kind, CoAxiom Unbranched)
-> Maybe ([TyVar], Kind, CoAxiom Unbranched)
forall a. a -> Maybe a
Just ([TyVar]
tvs, Kind
rhs, CoAxiom Unbranched
co)
| Bool
otherwise = Maybe ([TyVar], Kind, CoAxiom Unbranched)
forall a. Maybe a
Nothing
unwrapNewTyConEtad_maybe :: TyCon -> Maybe ([TyVar], Type, CoAxiom Unbranched)
unwrapNewTyConEtad_maybe :: TyCon -> Maybe ([TyVar], Kind, CoAxiom Unbranched)
unwrapNewTyConEtad_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> 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) }} <- TyConDetails
details
= ([TyVar], Kind, CoAxiom Unbranched)
-> Maybe ([TyVar], Kind, CoAxiom Unbranched)
forall a. a -> Maybe a
Just ([TyVar]
tvs, Kind
rhs, CoAxiom Unbranched
co)
| Bool
otherwise = Maybe ([TyVar], Kind, CoAxiom Unbranched)
forall a. Maybe a
Nothing
{-# INLINE isTypeSynonymTyCon #-}
isTypeSynonymTyCon :: TyCon -> Bool
isTypeSynonymTyCon :: TyCon -> Bool
isTypeSynonymTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| SynonymTyCon {} <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
isTauTyCon :: TyCon -> Bool
isTauTyCon :: TyCon -> Bool
isTauTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| SynonymTyCon { synIsTau :: TyConDetails -> Bool
synIsTau = Bool
is_tau } <- TyConDetails
details = Bool
is_tau
| Bool
otherwise = Bool
True
isFamFreeTyCon :: TyCon -> Bool
isFamFreeTyCon :: TyCon -> Bool
isFamFreeTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| SynonymTyCon { synIsFamFree :: TyConDetails -> Bool
synIsFamFree = Bool
fam_free } <- TyConDetails
details = Bool
fam_free
| FamilyTyCon { famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = FamTyConFlav
flav } <- TyConDetails
details = FamTyConFlav -> Bool
isDataFamFlav FamTyConFlav
flav
| Bool
otherwise = Bool
True
isForgetfulSynTyCon :: TyCon -> Bool
isForgetfulSynTyCon :: TyCon -> Bool
isForgetfulSynTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| SynonymTyCon { synIsForgetful :: TyConDetails -> Bool
synIsForgetful = Bool
forget } <- TyConDetails
details = Bool
forget
| Bool
otherwise = Bool
False
tyConMustBeSaturated :: TyCon -> Bool
tyConMustBeSaturated :: TyCon -> Bool
tyConMustBeSaturated = TyConFlavour -> Bool
tcFlavourMustBeSaturated (TyConFlavour -> Bool) -> (TyCon -> TyConFlavour) -> TyCon -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> TyConFlavour
tyConFlavour
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcGadtSyntax :: TyConDetails -> Bool
algTcGadtSyntax = Bool
res } <- TyConDetails
details = Bool
res
| Bool
otherwise = Bool
False
isEnumerationTyCon :: TyCon -> Bool
isEnumerationTyCon :: TyCon -> Bool
isEnumerationTyCon (TyCon { tyConArity :: TyCon -> Int
tyConArity = Int
arity, tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs } <- TyConDetails
details
= case AlgTyConRhs
rhs of
DataTyCon { is_enum :: AlgTyConRhs -> Bool
is_enum = Bool
res } -> Bool
res
TupleTyCon {} -> Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
AlgTyConRhs
_ -> Bool
False
| Bool
otherwise = Bool
False
isFamilyTyCon :: TyCon -> Bool
isFamilyTyCon :: TyCon -> Bool
isFamilyTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| FamilyTyCon {} <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
isOpenFamilyTyCon :: TyCon -> Bool
isOpenFamilyTyCon :: TyCon -> Bool
isOpenFamilyTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| FamilyTyCon {famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = FamTyConFlav
flav } <- TyConDetails
details
= case FamTyConFlav
flav of
FamTyConFlav
OpenSynFamilyTyCon -> Bool
True
DataFamilyTyCon {} -> Bool
True
FamTyConFlav
_ -> Bool
False
| Bool
otherwise = Bool
False
isTypeFamilyTyCon :: TyCon -> Bool
isTypeFamilyTyCon :: TyCon -> Bool
isTypeFamilyTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| FamilyTyCon { famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = FamTyConFlav
flav } <- TyConDetails
details = Bool -> Bool
not (FamTyConFlav -> Bool
isDataFamFlav FamTyConFlav
flav)
| Bool
otherwise = Bool
False
isDataFamilyTyCon :: TyCon -> Bool
isDataFamilyTyCon :: TyCon -> Bool
isDataFamilyTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| FamilyTyCon { famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = FamTyConFlav
flav } <- TyConDetails
details = FamTyConFlav -> Bool
isDataFamFlav FamTyConFlav
flav
| Bool
otherwise = Bool
False
isOpenTypeFamilyTyCon :: TyCon -> Bool
isOpenTypeFamilyTyCon :: TyCon -> Bool
isOpenTypeFamilyTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| FamilyTyCon {famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = FamTyConFlav
OpenSynFamilyTyCon } <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
isClosedSynFamilyTyConWithAxiom_maybe :: TyCon -> Maybe (CoAxiom Branched)
isClosedSynFamilyTyConWithAxiom_maybe :: TyCon -> Maybe (CoAxiom Branched)
isClosedSynFamilyTyConWithAxiom_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| FamilyTyCon {famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
mb} <- TyConDetails
details = Maybe (CoAxiom Branched)
mb
| Bool
otherwise = Maybe (CoAxiom Branched)
forall a. Maybe a
Nothing
isBuiltInSynFamTyCon_maybe :: TyCon -> Maybe BuiltInSynFamily
isBuiltInSynFamTyCon_maybe :: TyCon -> Maybe BuiltInSynFamily
isBuiltInSynFamTyCon_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| FamilyTyCon {famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = BuiltInSynFamTyCon BuiltInSynFamily
ops } <- TyConDetails
details = BuiltInSynFamily -> Maybe BuiltInSynFamily
forall a. a -> Maybe a
Just BuiltInSynFamily
ops
| Bool
otherwise = Maybe BuiltInSynFamily
forall a. Maybe a
Nothing
tyConFamilyResVar_maybe :: TyCon -> Maybe Name
tyConFamilyResVar_maybe :: TyCon -> Maybe Name
tyConFamilyResVar_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| FamilyTyCon {famTcResVar :: TyConDetails -> Maybe Name
famTcResVar = Maybe Name
res} <- TyConDetails
details = Maybe Name
res
| Bool
otherwise = Maybe Name
forall a. Maybe a
Nothing
tyConInjectivityInfo :: TyCon -> Injectivity
tyConInjectivityInfo :: TyCon -> Injectivity
tyConInjectivityInfo tc :: TyCon
tc@(TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| FamilyTyCon { famTcInj :: TyConDetails -> Injectivity
famTcInj = Injectivity
inj } <- TyConDetails
details
= Injectivity
inj
| TyCon -> Role -> Bool
isInjectiveTyCon TyCon
tc Role
Nominal
= [Bool] -> Injectivity
Injective (Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate (TyCon -> Int
tyConArity TyCon
tc) Bool
True)
| Bool
otherwise
= Injectivity
NotInjective
isDataFamFlav :: FamTyConFlav -> Bool
isDataFamFlav :: FamTyConFlav -> Bool
isDataFamFlav (DataFamilyTyCon {}) = Bool
True
isDataFamFlav FamTyConFlav
_ = Bool
False
isTyConAssoc :: TyCon -> Bool
isTyConAssoc :: TyCon -> Bool
isTyConAssoc = Maybe TyCon -> Bool
forall a. Maybe a -> Bool
isJust (Maybe TyCon -> Bool) -> (TyCon -> Maybe TyCon) -> TyCon -> Bool
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 (TyConFlavour -> Maybe TyCon)
-> (TyCon -> TyConFlavour) -> TyCon -> Maybe TyCon
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
_ = Maybe TyCon
forall a. Maybe a
Nothing
isTupleTyCon :: TyCon -> Bool
isTupleTyCon :: TyCon -> Bool
isTupleTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = TupleTyCon {} } <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
tyConTuple_maybe :: TyCon -> Maybe TupleSort
tyConTuple_maybe :: TyCon -> Maybe TupleSort
tyConTuple_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs } <- TyConDetails
details
, TupleTyCon { tup_sort :: AlgTyConRhs -> TupleSort
tup_sort = TupleSort
sort} <- AlgTyConRhs
rhs = TupleSort -> Maybe TupleSort
forall a. a -> Maybe a
Just TupleSort
sort
| Bool
otherwise = Maybe TupleSort
forall a. Maybe a
Nothing
isUnboxedTupleTyCon :: TyCon -> Bool
isUnboxedTupleTyCon :: TyCon -> Bool
isUnboxedTupleTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs } <- TyConDetails
details
, TupleTyCon { tup_sort :: AlgTyConRhs -> TupleSort
tup_sort = TupleSort
sort } <- AlgTyConRhs
rhs
= Bool -> Bool
not (Boxity -> Bool
isBoxed (TupleSort -> Boxity
tupleSortBoxity TupleSort
sort))
| Bool
otherwise = Bool
False
isBoxedTupleTyCon :: TyCon -> Bool
isBoxedTupleTyCon :: TyCon -> Bool
isBoxedTupleTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs } <- TyConDetails
details
, TupleTyCon { tup_sort :: AlgTyConRhs -> TupleSort
tup_sort = TupleSort
sort } <- AlgTyConRhs
rhs
= Boxity -> Bool
isBoxed (TupleSort -> Boxity
tupleSortBoxity TupleSort
sort)
| Bool
otherwise = Bool
False
isUnboxedSumTyCon :: TyCon -> Bool
isUnboxedSumTyCon :: TyCon -> Bool
isUnboxedSumTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs } <- TyConDetails
details
, SumTyCon {} <- AlgTyConRhs
rhs
= Bool
True
| Bool
otherwise = Bool
False
isLiftedAlgTyCon :: TyCon -> Bool
isLiftedAlgTyCon :: TyCon -> Bool
isLiftedAlgTyCon (TyCon { tyConResKind :: TyCon -> Kind
tyConResKind = Kind
res_kind, tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {} <- TyConDetails
details = Kind -> Bool
isLiftedTypeKind Kind
res_kind
| Bool
otherwise = Bool
False
isPromotedDataCon_maybe :: TyCon -> Maybe DataCon
isPromotedDataCon_maybe :: TyCon -> Maybe DataCon
isPromotedDataCon_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| PromotedDataCon { dataCon :: TyConDetails -> DataCon
dataCon = DataCon
dc } <- TyConDetails
details = DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
dc
| Bool
otherwise = Maybe DataCon
forall a. Maybe a
Nothing
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 (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| PromotedDataCon {} <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
isDataKindsPromotedDataCon :: TyCon -> Bool
isDataKindsPromotedDataCon :: TyCon -> Bool
isDataKindsPromotedDataCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| PromotedDataCon { dataCon :: TyConDetails -> DataCon
dataCon = DataCon
dc } <- TyConDetails
details
= Bool -> Bool
not (DataCon -> Bool
isTypeDataCon DataCon
dc)
| Bool
otherwise = Bool
False
isKindTyCon :: TyCon -> Bool
isKindTyCon :: TyCon -> Bool
isKindTyCon TyCon
tc = TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
tc Unique -> UniqSet Unique -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` UniqSet Unique
kindTyConKeys
kindTyConKeys :: UniqSet Unique
kindTyConKeys :: UniqSet Unique
kindTyConKeys = [UniqSet Unique] -> UniqSet Unique
forall a. [UniqSet a] -> UniqSet a
unionManyUniqSets
( [Unique] -> UniqSet Unique
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet [ Unique
liftedTypeKindTyConKey, Unique
liftedRepTyConKey, Unique
constraintKindTyConKey, Unique
tYPETyConKey ]
UniqSet Unique -> [UniqSet Unique] -> [UniqSet Unique]
forall a. a -> [a] -> [a]
: (TyCon -> UniqSet Unique) -> [TyCon] -> [UniqSet Unique]
forall a b. (a -> b) -> [a] -> [b]
map ([Unique] -> UniqSet Unique
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ([Unique] -> UniqSet Unique)
-> (TyCon -> [Unique]) -> TyCon -> UniqSet Unique
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 = TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
tc Unique -> [Unique] -> [Unique]
forall a. a -> [a] -> [a]
: (DataCon -> Unique) -> [DataCon] -> [Unique]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique (TyCon -> [DataCon]
tyConDataCons TyCon
tc)
isLiftedTypeKindTyConName :: Name -> Bool
isLiftedTypeKindTyConName :: Name -> Bool
isLiftedTypeKindTyConName = (Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
liftedTypeKindTyConKey)
isImplicitTyCon :: TyCon -> Bool
isImplicitTyCon :: TyCon -> Bool
isImplicitTyCon (TyCon { tyConName :: TyCon -> Name
tyConName = Name
name, tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details }) = TyConDetails -> Bool
go TyConDetails
details
where
go :: TyConDetails -> Bool
go (PrimTyCon {}) = Bool
True
go (PromotedDataCon {}) = Bool
True
go (SynonymTyCon {}) = Bool
False
go (TcTyCon {}) = Bool
False
go (FamilyTyCon { famTcParent :: TyConDetails -> Maybe TyCon
famTcParent = Maybe TyCon
parent }) = Maybe TyCon -> Bool
forall a. Maybe a -> Bool
isJust Maybe TyCon
parent
go (AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs })
| TupleTyCon {} <- AlgTyConRhs
rhs = Name -> Bool
isWiredInName Name
name
| SumTyCon {} <- AlgTyConRhs
rhs = Bool
True
| Bool
otherwise = Bool
False
tyConCType_maybe :: TyCon -> Maybe CType
tyConCType_maybe :: TyCon -> Maybe CType
tyConCType_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { tyConCType :: TyConDetails -> Maybe CType
tyConCType = Maybe CType
mb_ctype} <- TyConDetails
details = Maybe CType
mb_ctype
| Bool
otherwise = Maybe CType
forall a. Maybe a
Nothing
tcHasFixedRuntimeRep :: TyCon -> Bool
tcHasFixedRuntimeRep :: TyCon -> Bool
tcHasFixedRuntimeRep tc :: TyCon
tc@(TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs } <- TyConDetails
details
= case AlgTyConRhs
rhs of
AbstractTyCon {} -> Bool
False
DataTyCon { data_fixed_lev :: AlgTyConRhs -> Bool
data_fixed_lev = Bool
fixed_lev } -> Bool
fixed_lev
TupleTyCon { tup_sort :: AlgTyConRhs -> TupleSort
tup_sort = TupleSort
tuple_sort } -> Boxity -> Bool
isBoxed (TupleSort -> Boxity
tupleSortBoxity TupleSort
tuple_sort)
SumTyCon {} -> Bool
False
NewTyCon { nt_fixed_rep :: AlgTyConRhs -> Bool
nt_fixed_rep = Bool
fixed_rep } -> Bool
fixed_rep
| SynonymTyCon {} <- TyConDetails
details = Bool
False
| FamilyTyCon{} <- TyConDetails
details = Bool
False
| PrimTyCon{} <- TyConDetails
details = Bool
True
| TcTyCon{} <- TyConDetails
details = Bool
False
| PromotedDataCon{} <- TyConDetails
details = String -> SDoc -> Bool
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcHasFixedRuntimeRep datacon" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
isConcreteTyCon :: TyCon -> Bool
isConcreteTyCon :: TyCon -> Bool
isConcreteTyCon = TyConFlavour -> Bool
isConcreteTyConFlavour (TyConFlavour -> Bool) -> (TyCon -> TyConFlavour) -> TyCon -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> TyConFlavour
tyConFlavour
isConcreteTyConFlavour :: TyConFlavour -> Bool
isConcreteTyConFlavour :: TyConFlavour -> Bool
isConcreteTyConFlavour = \case
TyConFlavour
ClassFlavour -> Bool
True
TupleFlavour {} -> Bool
True
TyConFlavour
SumFlavour -> Bool
True
TyConFlavour
DataTypeFlavour -> Bool
True
TyConFlavour
NewtypeFlavour -> Bool
True
TyConFlavour
AbstractTypeFlavour -> Bool
True
DataFamilyFlavour {} -> Bool
False
OpenTypeFamilyFlavour {} -> Bool
False
TyConFlavour
ClosedTypeFamilyFlavour -> Bool
False
TyConFlavour
TypeSynonymFlavour -> Bool
False
TyConFlavour
BuiltInTypeFlavour -> Bool
True
TyConFlavour
PromotedDataConFlavour -> Bool
True
isTcTyCon :: TyCon -> Bool
isTcTyCon :: TyCon -> Bool
isTcTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| TcTyCon {} <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
setTcTyConKind :: TyCon -> Kind -> TyCon
setTcTyConKind :: TyCon -> Kind -> TyCon
setTcTyConKind TyCon
tc Kind
kind
= Bool -> TyCon -> TyCon
forall a. HasCallStack => Bool -> a -> a
assert (TyCon -> Bool
isMonoTcTyCon TyCon
tc) (TyCon -> TyCon) -> TyCon -> TyCon
forall a b. (a -> b) -> a -> b
$
let tc' :: TyCon
tc' = TyCon
tc { tyConKind = kind
, tyConNullaryTy = mkNakedTyConTy tc' }
in TyCon
tc'
isMonoTcTyCon :: TyCon -> Bool
isMonoTcTyCon :: TyCon -> Bool
isMonoTcTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| TcTyCon { tctc_is_poly :: TyConDetails -> Bool
tctc_is_poly = Bool
is_poly } <- TyConDetails
details = Bool -> Bool
not Bool
is_poly
| Bool
otherwise = Bool
False
tcTyConScopedTyVars :: TyCon -> [(Name,TcTyVar)]
tcTyConScopedTyVars :: TyCon -> [(Name, TyVar)]
tcTyConScopedTyVars tc :: TyCon
tc@(TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| TcTyCon { tctc_scoped_tvs :: TyConDetails -> [(Name, TyVar)]
tctc_scoped_tvs = [(Name, TyVar)]
scoped_tvs } <- TyConDetails
details = [(Name, TyVar)]
scoped_tvs
| Bool
otherwise = String -> SDoc -> [(Name, TyVar)]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcTyConScopedTyVars" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
data ExpandSynResult tyco
= NoExpansion
| ExpandsSyn [(TyVar,tyco)] Type [tyco]
expandSynTyCon_maybe
:: TyCon
-> [tyco]
-> ExpandSynResult tyco
expandSynTyCon_maybe :: forall tyco. TyCon -> [tyco] -> ExpandSynResult tyco
expandSynTyCon_maybe (TyCon { tyConTyVars :: TyCon -> [TyVar]
tyConTyVars = [TyVar]
tvs, tyConArity :: TyCon -> Int
tyConArity = Int
arity
, tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details }) [tyco]
tys
| SynonymTyCon { synTcRhs :: TyConDetails -> Kind
synTcRhs = Kind
rhs } <- TyConDetails
details
= if Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then [(TyVar, tyco)] -> Kind -> [tyco] -> ExpandSynResult tyco
forall tyco.
[(TyVar, tyco)] -> Kind -> [tyco] -> ExpandSynResult tyco
ExpandsSyn [] Kind
rhs [tyco]
tys
else case [tyco]
tys [tyco] -> Int -> Ordering
forall a. [a] -> Int -> Ordering
`listLengthCmp` Int
arity of
Ordering
GT -> [(TyVar, tyco)] -> Kind -> [tyco] -> ExpandSynResult tyco
forall tyco.
[(TyVar, tyco)] -> Kind -> [tyco] -> ExpandSynResult tyco
ExpandsSyn ([TyVar]
tvs [TyVar] -> [tyco] -> [(TyVar, tyco)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [tyco]
tys) Kind
rhs (Int -> [tyco] -> [tyco]
forall a. Int -> [a] -> [a]
drop Int
arity [tyco]
tys)
Ordering
EQ -> [(TyVar, tyco)] -> Kind -> [tyco] -> ExpandSynResult tyco
forall tyco.
[(TyVar, tyco)] -> Kind -> [tyco] -> ExpandSynResult tyco
ExpandsSyn ([TyVar]
tvs [TyVar] -> [tyco] -> [(TyVar, tyco)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [tyco]
tys) Kind
rhs []
Ordering
LT -> ExpandSynResult tyco
forall tyco. ExpandSynResult tyco
NoExpansion
| Bool
otherwise
= ExpandSynResult tyco
forall tyco. ExpandSynResult tyco
NoExpansion
isTyConWithSrcDataCons :: TyCon -> Bool
isTyConWithSrcDataCons :: TyCon -> Bool
isTyConWithSrcDataCons (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs, algTcFlavour :: TyConDetails -> AlgTyConFlav
algTcFlavour = AlgTyConFlav
parent } <- TyConDetails
details
, let isSrcParent :: Bool
isSrcParent = AlgTyConFlav -> Bool
isNoParent AlgTyConFlav
parent
= case AlgTyConRhs
rhs of
DataTyCon {} -> Bool
isSrcParent
NewTyCon {} -> Bool
isSrcParent
TupleTyCon {} -> Bool
isSrcParent
AlgTyConRhs
_ -> Bool
False
| FamilyTyCon { famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = DataFamilyTyCon {} } <- TyConDetails
details
= Bool
True
| Bool
otherwise = Bool
False
tyConDataCons :: TyCon -> [DataCon]
tyConDataCons :: TyCon -> [DataCon]
tyConDataCons TyCon
tycon = TyCon -> Maybe [DataCon]
tyConDataCons_maybe TyCon
tycon Maybe [DataCon] -> [DataCon] -> [DataCon]
forall a. Maybe a -> a -> a
`orElse` []
tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
tyConDataCons_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs} <- TyConDetails
details
= case AlgTyConRhs
rhs of
DataTyCon { data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon]
cons } -> [DataCon] -> Maybe [DataCon]
forall a. a -> Maybe a
Just [DataCon]
cons
NewTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
con } -> [DataCon] -> Maybe [DataCon]
forall a. a -> Maybe a
Just [DataCon
con]
TupleTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
con } -> [DataCon] -> Maybe [DataCon]
forall a. a -> Maybe a
Just [DataCon
con]
SumTyCon { data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon]
cons } -> [DataCon] -> Maybe [DataCon]
forall a. a -> Maybe a
Just [DataCon]
cons
AlgTyConRhs
_ -> Maybe [DataCon]
forall a. Maybe a
Nothing
tyConDataCons_maybe TyCon
_ = Maybe [DataCon]
forall a. Maybe a
Nothing
tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon
tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon
tyConSingleDataCon_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs } <- TyConDetails
details
= case AlgTyConRhs
rhs of
DataTyCon { data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon
c] } -> DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
c
TupleTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
c } -> DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
c
NewTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
c } -> DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
c
AlgTyConRhs
_ -> Maybe DataCon
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe DataCon
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 -> String -> SDoc -> DataCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConDataCon" (TyCon -> SDoc
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 = Maybe DataCon
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 = Maybe [DataCon]
forall a. Maybe a
Nothing
| Bool
otherwise = TyCon -> Maybe [DataCon]
tyConDataCons_maybe TyCon
tycon
tyConFamilySize :: TyCon -> Int
tyConFamilySize :: TyCon -> Int
tyConFamilySize tc :: TyCon
tc@(TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs } <- TyConDetails
details
= case AlgTyConRhs
rhs of
DataTyCon { data_cons_size :: AlgTyConRhs -> Int
data_cons_size = Int
size } -> Int
size
NewTyCon {} -> Int
1
TupleTyCon {} -> Int
1
SumTyCon { data_cons_size :: AlgTyConRhs -> Int
data_cons_size = Int
size } -> Int
size
AlgTyConRhs
_ -> String -> SDoc -> Int
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConFamilySize 1" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
| Bool
otherwise = String -> SDoc -> Int
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConFamilySize 2" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
algTyConRhs :: TyCon -> AlgTyConRhs
algTyConRhs :: TyCon -> AlgTyConRhs
algTyConRhs tc :: TyCon
tc@(TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs} <- TyConDetails
details = AlgTyConRhs
rhs
| Bool
otherwise = String -> SDoc -> AlgTyConRhs
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"algTyConRhs" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
newTyConRhs :: TyCon -> ([TyVar], Type)
newTyConRhs :: TyCon -> ([TyVar], Kind)
newTyConRhs tc :: TyCon
tc@(TyCon { tyConTyVars :: TyCon -> [TyVar]
tyConTyVars = [TyVar]
tvs, tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = NewTyCon { nt_rhs :: AlgTyConRhs -> Kind
nt_rhs = Kind
rhs }} <- TyConDetails
details
= ([TyVar]
tvs, Kind
rhs)
| Bool
otherwise
= String -> SDoc -> ([TyVar], Kind)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"newTyConRhs" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
newTyConEtadArity :: TyCon -> Int
newTyConEtadArity :: TyCon -> Int
newTyConEtadArity tc :: TyCon
tc@(TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = NewTyCon { nt_etad_rhs :: AlgTyConRhs -> ([TyVar], Kind)
nt_etad_rhs = ([TyVar], Kind)
tvs_rhs }} <- TyConDetails
details
= [TyVar] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (([TyVar], Kind) -> [TyVar]
forall a b. (a, b) -> a
fst ([TyVar], Kind)
tvs_rhs)
| Bool
otherwise
= String -> SDoc -> Int
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"newTyConEtadArity" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
newTyConEtadRhs :: TyCon -> ([TyVar], Type)
newTyConEtadRhs :: TyCon -> ([TyVar], Kind)
newTyConEtadRhs tc :: TyCon
tc@(TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = NewTyCon { nt_etad_rhs :: AlgTyConRhs -> ([TyVar], Kind)
nt_etad_rhs = ([TyVar], Kind)
tvs_rhs }} <- TyConDetails
details = ([TyVar], Kind)
tvs_rhs
| Bool
otherwise = String -> SDoc -> ([TyVar], Kind)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"newTyConEtadRhs" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
newTyConCo_maybe :: TyCon -> Maybe (CoAxiom Unbranched)
newTyConCo_maybe :: TyCon -> Maybe (CoAxiom Unbranched)
newTyConCo_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = NewTyCon { nt_co :: AlgTyConRhs -> CoAxiom Unbranched
nt_co = CoAxiom Unbranched
co }} <- TyConDetails
details = CoAxiom Unbranched -> Maybe (CoAxiom Unbranched)
forall a. a -> Maybe a
Just CoAxiom Unbranched
co
| Bool
otherwise = Maybe (CoAxiom Unbranched)
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 -> String -> SDoc -> CoAxiom Unbranched
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"newTyConCo" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
newTyConDataCon_maybe :: TyCon -> Maybe DataCon
newTyConDataCon_maybe :: TyCon -> Maybe DataCon
newTyConDataCon_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = NewTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
con }} <- TyConDetails
details = DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
con
| Bool
otherwise = Maybe DataCon
forall a. Maybe a
Nothing
tyConStupidTheta :: TyCon -> [PredType]
tyConStupidTheta :: TyCon -> [Kind]
tyConStupidTheta tc :: TyCon
tc@(TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcStupidTheta :: TyConDetails -> [Kind]
algTcStupidTheta = [Kind]
stupid} <- TyConDetails
details = [Kind]
stupid
| PrimTyCon {} <- TyConDetails
details = []
| Bool
otherwise = String -> SDoc -> [Kind]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConStupidTheta" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
synTyConDefn_maybe :: TyCon -> Maybe ([TyVar], Type)
synTyConDefn_maybe :: TyCon -> Maybe ([TyVar], Kind)
synTyConDefn_maybe (TyCon { tyConTyVars :: TyCon -> [TyVar]
tyConTyVars = [TyVar]
tyvars, tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| SynonymTyCon {synTcRhs :: TyConDetails -> Kind
synTcRhs = Kind
ty} <- TyConDetails
details
= ([TyVar], Kind) -> Maybe ([TyVar], Kind)
forall a. a -> Maybe a
Just ([TyVar]
tyvars, Kind
ty)
| Bool
otherwise
= Maybe ([TyVar], Kind)
forall a. Maybe a
Nothing
synTyConRhs_maybe :: TyCon -> Maybe Type
synTyConRhs_maybe :: TyCon -> Maybe Kind
synTyConRhs_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| SynonymTyCon {synTcRhs :: TyConDetails -> Kind
synTcRhs = Kind
rhs} <- TyConDetails
details = Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
rhs
| Bool
otherwise = Maybe Kind
forall a. Maybe a
Nothing
famTyConFlav_maybe :: TyCon -> Maybe FamTyConFlav
famTyConFlav_maybe :: TyCon -> Maybe FamTyConFlav
famTyConFlav_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| FamilyTyCon {famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = FamTyConFlav
flav} <- TyConDetails
details = FamTyConFlav -> Maybe FamTyConFlav
forall a. a -> Maybe a
Just FamTyConFlav
flav
| Bool
otherwise = Maybe FamTyConFlav
forall a. Maybe a
Nothing
isClassTyCon :: TyCon -> Bool
isClassTyCon :: TyCon -> Bool
isClassTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcFlavour :: TyConDetails -> AlgTyConFlav
algTcFlavour = ClassTyCon {}} <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
tyConClass_maybe :: TyCon -> Maybe Class
tyConClass_maybe :: TyCon -> Maybe Class
tyConClass_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcFlavour :: TyConDetails -> AlgTyConFlav
algTcFlavour = ClassTyCon Class
clas Name
_} <- TyConDetails
details = Class -> Maybe Class
forall a. a -> Maybe a
Just Class
clas
| Bool
otherwise = Maybe Class
forall a. Maybe a
Nothing
tyConATs :: TyCon -> [TyCon]
tyConATs :: TyCon -> [TyCon]
tyConATs (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcFlavour :: TyConDetails -> AlgTyConFlav
algTcFlavour = ClassTyCon Class
clas Name
_} <- TyConDetails
details = Class -> [TyCon]
classATs Class
clas
| Bool
otherwise = []
isFamInstTyCon :: TyCon -> Bool
isFamInstTyCon :: TyCon -> Bool
isFamInstTyCon (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcFlavour :: TyConDetails -> AlgTyConFlav
algTcFlavour = DataFamInstTyCon {} } <- TyConDetails
details = Bool
True
| Bool
otherwise = Bool
False
tyConFamInstSig_maybe :: TyCon -> Maybe (TyCon, [Type], CoAxiom Unbranched)
tyConFamInstSig_maybe :: TyCon -> Maybe (TyCon, [Kind], CoAxiom Unbranched)
tyConFamInstSig_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcFlavour :: TyConDetails -> AlgTyConFlav
algTcFlavour = DataFamInstTyCon CoAxiom Unbranched
ax TyCon
f [Kind]
ts } <- TyConDetails
details = (TyCon, [Kind], CoAxiom Unbranched)
-> Maybe (TyCon, [Kind], CoAxiom Unbranched)
forall a. a -> Maybe a
Just (TyCon
f, [Kind]
ts, CoAxiom Unbranched
ax)
| Bool
otherwise = Maybe (TyCon, [Kind], CoAxiom Unbranched)
forall a. Maybe a
Nothing
tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Kind])
tyConFamInst_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcFlavour :: TyConDetails -> AlgTyConFlav
algTcFlavour = DataFamInstTyCon CoAxiom Unbranched
_ TyCon
f [Kind]
ts } <- TyConDetails
details = (TyCon, [Kind]) -> Maybe (TyCon, [Kind])
forall a. a -> Maybe a
Just (TyCon
f, [Kind]
ts)
| Bool
otherwise = Maybe (TyCon, [Kind])
forall a. Maybe a
Nothing
tyConFamilyCoercion_maybe :: TyCon -> Maybe (CoAxiom Unbranched)
tyConFamilyCoercion_maybe :: TyCon -> Maybe (CoAxiom Unbranched)
tyConFamilyCoercion_maybe (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon {algTcFlavour :: TyConDetails -> AlgTyConFlav
algTcFlavour = DataFamInstTyCon CoAxiom Unbranched
ax TyCon
_ [Kind]
_ } <- TyConDetails
details = CoAxiom Unbranched -> Maybe (CoAxiom Unbranched)
forall a. a -> Maybe a
Just CoAxiom Unbranched
ax
| Bool
otherwise = Maybe (CoAxiom Unbranched)
forall a. Maybe a
Nothing
tyConPromDataConInfo :: TyCon -> PromDataConInfo
tyConPromDataConInfo :: TyCon -> PromDataConInfo
tyConPromDataConInfo (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| PromotedDataCon { promDcInfo :: TyConDetails -> PromDataConInfo
promDcInfo = PromDataConInfo
rri } <- TyConDetails
details = PromDataConInfo
rri
| Bool
otherwise = PromDataConInfo
NoPromInfo
mkTyConTagMap :: TyCon -> NameEnv ConTag
mkTyConTagMap :: TyCon -> NameEnv Int
mkTyConTagMap TyCon
tycon =
[(Name, Int)] -> NameEnv Int
forall a. [(Name, a)] -> NameEnv a
mkNameEnv ([(Name, Int)] -> NameEnv Int) -> [(Name, Int)] -> NameEnv Int
forall a b. (a -> b) -> a -> b
$ (DataCon -> Name) -> [DataCon] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> Name
forall a. NamedThing a => a -> Name
getName (TyCon -> [DataCon]
tyConDataCons TyCon
tycon) [Name] -> [Int] -> [(Name, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
fIRST_TAG..]
instance Eq TyCon where
TyCon
a == :: TyCon -> TyCon -> Bool
== TyCon
b = TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
a Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
b
TyCon
a /= :: TyCon -> TyCon -> Bool
/= TyCon
b = TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
a Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
/= TyCon -> Unique
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 doc. IsLine doc => doc -> doc -> doc
<> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> Name
tyConName TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
pp_tc
where
pp_tc :: SDoc
pp_tc = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
(Bool -> SDoc) -> SDoc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
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
forall doc. IsLine doc => String -> doc
text String
"[tc]"
else SDoc
forall doc. IsOutput doc => doc
empty
data TyConFlavour
= ClassFlavour
| TupleFlavour Boxity
| SumFlavour
| DataTypeFlavour
| NewtypeFlavour
| AbstractTypeFlavour
| DataFamilyFlavour (Maybe TyCon)
| OpenTypeFamilyFlavour (Maybe TyCon)
| ClosedTypeFamilyFlavour
| TypeSynonymFlavour
| BuiltInTypeFlavour
| PromotedDataConFlavour
deriving TyConFlavour -> TyConFlavour -> Bool
(TyConFlavour -> TyConFlavour -> Bool)
-> (TyConFlavour -> TyConFlavour -> Bool) -> Eq TyConFlavour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TyConFlavour -> TyConFlavour -> Bool
== :: TyConFlavour -> TyConFlavour -> Bool
$c/= :: TyConFlavour -> TyConFlavour -> Bool
/= :: TyConFlavour -> TyConFlavour -> Bool
Eq
instance Outputable TyConFlavour where
ppr :: TyConFlavour -> SDoc
ppr = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc)
-> (TyConFlavour -> String) -> TyConFlavour -> SDoc
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 (TyCon { tyConDetails :: TyCon -> TyConDetails
tyConDetails = TyConDetails
details })
| AlgTyCon { algTcFlavour :: TyConDetails -> AlgTyConFlav
algTcFlavour = AlgTyConFlav
parent, algTcRhs :: TyConDetails -> AlgTyConRhs
algTcRhs = AlgTyConRhs
rhs } <- TyConDetails
details
= case AlgTyConFlav
parent of
ClassTyCon {} -> TyConFlavour
ClassFlavour
AlgTyConFlav
_ -> 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
| FamilyTyCon { famTcFlav :: TyConDetails -> FamTyConFlav
famTcFlav = FamTyConFlav
flav, famTcParent :: TyConDetails -> Maybe TyCon
famTcParent = Maybe TyCon
parent } <- TyConDetails
details
= 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
| SynonymTyCon {} <- TyConDetails
details = TyConFlavour
TypeSynonymFlavour
| PrimTyCon {} <- TyConDetails
details = TyConFlavour
BuiltInTypeFlavour
| PromotedDataCon {} <- TyConDetails
details = TyConFlavour
PromotedDataConFlavour
| TcTyCon { tctc_flavour :: TyConDetails -> TyConFlavour
tctc_flavour = TyConFlavour
flav } <-TyConDetails
details = 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 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 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 =
(PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
let
name :: OccName
name = TyCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyCon
tc
ticked :: Bool
ticked = TyCon -> Bool
isDataKindsPromotedDataCon TyCon
tc Bool -> Bool -> Bool
&& PprStyle -> QueryPromotionTick
promTick PprStyle
sty (OccName -> PromotedItem
PromotedItemDataCon OccName
name)
in
if Bool
ticked
then Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\''
else SDoc
forall doc. IsOutput doc => doc
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
_ = String -> Constr -> c TyCon
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [Bool] -> IO ()
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 -> Injectivity -> IO Injectivity
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Injectivity
NotInjective
Word8
_ -> do { [Bool]
xs <- BinHandle -> IO [Bool]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; Injectivity -> IO Injectivity
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Bool] -> Injectivity
Injective [Bool]
xs) } }
tyConSkolem :: TyCon -> Bool
tyConSkolem :: TyCon -> Bool
tyConSkolem = Name -> Bool
isHoleName (Name -> Bool) -> (TyCon -> Name) -> TyCon -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Name
tyConName