{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Tc.Utils.TcType (
TcType, TcSigmaType, TcTypeFRR, TcSigmaTypeFRR,
TcRhoType, TcTauType, TcPredType, TcThetaType,
TcTyVar, TcTyVarSet, TcDTyVarSet, TcTyCoVarSet, TcDTyCoVarSet,
TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcInvisTVBinder, TcReqTVBinder,
TcTyCon, MonoTcTyCon, PolyTcTyCon, TcTyConBinder, KnotTied,
ExpType(..), InferResult(..),
ExpTypeFRR, ExpSigmaType, ExpSigmaTypeFRR,
ExpRhoType,
mkCheckExpType,
SyntaxOpType(..), synKnownType, mkSynFunTys,
TcLevel(..), topTcLevel, pushTcLevel, isTopTcLevel,
strictlyDeeperThan, deeperThanOrSame, sameDepthAs,
tcTypeLevel, tcTyVarLevel, maxTcLevel,
TcTyVarDetails(..), pprTcTyVarDetails, vanillaSkolemTvUnk,
MetaDetails(Flexi, Indirect), MetaInfo(..), skolemSkolInfo,
isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isMetaTyVarTy, isTyVarTy,
tcIsTcTyVar, isTyVarTyVar, isOverlappableTyVar, isTyConableTyVar,
ConcreteTvOrigin(..), isConcreteTyVar_maybe, isConcreteTyVar,
isConcreteTyVarTy, isConcreteTyVarTy_maybe,
isAmbiguousTyVar, isCycleBreakerTyVar, metaTyVarRef, metaTyVarInfo,
isFlexi, isIndirect, isRuntimeUnkSkol,
metaTyVarTcLevel, setMetaTyVarTcLevel, metaTyVarTcLevel_maybe,
isTouchableMetaTyVar, isPromotableMetaTyVar,
findDupTyVarTvs, mkTyVarNamePairs,
mkPhiTy, mkInfSigmaTy, mkSpecSigmaTy, mkSigmaTy,
mkTcAppTy, mkTcAppTys, mkTcCastTy,
getTyVar,
tcSplitForAllTyVarBinder_maybe,
tcSplitForAllTyVars, tcSplitForAllInvisTyVars, tcSplitSomeForAllTyVars,
tcSplitForAllReqTVBinders, tcSplitForAllInvisTVBinders,
tcSplitPiTys, tcSplitPiTy_maybe, tcSplitForAllTyVarBinders,
tcSplitPhiTy, tcSplitPredFunTy_maybe,
tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcFunResultTyN,
tcSplitFunTysN,
tcSplitTyConApp, tcSplitTyConApp_maybe,
tcTyConAppTyCon, tcTyConAppTyCon_maybe, tcTyConAppArgs,
tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, tcRepSplitAppTy_maybe,
tcRepGetNumAppTys,
tcGetCastedTyVar_maybe, tcGetTyVar_maybe, tcGetTyVar,
tcSplitSigmaTy, tcSplitNestedSigmaTys,
eqType, eqTypes, nonDetCmpType, nonDetCmpTypes, eqTypeX,
pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, tcEqTypeVis,
tcEqTyConApps,
isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy,
isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
isIntegerTy, isNaturalTy,
isBoolTy, isUnitTy, isCharTy,
isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,
isPredTy, isTyVarClassPred,
checkValidClsArgs, hasTyVarHead,
isRigidTy,
deNoteType,
orphNamesOfType, orphNamesOfCo,
orphNamesOfTypes, orphNamesOfCoCon,
getDFunTyKey, evVarPred,
ambigTkvsOfTy,
mkMinimalBySCs, transSuperClasses,
pickCapturedPreds,
immSuperClasses, boxEqPred,
isImprovementPred,
tcTyFamInsts, tcTyFamInstsAndVis, tcTyConAppTyFamInstsAndVis, isTyFamFree,
exactTyCoVarsOfType, exactTyCoVarsOfTypes,
anyRewritableTyVar, anyRewritableTyFamApp,
IllegalForeignTypeReason(..),
TypeCannotBeMarshaledReason(..),
isFFIArgumentTy,
isFFIImportResultTy,
isFFIExportResultTy,
isFFIExternalTy,
isFFIDynTy,
isFFIPrimArgumentTy,
isFFIPrimResultTy,
isFFILabelTy,
isFunPtrTy,
tcSplitIOType_maybe,
Kind, tcTypeKind,
liftedTypeKind,
constraintKind,
isLiftedTypeKind, isUnliftedTypeKind, classifiesTypeWithValues,
Type, PredType, ThetaType, TyCoBinder,
ArgFlag(..), AnonArgFlag(..),
mkForAllTy, mkForAllTys, mkInvisForAllTys, mkTyCoInvForAllTys,
mkSpecForAllTys, mkTyCoInvForAllTy,
mkInfForAllTy, mkInfForAllTys,
mkVisFunTy, mkVisFunTys, mkInvisFunTy, mkInvisFunTyMany,
mkVisFunTyMany, mkVisFunTysMany, mkInvisFunTysMany,
mkTyConApp, mkAppTy, mkAppTys,
mkTyConTy, mkTyVarTy, mkTyVarTys,
mkTyCoVarTy, mkTyCoVarTys,
isClassPred, isEqPrimPred, isIPLikePred, isEqPred, isEqPredClass,
mkClassPred,
tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy,
isRuntimeRepVar, isFixedRuntimeRepKind,
isVisibleBinder, isInvisibleBinder,
TCvSubst(..),
TvSubstEnv, emptyTCvSubst, mkEmptyTCvSubst,
zipTvSubst,
mkTvSubstPrs, notElemTCvSubst, unionTCvSubst,
getTvSubstEnv, setTvSubstEnv, getTCvInScope, extendTCvInScope,
extendTCvInScopeList, extendTCvInScopeSet, extendTvSubstAndInScope,
Type.lookupTyVar, Type.extendTCvSubst, Type.substTyVarBndr,
Type.extendTvSubst,
isInScope, mkTCvSubst, mkTvSubst, zipTyEnv, zipCoEnv,
Type.substTy, substTys, substScaledTys, substTyWith, substTyWithCoVars,
substTyAddInScope,
substTyUnchecked, substTysUnchecked, substScaledTyUnchecked,
substThetaUnchecked,
substTyWithUnchecked,
substCoUnchecked, substCoWithUnchecked,
substTheta,
isUnliftedType,
isUnboxedTupleType,
isPrimitiveType,
tcView, coreView,
tyCoVarsOfType, tyCoVarsOfTypes, closeOverKinds,
tyCoFVsOfType, tyCoFVsOfTypes,
tyCoVarsOfTypeDSet, tyCoVarsOfTypesDSet, closeOverKindsDSet,
tyCoVarsOfTypeList, tyCoVarsOfTypesList,
noFreeVarsOfType,
pprKind, pprParendKind, pprSigmaType,
pprType, pprParendType, pprTypeApp,
pprTheta, pprParendTheta, pprThetaArrowTy, pprClassPred,
pprTCvBndr, pprTCvBndrs,
TypeSize, sizeType, sizeTypes, scopedSort,
tcTyConVisibilities, isNextTyConArgVisible, isNextArgVisible
) where
import GHC.Prelude
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.Subst ( mkTvSubst, substTyWithCoVars )
import GHC.Core.TyCo.FVs
import GHC.Core.TyCo.Ppr
import GHC.Core.Class
import GHC.Types.Var
import GHC.Types.ForeignCall
import GHC.Types.Var.Set
import GHC.Core.Coercion
import GHC.Core.Type as Type
import GHC.Core.Predicate
import GHC.Types.RepType
import GHC.Core.TyCon
import {-# SOURCE #-} GHC.Tc.Types.Origin
( SkolemInfo, unkSkol
, FixedRuntimeRepOrigin, FixedRuntimeRepContext )
import GHC.Driver.Session
import GHC.Core.FVs
import GHC.Types.Name as Name
import GHC.Types.Name.Set
import GHC.Types.Var.Env
import GHC.Builtin.Names
import GHC.Builtin.Types ( coercibleClass, eqClass, heqClass, unitTyCon, unitTyConKey
, listTyCon, constraintKind )
import GHC.Types.Basic
import GHC.Utils.Misc
import GHC.Data.Maybe
import GHC.Data.List.SetOps ( getNth, findDupsEq )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Utils.Error( Validity'(..) )
import qualified GHC.LanguageExtensions as LangExt
import Data.IORef
import Data.List.NonEmpty( NonEmpty(..) )
import Data.List ( partition )
type TcCoVar = CoVar
type TcType = Type
type TcTyCoVar = Var
type TcTypeFRR = TcType
type TcTyVarBinder = TyVarBinder
type TcInvisTVBinder = InvisTVBinder
type TcReqTVBinder = ReqTVBinder
type TcTyCon = TyCon
type MonoTcTyCon = TcTyCon
type PolyTcTyCon = TcTyCon
type TcTyConBinder = TyConBinder
type TcPredType = PredType
type TcThetaType = ThetaType
type TcSigmaType = TcType
type TcSigmaTypeFRR = TcSigmaType
type TcRhoType = TcType
type TcTauType = TcType
type TcKind = Kind
type TcTyVarSet = TyVarSet
type TcTyCoVarSet = TyCoVarSet
type TcDTyVarSet = DTyVarSet
type TcDTyCoVarSet = DTyCoVarSet
data ExpType = Check TcType
| Infer !InferResult
data InferResult
= IR { InferResult -> Unique
ir_uniq :: Unique
, InferResult -> TcLevel
ir_lvl :: TcLevel
, InferResult -> Maybe FixedRuntimeRepContext
ir_frr :: Maybe FixedRuntimeRepContext
, InferResult -> IORef (Maybe TcType)
ir_ref :: IORef (Maybe TcType) }
type ExpSigmaType = ExpType
type ExpTypeFRR = ExpType
type ExpSigmaTypeFRR = ExpTypeFRR
type ExpRhoType = ExpType
instance Outputable ExpType where
ppr :: ExpType -> SDoc
ppr (Check TcType
ty) = String -> SDoc
text String
"Check" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty)
ppr (Infer InferResult
ir) = InferResult -> SDoc
forall a. Outputable a => a -> SDoc
ppr InferResult
ir
instance Outputable InferResult where
ppr :: InferResult -> SDoc
ppr (IR { ir_uniq :: InferResult -> Unique
ir_uniq = Unique
u, ir_lvl :: InferResult -> TcLevel
ir_lvl = TcLevel
lvl, ir_frr :: InferResult -> Maybe FixedRuntimeRepContext
ir_frr = Maybe FixedRuntimeRepContext
mb_frr })
= String -> SDoc
text String
"Infer" SDoc -> SDoc -> SDoc
<> SDoc
mb_frr_text SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (Unique -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unique
u SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> TcLevel -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcLevel
lvl)
where
mb_frr_text :: SDoc
mb_frr_text = case Maybe FixedRuntimeRepContext
mb_frr of
Just FixedRuntimeRepContext
_ -> String -> SDoc
text String
"FRR"
Maybe FixedRuntimeRepContext
Nothing -> SDoc
empty
mkCheckExpType :: TcType -> ExpType
mkCheckExpType :: TcType -> ExpType
mkCheckExpType = TcType -> ExpType
Check
data SyntaxOpType
= SynAny
| SynRho
| SynList
| SynFun SyntaxOpType SyntaxOpType
| SynType ExpType
infixr 0 `SynFun`
synKnownType :: TcType -> SyntaxOpType
synKnownType :: TcType -> SyntaxOpType
synKnownType = ExpType -> SyntaxOpType
SynType (ExpType -> SyntaxOpType)
-> (TcType -> ExpType) -> TcType -> SyntaxOpType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcType -> ExpType
mkCheckExpType
mkSynFunTys :: [SyntaxOpType] -> ExpType -> SyntaxOpType
mkSynFunTys :: [SyntaxOpType] -> ExpType -> SyntaxOpType
mkSynFunTys [SyntaxOpType]
arg_tys ExpType
res_ty = (SyntaxOpType -> SyntaxOpType -> SyntaxOpType)
-> SyntaxOpType -> [SyntaxOpType] -> SyntaxOpType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SyntaxOpType -> SyntaxOpType -> SyntaxOpType
SynFun (ExpType -> SyntaxOpType
SynType ExpType
res_ty) [SyntaxOpType]
arg_tys
data TcTyVarDetails
= SkolemTv
SkolemInfo
TcLevel
Bool
| RuntimeUnk
| MetaTv { TcTyVarDetails -> MetaInfo
mtv_info :: MetaInfo
, TcTyVarDetails -> IORef MetaDetails
mtv_ref :: IORef MetaDetails
, TcTyVarDetails -> TcLevel
mtv_tclvl :: TcLevel }
vanillaSkolemTvUnk :: HasCallStack => TcTyVarDetails
vanillaSkolemTvUnk :: TcTyVarDetails
vanillaSkolemTvUnk = SkolemInfo -> TcLevel -> Bool -> TcTyVarDetails
SkolemTv SkolemInfo
HasCallStack => SkolemInfo
unkSkol TcLevel
topTcLevel Bool
False
instance Outputable TcTyVarDetails where
ppr :: TcTyVarDetails -> SDoc
ppr = TcTyVarDetails -> SDoc
pprTcTyVarDetails
pprTcTyVarDetails :: TcTyVarDetails -> SDoc
pprTcTyVarDetails :: TcTyVarDetails -> SDoc
pprTcTyVarDetails (RuntimeUnk {}) = String -> SDoc
text String
"rt"
pprTcTyVarDetails (SkolemTv SkolemInfo
_sk TcLevel
lvl Bool
True) = String -> SDoc
text String
"ssk" SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<> TcLevel -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcLevel
lvl
pprTcTyVarDetails (SkolemTv SkolemInfo
_sk TcLevel
lvl Bool
False) = String -> SDoc
text String
"sk" SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<> TcLevel -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcLevel
lvl
pprTcTyVarDetails (MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
info, mtv_tclvl :: TcTyVarDetails -> TcLevel
mtv_tclvl = TcLevel
tclvl })
= MetaInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr MetaInfo
info SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<> TcLevel -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcLevel
tclvl
data MetaDetails
= Flexi
| Indirect TcType
data MetaInfo
= TauTv
| TyVarTv
| RuntimeUnkTv
| CycleBreakerTv
| ConcreteTv ConcreteTvOrigin
instance Outputable MetaDetails where
ppr :: MetaDetails -> SDoc
ppr MetaDetails
Flexi = String -> SDoc
text String
"Flexi"
ppr (Indirect TcType
ty) = String -> SDoc
text String
"Indirect" SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
instance Outputable MetaInfo where
ppr :: MetaInfo -> SDoc
ppr MetaInfo
TauTv = String -> SDoc
text String
"tau"
ppr MetaInfo
TyVarTv = String -> SDoc
text String
"tyv"
ppr MetaInfo
RuntimeUnkTv = String -> SDoc
text String
"rutv"
ppr MetaInfo
CycleBreakerTv = String -> SDoc
text String
"cbv"
ppr (ConcreteTv {}) = String -> SDoc
text String
"conc"
data ConcreteTvOrigin
= ConcreteFRR FixedRuntimeRepOrigin
newtype TcLevel = TcLevel Int deriving( TcLevel -> TcLevel -> Bool
(TcLevel -> TcLevel -> Bool)
-> (TcLevel -> TcLevel -> Bool) -> Eq TcLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TcLevel -> TcLevel -> Bool
$c/= :: TcLevel -> TcLevel -> Bool
== :: TcLevel -> TcLevel -> Bool
$c== :: TcLevel -> TcLevel -> Bool
Eq, Eq TcLevel
Eq TcLevel
-> (TcLevel -> TcLevel -> Ordering)
-> (TcLevel -> TcLevel -> Bool)
-> (TcLevel -> TcLevel -> Bool)
-> (TcLevel -> TcLevel -> Bool)
-> (TcLevel -> TcLevel -> Bool)
-> (TcLevel -> TcLevel -> TcLevel)
-> (TcLevel -> TcLevel -> TcLevel)
-> Ord TcLevel
TcLevel -> TcLevel -> Bool
TcLevel -> TcLevel -> Ordering
TcLevel -> TcLevel -> TcLevel
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
min :: TcLevel -> TcLevel -> TcLevel
$cmin :: TcLevel -> TcLevel -> TcLevel
max :: TcLevel -> TcLevel -> TcLevel
$cmax :: TcLevel -> TcLevel -> TcLevel
>= :: TcLevel -> TcLevel -> Bool
$c>= :: TcLevel -> TcLevel -> Bool
> :: TcLevel -> TcLevel -> Bool
$c> :: TcLevel -> TcLevel -> Bool
<= :: TcLevel -> TcLevel -> Bool
$c<= :: TcLevel -> TcLevel -> Bool
< :: TcLevel -> TcLevel -> Bool
$c< :: TcLevel -> TcLevel -> Bool
compare :: TcLevel -> TcLevel -> Ordering
$ccompare :: TcLevel -> TcLevel -> Ordering
$cp1Ord :: Eq TcLevel
Ord )
maxTcLevel :: TcLevel -> TcLevel -> TcLevel
maxTcLevel :: TcLevel -> TcLevel -> TcLevel
maxTcLevel (TcLevel Int
a) (TcLevel Int
b) = Int -> TcLevel
TcLevel (Int
a Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
b)
topTcLevel :: TcLevel
topTcLevel :: TcLevel
topTcLevel = Int -> TcLevel
TcLevel Int
0
isTopTcLevel :: TcLevel -> Bool
isTopTcLevel :: TcLevel -> Bool
isTopTcLevel (TcLevel Int
0) = Bool
True
isTopTcLevel TcLevel
_ = Bool
False
pushTcLevel :: TcLevel -> TcLevel
pushTcLevel :: TcLevel -> TcLevel
pushTcLevel (TcLevel Int
us) = Int -> TcLevel
TcLevel (Int
us Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
strictlyDeeperThan :: TcLevel -> TcLevel -> Bool
strictlyDeeperThan :: TcLevel -> TcLevel -> Bool
strictlyDeeperThan (TcLevel Int
tv_tclvl) (TcLevel Int
ctxt_tclvl)
= Int
tv_tclvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ctxt_tclvl
deeperThanOrSame :: TcLevel -> TcLevel -> Bool
deeperThanOrSame :: TcLevel -> TcLevel -> Bool
deeperThanOrSame (TcLevel Int
tv_tclvl) (TcLevel Int
ctxt_tclvl)
= Int
tv_tclvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ctxt_tclvl
sameDepthAs :: TcLevel -> TcLevel -> Bool
sameDepthAs :: TcLevel -> TcLevel -> Bool
sameDepthAs (TcLevel Int
ctxt_tclvl) (TcLevel Int
tv_tclvl)
= Int
ctxt_tclvl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
tv_tclvl
checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool
checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool
checkTcLevelInvariant (TcLevel Int
ctxt_tclvl) (TcLevel Int
tv_tclvl)
= Int
ctxt_tclvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
tv_tclvl
tcTyVarLevel :: TcTyVar -> TcLevel
tcTyVarLevel :: TcTyVar -> TcLevel
tcTyVarLevel TcTyVar
tv
= case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
MetaTv { mtv_tclvl :: TcTyVarDetails -> TcLevel
mtv_tclvl = TcLevel
tv_lvl } -> TcLevel
tv_lvl
SkolemTv SkolemInfo
_ TcLevel
tv_lvl Bool
_ -> TcLevel
tv_lvl
TcTyVarDetails
RuntimeUnk -> TcLevel
topTcLevel
tcTypeLevel :: TcType -> TcLevel
tcTypeLevel :: TcType -> TcLevel
tcTypeLevel TcType
ty
= (TcTyVar -> TcLevel -> TcLevel) -> TcLevel -> DVarSet -> TcLevel
forall a. (TcTyVar -> a -> a) -> a -> DVarSet -> a
nonDetStrictFoldDVarSet TcTyVar -> TcLevel -> TcLevel
add TcLevel
topTcLevel (TcType -> DVarSet
tyCoVarsOfTypeDSet TcType
ty)
where
add :: TcTyVar -> TcLevel -> TcLevel
add TcTyVar
v TcLevel
lvl
| TcTyVar -> Bool
isTcTyVar TcTyVar
v = TcLevel
lvl TcLevel -> TcLevel -> TcLevel
`maxTcLevel` TcTyVar -> TcLevel
tcTyVarLevel TcTyVar
v
| Bool
otherwise = TcLevel
lvl
instance Outputable TcLevel where
ppr :: TcLevel -> SDoc
ppr (TcLevel Int
us) = Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
us
tcTyFamInsts :: Type -> [(TyCon, [Type])]
tcTyFamInsts :: TcType -> [(TyCon, [TcType])]
tcTyFamInsts = ((Bool, TyCon, [TcType]) -> (TyCon, [TcType]))
-> [(Bool, TyCon, [TcType])] -> [(TyCon, [TcType])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Bool
_,TyCon
b,[TcType]
c) -> (TyCon
b,[TcType]
c)) ([(Bool, TyCon, [TcType])] -> [(TyCon, [TcType])])
-> (TcType -> [(Bool, TyCon, [TcType])])
-> TcType
-> [(TyCon, [TcType])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcType -> [(Bool, TyCon, [TcType])]
tcTyFamInstsAndVis
tcTyFamInstsAndVis :: Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVis :: TcType -> [(Bool, TyCon, [TcType])]
tcTyFamInstsAndVis = Bool -> TcType -> [(Bool, TyCon, [TcType])]
tcTyFamInstsAndVisX Bool
False
tcTyFamInstsAndVisX
:: Bool
-> Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVisX :: Bool -> TcType -> [(Bool, TyCon, [TcType])]
tcTyFamInstsAndVisX = Bool -> TcType -> [(Bool, TyCon, [TcType])]
go
where
go :: Bool -> TcType -> [(Bool, TyCon, [TcType])]
go Bool
is_invis_arg TcType
ty
| Just TcType
exp_ty <- TcType -> Maybe TcType
tcView TcType
ty = Bool -> TcType -> [(Bool, TyCon, [TcType])]
go Bool
is_invis_arg TcType
exp_ty
go Bool
_ (TyVarTy TcTyVar
_) = []
go Bool
is_invis_arg (TyConApp TyCon
tc [TcType]
tys)
| TyCon -> Bool
isTypeFamilyTyCon TyCon
tc
= [(Bool
is_invis_arg, TyCon
tc, Int -> [TcType] -> [TcType]
forall a. Int -> [a] -> [a]
take (TyCon -> Int
tyConArity TyCon
tc) [TcType]
tys)]
| Bool
otherwise
= Bool -> TyCon -> [TcType] -> [(Bool, TyCon, [TcType])]
tcTyConAppTyFamInstsAndVisX Bool
is_invis_arg TyCon
tc [TcType]
tys
go Bool
_ (LitTy {}) = []
go Bool
is_invis_arg (ForAllTy TyCoVarBinder
bndr TcType
ty) = Bool -> TcType -> [(Bool, TyCon, [TcType])]
go Bool
is_invis_arg (TyCoVarBinder -> TcType
forall argf. VarBndr TcTyVar argf -> TcType
binderType TyCoVarBinder
bndr)
[(Bool, TyCon, [TcType])]
-> [(Bool, TyCon, [TcType])] -> [(Bool, TyCon, [TcType])]
forall a. [a] -> [a] -> [a]
++ Bool -> TcType -> [(Bool, TyCon, [TcType])]
go Bool
is_invis_arg TcType
ty
go Bool
is_invis_arg (FunTy AnonArgFlag
_ TcType
w TcType
ty1 TcType
ty2) = Bool -> TcType -> [(Bool, TyCon, [TcType])]
go Bool
is_invis_arg TcType
w
[(Bool, TyCon, [TcType])]
-> [(Bool, TyCon, [TcType])] -> [(Bool, TyCon, [TcType])]
forall a. [a] -> [a] -> [a]
++ Bool -> TcType -> [(Bool, TyCon, [TcType])]
go Bool
is_invis_arg TcType
ty1
[(Bool, TyCon, [TcType])]
-> [(Bool, TyCon, [TcType])] -> [(Bool, TyCon, [TcType])]
forall a. [a] -> [a] -> [a]
++ Bool -> TcType -> [(Bool, TyCon, [TcType])]
go Bool
is_invis_arg TcType
ty2
go Bool
is_invis_arg ty :: TcType
ty@(AppTy TcType
_ TcType
_) =
let (TcType
ty_head, [TcType]
ty_args) = TcType -> (TcType, [TcType])
splitAppTys TcType
ty
ty_arg_flags :: [ArgFlag]
ty_arg_flags = TcType -> [TcType] -> [ArgFlag]
appTyArgFlags TcType
ty_head [TcType]
ty_args
in Bool -> TcType -> [(Bool, TyCon, [TcType])]
go Bool
is_invis_arg TcType
ty_head
[(Bool, TyCon, [TcType])]
-> [(Bool, TyCon, [TcType])] -> [(Bool, TyCon, [TcType])]
forall a. [a] -> [a] -> [a]
++ [[(Bool, TyCon, [TcType])]] -> [(Bool, TyCon, [TcType])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((ArgFlag -> TcType -> [(Bool, TyCon, [TcType])])
-> [ArgFlag] -> [TcType] -> [[(Bool, TyCon, [TcType])]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ArgFlag
flag -> Bool -> TcType -> [(Bool, TyCon, [TcType])]
go (ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
flag))
[ArgFlag]
ty_arg_flags [TcType]
ty_args)
go Bool
is_invis_arg (CastTy TcType
ty KindCoercion
_) = Bool -> TcType -> [(Bool, TyCon, [TcType])]
go Bool
is_invis_arg TcType
ty
go Bool
_ (CoercionTy KindCoercion
_) = []
tcTyConAppTyFamInstsAndVis :: TyCon -> [Type] -> [(Bool, TyCon, [Type])]
tcTyConAppTyFamInstsAndVis :: TyCon -> [TcType] -> [(Bool, TyCon, [TcType])]
tcTyConAppTyFamInstsAndVis = Bool -> TyCon -> [TcType] -> [(Bool, TyCon, [TcType])]
tcTyConAppTyFamInstsAndVisX Bool
False
tcTyConAppTyFamInstsAndVisX
:: Bool
-> TyCon -> [Type] -> [(Bool, TyCon, [Type])]
tcTyConAppTyFamInstsAndVisX :: Bool -> TyCon -> [TcType] -> [(Bool, TyCon, [TcType])]
tcTyConAppTyFamInstsAndVisX Bool
is_invis_arg TyCon
tc [TcType]
tys =
let ([TcType]
invis_tys, [TcType]
vis_tys) = TyCon -> [TcType] -> ([TcType], [TcType])
partitionInvisibleTypes TyCon
tc [TcType]
tys
in [[(Bool, TyCon, [TcType])]] -> [(Bool, TyCon, [TcType])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Bool, TyCon, [TcType])]] -> [(Bool, TyCon, [TcType])])
-> [[(Bool, TyCon, [TcType])]] -> [(Bool, TyCon, [TcType])]
forall a b. (a -> b) -> a -> b
$ (TcType -> [(Bool, TyCon, [TcType])])
-> [TcType] -> [[(Bool, TyCon, [TcType])]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> TcType -> [(Bool, TyCon, [TcType])]
tcTyFamInstsAndVisX Bool
True) [TcType]
invis_tys
[[(Bool, TyCon, [TcType])]]
-> [[(Bool, TyCon, [TcType])]] -> [[(Bool, TyCon, [TcType])]]
forall a. [a] -> [a] -> [a]
++ (TcType -> [(Bool, TyCon, [TcType])])
-> [TcType] -> [[(Bool, TyCon, [TcType])]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> TcType -> [(Bool, TyCon, [TcType])]
tcTyFamInstsAndVisX Bool
is_invis_arg) [TcType]
vis_tys
isTyFamFree :: Type -> Bool
isTyFamFree :: TcType -> Bool
isTyFamFree = [(TyCon, [TcType])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(TyCon, [TcType])] -> Bool)
-> (TcType -> [(TyCon, [TcType])]) -> TcType -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcType -> [(TyCon, [TcType])]
tcTyFamInsts
any_rewritable :: EqRel
-> (EqRel -> TcTyVar -> Bool)
-> (EqRel -> TyCon -> [TcType] -> Bool)
-> (TyCon -> Bool)
-> TcType -> Bool
{-# INLINE any_rewritable #-}
any_rewritable :: EqRel
-> (EqRel -> TcTyVar -> Bool)
-> (EqRel -> TyCon -> [TcType] -> Bool)
-> (TyCon -> Bool)
-> TcType
-> Bool
any_rewritable EqRel
role EqRel -> TcTyVar -> Bool
tv_pred EqRel -> TyCon -> [TcType] -> Bool
tc_pred TyCon -> Bool
should_expand
= EqRel -> VarSet -> TcType -> Bool
go EqRel
role VarSet
emptyVarSet
where
go_tv :: EqRel -> VarSet -> TcTyVar -> Bool
go_tv EqRel
rl VarSet
bvs TcTyVar
tv | TcTyVar
tv TcTyVar -> VarSet -> Bool
`elemVarSet` VarSet
bvs = Bool
False
| Bool
otherwise = EqRel -> TcTyVar -> Bool
tv_pred EqRel
rl TcTyVar
tv
go :: EqRel -> VarSet -> TcType -> Bool
go EqRel
rl VarSet
bvs ty :: TcType
ty@(TyConApp TyCon
tc [TcType]
tys)
| TyCon -> Bool
isTypeSynonymTyCon TyCon
tc
, TyCon -> Bool
should_expand TyCon
tc
, Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty
= EqRel -> VarSet -> TcType -> Bool
go EqRel
rl VarSet
bvs TcType
ty'
| EqRel -> TyCon -> [TcType] -> Bool
tc_pred EqRel
rl TyCon
tc [TcType]
tys
= Bool
True
| Bool
otherwise
= EqRel -> VarSet -> TyCon -> [TcType] -> Bool
go_tc EqRel
rl VarSet
bvs TyCon
tc [TcType]
tys
go EqRel
rl VarSet
bvs (TyVarTy TcTyVar
tv) = EqRel -> VarSet -> TcTyVar -> Bool
go_tv EqRel
rl VarSet
bvs TcTyVar
tv
go EqRel
_ VarSet
_ (LitTy {}) = Bool
False
go EqRel
rl VarSet
bvs (AppTy TcType
fun TcType
arg) = EqRel -> VarSet -> TcType -> Bool
go EqRel
rl VarSet
bvs TcType
fun Bool -> Bool -> Bool
|| EqRel -> VarSet -> TcType -> Bool
go EqRel
NomEq VarSet
bvs TcType
arg
go EqRel
rl VarSet
bvs (FunTy AnonArgFlag
_ TcType
w TcType
arg TcType
res) = EqRel -> VarSet -> TcType -> Bool
go EqRel
NomEq VarSet
bvs TcType
arg_rep Bool -> Bool -> Bool
|| EqRel -> VarSet -> TcType -> Bool
go EqRel
NomEq VarSet
bvs TcType
res_rep Bool -> Bool -> Bool
||
EqRel -> VarSet -> TcType -> Bool
go EqRel
rl VarSet
bvs TcType
arg Bool -> Bool -> Bool
|| EqRel -> VarSet -> TcType -> Bool
go EqRel
rl VarSet
bvs TcType
res Bool -> Bool -> Bool
|| EqRel -> VarSet -> TcType -> Bool
go EqRel
NomEq VarSet
bvs TcType
w
where arg_rep :: TcType
arg_rep = HasDebugCallStack => TcType -> TcType
TcType -> TcType
getRuntimeRep TcType
arg
res_rep :: TcType
res_rep = HasDebugCallStack => TcType -> TcType
TcType -> TcType
getRuntimeRep TcType
res
go EqRel
rl VarSet
bvs (ForAllTy TyCoVarBinder
tv TcType
ty) = EqRel -> VarSet -> TcType -> Bool
go EqRel
rl (VarSet
bvs VarSet -> TcTyVar -> VarSet
`extendVarSet` TyCoVarBinder -> TcTyVar
forall tv argf. VarBndr tv argf -> tv
binderVar TyCoVarBinder
tv) TcType
ty
go EqRel
rl VarSet
bvs (CastTy TcType
ty KindCoercion
_) = EqRel -> VarSet -> TcType -> Bool
go EqRel
rl VarSet
bvs TcType
ty
go EqRel
_ VarSet
_ (CoercionTy KindCoercion
_) = Bool
False
go_tc :: EqRel -> VarSet -> TyCon -> [TcType] -> Bool
go_tc EqRel
NomEq VarSet
bvs TyCon
_ [TcType]
tys = (TcType -> Bool) -> [TcType] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (EqRel -> VarSet -> TcType -> Bool
go EqRel
NomEq VarSet
bvs) [TcType]
tys
go_tc EqRel
ReprEq VarSet
bvs TyCon
tc [TcType]
tys = ((Role, TcType) -> Bool) -> [(Role, TcType)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (VarSet -> (Role, TcType) -> Bool
go_arg VarSet
bvs)
(TyCon -> [Role]
tyConRolesRepresentational TyCon
tc [Role] -> [TcType] -> [(Role, TcType)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [TcType]
tys)
go_arg :: VarSet -> (Role, TcType) -> Bool
go_arg VarSet
bvs (Role
Nominal, TcType
ty) = EqRel -> VarSet -> TcType -> Bool
go EqRel
NomEq VarSet
bvs TcType
ty
go_arg VarSet
bvs (Role
Representational, TcType
ty) = EqRel -> VarSet -> TcType -> Bool
go EqRel
ReprEq VarSet
bvs TcType
ty
go_arg VarSet
_ (Role
Phantom, TcType
_) = Bool
False
anyRewritableTyVar :: EqRel
-> (EqRel -> TcTyVar -> Bool)
-> TcType -> Bool
anyRewritableTyVar :: EqRel -> (EqRel -> TcTyVar -> Bool) -> TcType -> Bool
anyRewritableTyVar EqRel
role EqRel -> TcTyVar -> Bool
pred
= EqRel
-> (EqRel -> TcTyVar -> Bool)
-> (EqRel -> TyCon -> [TcType] -> Bool)
-> (TyCon -> Bool)
-> TcType
-> Bool
any_rewritable EqRel
role EqRel -> TcTyVar -> Bool
pred
(\ EqRel
_ TyCon
_ [TcType]
_ -> Bool
False)
(\ TyCon
_ -> Bool
False)
anyRewritableTyFamApp :: EqRel
-> (EqRel -> TyCon -> [TcType] -> Bool)
-> TcType -> Bool
anyRewritableTyFamApp :: EqRel -> (EqRel -> TyCon -> [TcType] -> Bool) -> TcType -> Bool
anyRewritableTyFamApp EqRel
role EqRel -> TyCon -> [TcType] -> Bool
check_tyconapp
= EqRel
-> (EqRel -> TcTyVar -> Bool)
-> (EqRel -> TyCon -> [TcType] -> Bool)
-> (TyCon -> Bool)
-> TcType
-> Bool
any_rewritable EqRel
role (\ EqRel
_ TcTyVar
_ -> Bool
False) EqRel -> TyCon -> [TcType] -> Bool
check_tyconapp (Bool -> Bool
not (Bool -> Bool) -> (TyCon -> Bool) -> TyCon -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Bool
isFamFreeTyCon)
exactTyCoVarsOfType :: Type -> TyCoVarSet
exactTyCoVarsOfTypes :: [Type] -> TyCoVarSet
exactTyCoVarsOfType :: TcType -> VarSet
exactTyCoVarsOfType TcType
ty = Endo VarSet -> VarSet
runTyCoVars (TcType -> Endo VarSet
exact_ty TcType
ty)
exactTyCoVarsOfTypes :: [TcType] -> VarSet
exactTyCoVarsOfTypes [TcType]
tys = Endo VarSet -> VarSet
runTyCoVars ([TcType] -> Endo VarSet
exact_tys [TcType]
tys)
exact_ty :: Type -> Endo TyCoVarSet
exact_tys :: [Type] -> Endo TyCoVarSet
(TcType -> Endo VarSet
exact_ty, [TcType] -> Endo VarSet
exact_tys, KindCoercion -> Endo VarSet
_, [KindCoercion] -> Endo VarSet
_) = TyCoFolder VarSet (Endo VarSet)
-> VarSet
-> (TcType -> Endo VarSet, [TcType] -> Endo VarSet,
KindCoercion -> Endo VarSet, [KindCoercion] -> Endo VarSet)
forall a env.
Monoid a =>
TyCoFolder env a
-> env
-> (TcType -> a, [TcType] -> a, KindCoercion -> a,
[KindCoercion] -> a)
foldTyCo TyCoFolder VarSet (Endo VarSet)
exactTcvFolder VarSet
emptyVarSet
exactTcvFolder :: TyCoFolder TyCoVarSet (Endo TyCoVarSet)
exactTcvFolder :: TyCoFolder VarSet (Endo VarSet)
exactTcvFolder = TyCoFolder VarSet (Endo VarSet)
deepTcvFolder { tcf_view :: TcType -> Maybe TcType
tcf_view = TcType -> Maybe TcType
tcView }
tcIsTcTyVar :: TcTyVar -> Bool
tcIsTcTyVar :: TcTyVar -> Bool
tcIsTcTyVar TcTyVar
tv = TcTyVar -> Bool
isTyVar TcTyVar
tv
isPromotableMetaTyVar :: TcTyVar -> Bool
isPromotableMetaTyVar :: TcTyVar -> Bool
isPromotableMetaTyVar TcTyVar
tv
| TcTyVar -> Bool
isTyVar TcTyVar
tv
, MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
info } <- TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv
= MetaInfo -> Bool
isTouchableInfo MetaInfo
info
| Bool
otherwise
= Bool
False
isTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool
isTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool
isTouchableMetaTyVar TcLevel
ctxt_tclvl TcTyVar
tv
| TcTyVar -> Bool
isTyVar TcTyVar
tv
, MetaTv { mtv_tclvl :: TcTyVarDetails -> TcLevel
mtv_tclvl = TcLevel
tv_tclvl, mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
info } <- TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv
, MetaInfo -> Bool
isTouchableInfo MetaInfo
info
= Bool -> SDoc -> Bool -> Bool
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (TcLevel -> TcLevel -> Bool
checkTcLevelInvariant TcLevel
ctxt_tclvl TcLevel
tv_tclvl)
(TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv SDoc -> SDoc -> SDoc
$$ TcLevel -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcLevel
tv_tclvl SDoc -> SDoc -> SDoc
$$ TcLevel -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcLevel
ctxt_tclvl) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
TcLevel
tv_tclvl TcLevel -> TcLevel -> Bool
`sameDepthAs` TcLevel
ctxt_tclvl
| Bool
otherwise = Bool
False
isImmutableTyVar :: TyVar -> Bool
isImmutableTyVar :: TcTyVar -> Bool
isImmutableTyVar TcTyVar
tv = TcTyVar -> Bool
isSkolemTyVar TcTyVar
tv
isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar,
isMetaTyVar, isAmbiguousTyVar, isCycleBreakerTyVar :: TcTyVar -> Bool
isTyConableTyVar :: TcTyVar -> Bool
isTyConableTyVar TcTyVar
tv
| TcTyVar -> Bool
isTyVar TcTyVar
tv
= case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
TyVarTv } -> Bool
False
TcTyVarDetails
_ -> Bool
True
| Bool
otherwise = Bool
True
isSkolemTyVar :: TcTyVar -> Bool
isSkolemTyVar TcTyVar
tv
= Bool -> SDoc -> Bool -> Bool
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (TcTyVar -> Bool
tcIsTcTyVar TcTyVar
tv) (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
MetaTv {} -> Bool
False
TcTyVarDetails
_other -> Bool
True
skolemSkolInfo :: TcTyVar -> SkolemInfo
skolemSkolInfo :: TcTyVar -> SkolemInfo
skolemSkolInfo TcTyVar
tv
= Bool -> SkolemInfo -> SkolemInfo
forall a. HasCallStack => Bool -> a -> a
assert (TcTyVar -> Bool
isSkolemTyVar TcTyVar
tv) (SkolemInfo -> SkolemInfo) -> SkolemInfo -> SkolemInfo
forall a b. (a -> b) -> a -> b
$
case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
SkolemTv SkolemInfo
skol_info TcLevel
_ Bool
_ -> SkolemInfo
skol_info
TcTyVarDetails
RuntimeUnk -> String -> SkolemInfo
forall a. String -> a
panic String
"RuntimeUnk"
MetaTv {} -> String -> SkolemInfo
forall a. String -> a
panic String
"skolemSkolInfo"
isOverlappableTyVar :: TcTyVar -> Bool
isOverlappableTyVar TcTyVar
tv
| TcTyVar -> Bool
isTyVar TcTyVar
tv
= case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
SkolemTv SkolemInfo
_ TcLevel
_ Bool
overlappable -> Bool
overlappable
TcTyVarDetails
_ -> Bool
False
| Bool
otherwise = Bool
False
isMetaTyVar :: TcTyVar -> Bool
isMetaTyVar TcTyVar
tv
| TcTyVar -> Bool
isTyVar TcTyVar
tv
= case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
MetaTv {} -> Bool
True
TcTyVarDetails
_ -> Bool
False
| Bool
otherwise = Bool
False
isAmbiguousTyVar :: TcTyVar -> Bool
isAmbiguousTyVar TcTyVar
tv
| TcTyVar -> Bool
isTyVar TcTyVar
tv
= case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
MetaTv {} -> Bool
True
RuntimeUnk {} -> Bool
True
TcTyVarDetails
_ -> Bool
False
| Bool
otherwise = Bool
False
isCycleBreakerTyVar :: TcTyVar -> Bool
isCycleBreakerTyVar TcTyVar
tv
| TcTyVar -> Bool
isTyVar TcTyVar
tv
, MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
CycleBreakerTv } <- TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv
= Bool
True
| Bool
otherwise
= Bool
False
isConcreteTyVar_maybe :: TcTyVar -> Maybe ConcreteTvOrigin
isConcreteTyVar_maybe :: TcTyVar -> Maybe ConcreteTvOrigin
isConcreteTyVar_maybe TcTyVar
tv
| TcTyVar -> Bool
isTcTyVar TcTyVar
tv
, MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = ConcreteTv ConcreteTvOrigin
conc_orig } <- TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv
= ConcreteTvOrigin -> Maybe ConcreteTvOrigin
forall a. a -> Maybe a
Just ConcreteTvOrigin
conc_orig
| Bool
otherwise
= Maybe ConcreteTvOrigin
forall a. Maybe a
Nothing
isConcreteTyVar :: TcTyVar -> Bool
isConcreteTyVar :: TcTyVar -> Bool
isConcreteTyVar = Maybe ConcreteTvOrigin -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ConcreteTvOrigin -> Bool)
-> (TcTyVar -> Maybe ConcreteTvOrigin) -> TcTyVar -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcTyVar -> Maybe ConcreteTvOrigin
isConcreteTyVar_maybe
isConcreteTyVarTy :: TcType -> Bool
isConcreteTyVarTy :: TcType -> Bool
isConcreteTyVarTy = Maybe (TcTyVar, ConcreteTvOrigin) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (TcTyVar, ConcreteTvOrigin) -> Bool)
-> (TcType -> Maybe (TcTyVar, ConcreteTvOrigin)) -> TcType -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcType -> Maybe (TcTyVar, ConcreteTvOrigin)
isConcreteTyVarTy_maybe
isConcreteTyVarTy_maybe :: TcType -> Maybe (TcTyVar, ConcreteTvOrigin)
isConcreteTyVarTy_maybe :: TcType -> Maybe (TcTyVar, ConcreteTvOrigin)
isConcreteTyVarTy_maybe (TyVarTy TcTyVar
tv) = (TcTyVar
tv, ) (ConcreteTvOrigin -> (TcTyVar, ConcreteTvOrigin))
-> Maybe ConcreteTvOrigin -> Maybe (TcTyVar, ConcreteTvOrigin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TcTyVar -> Maybe ConcreteTvOrigin
isConcreteTyVar_maybe TcTyVar
tv
isConcreteTyVarTy_maybe TcType
_ = Maybe (TcTyVar, ConcreteTvOrigin)
forall a. Maybe a
Nothing
isMetaTyVarTy :: TcType -> Bool
isMetaTyVarTy :: TcType -> Bool
isMetaTyVarTy (TyVarTy TcTyVar
tv) = TcTyVar -> Bool
isMetaTyVar TcTyVar
tv
isMetaTyVarTy TcType
_ = Bool
False
metaTyVarInfo :: TcTyVar -> MetaInfo
metaTyVarInfo :: TcTyVar -> MetaInfo
metaTyVarInfo TcTyVar
tv
= case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
info } -> MetaInfo
info
TcTyVarDetails
_ -> String -> SDoc -> MetaInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarInfo" (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv)
isTouchableInfo :: MetaInfo -> Bool
isTouchableInfo :: MetaInfo -> Bool
isTouchableInfo MetaInfo
info
| MetaInfo
CycleBreakerTv <- MetaInfo
info = Bool
False
| Bool
otherwise = Bool
True
metaTyVarTcLevel :: TcTyVar -> TcLevel
metaTyVarTcLevel :: TcTyVar -> TcLevel
metaTyVarTcLevel TcTyVar
tv
= case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
MetaTv { mtv_tclvl :: TcTyVarDetails -> TcLevel
mtv_tclvl = TcLevel
tclvl } -> TcLevel
tclvl
TcTyVarDetails
_ -> String -> SDoc -> TcLevel
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarTcLevel" (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv)
metaTyVarTcLevel_maybe :: TcTyVar -> Maybe TcLevel
metaTyVarTcLevel_maybe :: TcTyVar -> Maybe TcLevel
metaTyVarTcLevel_maybe TcTyVar
tv
= case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
MetaTv { mtv_tclvl :: TcTyVarDetails -> TcLevel
mtv_tclvl = TcLevel
tclvl } -> TcLevel -> Maybe TcLevel
forall a. a -> Maybe a
Just TcLevel
tclvl
TcTyVarDetails
_ -> Maybe TcLevel
forall a. Maybe a
Nothing
metaTyVarRef :: TyVar -> IORef MetaDetails
metaTyVarRef :: TcTyVar -> IORef MetaDetails
metaTyVarRef TcTyVar
tv
= case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
MetaTv { mtv_ref :: TcTyVarDetails -> IORef MetaDetails
mtv_ref = IORef MetaDetails
ref } -> IORef MetaDetails
ref
TcTyVarDetails
_ -> String -> SDoc -> IORef MetaDetails
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarRef" (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv)
setMetaTyVarTcLevel :: TcTyVar -> TcLevel -> TcTyVar
setMetaTyVarTcLevel :: TcTyVar -> TcLevel -> TcTyVar
setMetaTyVarTcLevel TcTyVar
tv TcLevel
tclvl
= case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
details :: TcTyVarDetails
details@(MetaTv {}) -> TcTyVar -> TcTyVarDetails -> TcTyVar
setTcTyVarDetails TcTyVar
tv (TcTyVarDetails
details { mtv_tclvl :: TcLevel
mtv_tclvl = TcLevel
tclvl })
TcTyVarDetails
_ -> String -> SDoc -> TcTyVar
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarTcLevel" (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv)
isTyVarTyVar :: Var -> Bool
isTyVarTyVar :: TcTyVar -> Bool
isTyVarTyVar TcTyVar
tv
= case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
TyVarTv } -> Bool
True
TcTyVarDetails
_ -> Bool
False
isFlexi, isIndirect :: MetaDetails -> Bool
isFlexi :: MetaDetails -> Bool
isFlexi MetaDetails
Flexi = Bool
True
isFlexi MetaDetails
_ = Bool
False
isIndirect :: MetaDetails -> Bool
isIndirect (Indirect TcType
_) = Bool
True
isIndirect MetaDetails
_ = Bool
False
isRuntimeUnkSkol :: TyVar -> Bool
isRuntimeUnkSkol :: TcTyVar -> Bool
isRuntimeUnkSkol TcTyVar
x
| TcTyVarDetails
RuntimeUnk <- TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
x = Bool
True
| Bool
otherwise = Bool
False
mkTyVarNamePairs :: [TyVar] -> [(Name,TyVar)]
mkTyVarNamePairs :: [TcTyVar] -> [(Name, TcTyVar)]
mkTyVarNamePairs [TcTyVar]
tvs = [(TcTyVar -> Name
tyVarName TcTyVar
tv, TcTyVar
tv) | TcTyVar
tv <- [TcTyVar]
tvs]
findDupTyVarTvs :: [(Name,TcTyVar)] -> [(Name,Name)]
findDupTyVarTvs :: [(Name, TcTyVar)] -> [(Name, Name)]
findDupTyVarTvs [(Name, TcTyVar)]
prs
= (NonEmpty (Name, TcTyVar) -> [(Name, Name)])
-> [NonEmpty (Name, TcTyVar)] -> [(Name, Name)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (Name, TcTyVar) -> [(Name, Name)]
forall b b. NonEmpty (b, b) -> [(b, b)]
mk_result_prs ([NonEmpty (Name, TcTyVar)] -> [(Name, Name)])
-> [NonEmpty (Name, TcTyVar)] -> [(Name, Name)]
forall a b. (a -> b) -> a -> b
$
((Name, TcTyVar) -> (Name, TcTyVar) -> Bool)
-> [(Name, TcTyVar)] -> [NonEmpty (Name, TcTyVar)]
forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
findDupsEq (Name, TcTyVar) -> (Name, TcTyVar) -> Bool
forall a a a. Eq a => (a, a) -> (a, a) -> Bool
eq_snd [(Name, TcTyVar)]
prs
where
eq_snd :: (a, a) -> (a, a) -> Bool
eq_snd (a
_,a
tv1) (a
_,a
tv2) = a
tv1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
tv2
mk_result_prs :: NonEmpty (b, b) -> [(b, b)]
mk_result_prs ((b
n1,b
_) :| [(b, b)]
xs) = ((b, b) -> (b, b)) -> [(b, b)] -> [(b, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(b
n2,b
_) -> (b
n1,b
n2)) [(b, b)]
xs
ambigTkvsOfTy :: TcType -> ([Var],[Var])
ambigTkvsOfTy :: TcType -> ([TcTyVar], [TcTyVar])
ambigTkvsOfTy TcType
ty
= (TcTyVar -> Bool) -> [TcTyVar] -> ([TcTyVar], [TcTyVar])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (TcTyVar -> VarSet -> Bool
`elemVarSet` VarSet
dep_tkv_set) [TcTyVar]
ambig_tkvs
where
tkvs :: [TcTyVar]
tkvs = TcType -> [TcTyVar]
tyCoVarsOfTypeList TcType
ty
ambig_tkvs :: [TcTyVar]
ambig_tkvs = (TcTyVar -> Bool) -> [TcTyVar] -> [TcTyVar]
forall a. (a -> Bool) -> [a] -> [a]
filter TcTyVar -> Bool
isAmbiguousTyVar [TcTyVar]
tkvs
dep_tkv_set :: VarSet
dep_tkv_set = [TcType] -> VarSet
tyCoVarsOfTypes ((TcTyVar -> TcType) -> [TcTyVar] -> [TcType]
forall a b. (a -> b) -> [a] -> [b]
map TcTyVar -> TcType
tyVarKind [TcTyVar]
tkvs)
mkSigmaTy :: [TyCoVarBinder] -> [PredType] -> Type -> Type
mkSigmaTy :: [TyCoVarBinder] -> [TcType] -> TcType -> TcType
mkSigmaTy [TyCoVarBinder]
bndrs [TcType]
theta TcType
tau = [TyCoVarBinder] -> TcType -> TcType
mkForAllTys [TyCoVarBinder]
bndrs ([TcType] -> TcType -> TcType
mkPhiTy [TcType]
theta TcType
tau)
mkInfSigmaTy :: [TyCoVar] -> [PredType] -> Type -> Type
mkInfSigmaTy :: [TcTyVar] -> [TcType] -> TcType -> TcType
mkInfSigmaTy [TcTyVar]
tyvars [TcType]
theta TcType
ty = [TyCoVarBinder] -> [TcType] -> TcType -> TcType
mkSigmaTy (ArgFlag -> [TcTyVar] -> [TyCoVarBinder]
forall vis. vis -> [TcTyVar] -> [VarBndr TcTyVar vis]
mkTyCoVarBinders ArgFlag
Inferred [TcTyVar]
tyvars) [TcType]
theta TcType
ty
mkSpecSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
mkSpecSigmaTy :: [TcTyVar] -> [TcType] -> TcType -> TcType
mkSpecSigmaTy [TcTyVar]
tyvars [TcType]
preds TcType
ty = [TyCoVarBinder] -> [TcType] -> TcType -> TcType
mkSigmaTy (ArgFlag -> [TcTyVar] -> [TyCoVarBinder]
forall vis. vis -> [TcTyVar] -> [VarBndr TcTyVar vis]
mkTyCoVarBinders ArgFlag
Specified [TcTyVar]
tyvars) [TcType]
preds TcType
ty
mkPhiTy :: [PredType] -> Type -> Type
mkPhiTy :: [TcType] -> TcType -> TcType
mkPhiTy = [TcType] -> TcType -> TcType
mkInvisFunTysMany
getDFunTyKey :: Type -> OccName
getDFunTyKey :: TcType -> OccName
getDFunTyKey TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
coreView TcType
ty = TcType -> OccName
getDFunTyKey TcType
ty'
getDFunTyKey (TyVarTy TcTyVar
tv) = TcTyVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName TcTyVar
tv
getDFunTyKey (TyConApp TyCon
tc [TcType]
_) = TyCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyCon
tc
getDFunTyKey (LitTy TyLit
x) = TyLit -> OccName
getDFunTyLitKey TyLit
x
getDFunTyKey (AppTy TcType
fun TcType
_) = TcType -> OccName
getDFunTyKey TcType
fun
getDFunTyKey (FunTy {}) = TyCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyCon
funTyCon
getDFunTyKey (ForAllTy TyCoVarBinder
_ TcType
t) = TcType -> OccName
getDFunTyKey TcType
t
getDFunTyKey (CastTy TcType
ty KindCoercion
_) = TcType -> OccName
getDFunTyKey TcType
ty
getDFunTyKey t :: TcType
t@(CoercionTy KindCoercion
_) = String -> SDoc -> OccName
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getDFunTyKey" (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t)
getDFunTyLitKey :: TyLit -> OccName
getDFunTyLitKey :: TyLit -> OccName
getDFunTyLitKey (NumTyLit Integer
n) = NameSpace -> String -> OccName
mkOccName NameSpace
Name.varName (Integer -> String
forall a. Show a => a -> String
show Integer
n)
getDFunTyLitKey (StrTyLit FastString
n) = NameSpace -> String -> OccName
mkOccName NameSpace
Name.varName (FastString -> String
forall a. Show a => a -> String
show FastString
n)
getDFunTyLitKey (CharTyLit Char
n) = NameSpace -> String -> OccName
mkOccName NameSpace
Name.varName (Char -> String
forall a. Show a => a -> String
show Char
n)
mkTcAppTys :: Type -> [Type] -> Type
mkTcAppTys :: TcType -> [TcType] -> TcType
mkTcAppTys = TcType -> [TcType] -> TcType
mkAppTys
mkTcAppTy :: Type -> Type -> Type
mkTcAppTy :: TcType -> TcType -> TcType
mkTcAppTy = TcType -> TcType -> TcType
mkAppTy
mkTcCastTy :: Type -> Coercion -> Type
mkTcCastTy :: TcType -> KindCoercion -> TcType
mkTcCastTy = TcType -> KindCoercion -> TcType
mkCastTy
tcSplitPiTys :: Type -> ([TyBinder], Type)
tcSplitPiTys :: TcType -> ([TyBinder], TcType)
tcSplitPiTys TcType
ty
= Bool -> ([TyBinder], TcType) -> ([TyBinder], TcType)
forall a. HasCallStack => Bool -> a -> a
assert ((TyBinder -> Bool) -> [TyBinder] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TyBinder -> Bool
isTyBinder (([TyBinder], TcType) -> [TyBinder]
forall a b. (a, b) -> a
fst ([TyBinder], TcType)
sty) ) ([TyBinder], TcType)
sty
where sty :: ([TyBinder], TcType)
sty = TcType -> ([TyBinder], TcType)
splitPiTys TcType
ty
tcSplitPiTy_maybe :: Type -> Maybe (TyBinder, Type)
tcSplitPiTy_maybe :: TcType -> Maybe (TyBinder, TcType)
tcSplitPiTy_maybe TcType
ty
= Bool -> Maybe (TyBinder, TcType) -> Maybe (TyBinder, TcType)
forall a. HasCallStack => Bool -> a -> a
assert (Maybe (TyBinder, TcType) -> Bool
forall b. Maybe (TyBinder, b) -> Bool
isMaybeTyBinder Maybe (TyBinder, TcType)
sty ) Maybe (TyBinder, TcType)
sty
where
sty :: Maybe (TyBinder, TcType)
sty = TcType -> Maybe (TyBinder, TcType)
splitPiTy_maybe TcType
ty
isMaybeTyBinder :: Maybe (TyBinder, b) -> Bool
isMaybeTyBinder (Just (TyBinder
t,b
_)) = TyBinder -> Bool
isTyBinder TyBinder
t
isMaybeTyBinder Maybe (TyBinder, b)
_ = Bool
True
tcSplitForAllTyVarBinder_maybe :: Type -> Maybe (TyVarBinder, Type)
tcSplitForAllTyVarBinder_maybe :: TcType -> Maybe (TyCoVarBinder, TcType)
tcSplitForAllTyVarBinder_maybe TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Maybe (TyCoVarBinder, TcType)
tcSplitForAllTyVarBinder_maybe TcType
ty'
tcSplitForAllTyVarBinder_maybe (ForAllTy TyCoVarBinder
tv TcType
ty) = Bool
-> ((TyCoVarBinder, TcType) -> Maybe (TyCoVarBinder, TcType))
-> (TyCoVarBinder, TcType)
-> Maybe (TyCoVarBinder, TcType)
forall a. HasCallStack => Bool -> a -> a
assert (TyCoVarBinder -> Bool
isTyVarBinder TyCoVarBinder
tv ) (TyCoVarBinder, TcType) -> Maybe (TyCoVarBinder, TcType)
forall a. a -> Maybe a
Just (TyCoVarBinder
tv, TcType
ty)
tcSplitForAllTyVarBinder_maybe TcType
_ = Maybe (TyCoVarBinder, TcType)
forall a. Maybe a
Nothing
tcSplitForAllTyVars :: Type -> ([TyVar], Type)
tcSplitForAllTyVars :: TcType -> ([TcTyVar], TcType)
tcSplitForAllTyVars TcType
ty
= Bool -> ([TcTyVar], TcType) -> ([TcTyVar], TcType)
forall a. HasCallStack => Bool -> a -> a
assert ((TcTyVar -> Bool) -> [TcTyVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TcTyVar -> Bool
isTyVar (([TcTyVar], TcType) -> [TcTyVar]
forall a b. (a, b) -> a
fst ([TcTyVar], TcType)
sty) ) ([TcTyVar], TcType)
sty
where sty :: ([TcTyVar], TcType)
sty = TcType -> ([TcTyVar], TcType)
splitForAllTyCoVars TcType
ty
tcSplitForAllInvisTyVars :: Type -> ([TyVar], Type)
tcSplitForAllInvisTyVars :: TcType -> ([TcTyVar], TcType)
tcSplitForAllInvisTyVars TcType
ty = (ArgFlag -> Bool) -> TcType -> ([TcTyVar], TcType)
tcSplitSomeForAllTyVars ArgFlag -> Bool
isInvisibleArgFlag TcType
ty
tcSplitSomeForAllTyVars :: (ArgFlag -> Bool) -> Type -> ([TyVar], Type)
tcSplitSomeForAllTyVars :: (ArgFlag -> Bool) -> TcType -> ([TcTyVar], TcType)
tcSplitSomeForAllTyVars ArgFlag -> Bool
argf_pred TcType
ty
= TcType -> TcType -> [TcTyVar] -> ([TcTyVar], TcType)
split TcType
ty TcType
ty []
where
split :: TcType -> TcType -> [TcTyVar] -> ([TcTyVar], TcType)
split TcType
_ (ForAllTy (Bndr TcTyVar
tv ArgFlag
argf) TcType
ty) [TcTyVar]
tvs
| ArgFlag -> Bool
argf_pred ArgFlag
argf = TcType -> TcType -> [TcTyVar] -> ([TcTyVar], TcType)
split TcType
ty TcType
ty (TcTyVar
tvTcTyVar -> [TcTyVar] -> [TcTyVar]
forall a. a -> [a] -> [a]
:[TcTyVar]
tvs)
split TcType
orig_ty TcType
ty [TcTyVar]
tvs | Just TcType
ty' <- TcType -> Maybe TcType
coreView TcType
ty = TcType -> TcType -> [TcTyVar] -> ([TcTyVar], TcType)
split TcType
orig_ty TcType
ty' [TcTyVar]
tvs
split TcType
orig_ty TcType
_ [TcTyVar]
tvs = ([TcTyVar] -> [TcTyVar]
forall a. [a] -> [a]
reverse [TcTyVar]
tvs, TcType
orig_ty)
tcSplitForAllReqTVBinders :: Type -> ([TcReqTVBinder], Type)
tcSplitForAllReqTVBinders :: TcType -> ([TcReqTVBinder], TcType)
tcSplitForAllReqTVBinders TcType
ty = Bool -> ([TcReqTVBinder], TcType) -> ([TcReqTVBinder], TcType)
forall a. HasCallStack => Bool -> a -> a
assert ((TcReqTVBinder -> Bool) -> [TcReqTVBinder] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TcTyVar -> Bool
isTyVar (TcTyVar -> Bool)
-> (TcReqTVBinder -> TcTyVar) -> TcReqTVBinder -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcReqTVBinder -> TcTyVar
forall tv argf. VarBndr tv argf -> tv
binderVar) (([TcReqTVBinder], TcType) -> [TcReqTVBinder]
forall a b. (a, b) -> a
fst ([TcReqTVBinder], TcType)
sty) ) ([TcReqTVBinder], TcType)
sty
where sty :: ([TcReqTVBinder], TcType)
sty = TcType -> ([TcReqTVBinder], TcType)
splitForAllReqTVBinders TcType
ty
tcSplitForAllInvisTVBinders :: Type -> ([TcInvisTVBinder], Type)
tcSplitForAllInvisTVBinders :: TcType -> ([TcInvisTVBinder], TcType)
tcSplitForAllInvisTVBinders TcType
ty = Bool -> ([TcInvisTVBinder], TcType) -> ([TcInvisTVBinder], TcType)
forall a. HasCallStack => Bool -> a -> a
assert ((TcInvisTVBinder -> Bool) -> [TcInvisTVBinder] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TcTyVar -> Bool
isTyVar (TcTyVar -> Bool)
-> (TcInvisTVBinder -> TcTyVar) -> TcInvisTVBinder -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcInvisTVBinder -> TcTyVar
forall tv argf. VarBndr tv argf -> tv
binderVar) (([TcInvisTVBinder], TcType) -> [TcInvisTVBinder]
forall a b. (a, b) -> a
fst ([TcInvisTVBinder], TcType)
sty) ) ([TcInvisTVBinder], TcType)
sty
where sty :: ([TcInvisTVBinder], TcType)
sty = TcType -> ([TcInvisTVBinder], TcType)
splitForAllInvisTVBinders TcType
ty
tcSplitForAllTyVarBinders :: Type -> ([TyVarBinder], Type)
tcSplitForAllTyVarBinders :: TcType -> ([TyCoVarBinder], TcType)
tcSplitForAllTyVarBinders TcType
ty = Bool -> ([TyCoVarBinder], TcType) -> ([TyCoVarBinder], TcType)
forall a. HasCallStack => Bool -> a -> a
assert ((TyCoVarBinder -> Bool) -> [TyCoVarBinder] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TyCoVarBinder -> Bool
isTyVarBinder (([TyCoVarBinder], TcType) -> [TyCoVarBinder]
forall a b. (a, b) -> a
fst ([TyCoVarBinder], TcType)
sty)) ([TyCoVarBinder], TcType)
sty
where sty :: ([TyCoVarBinder], TcType)
sty = TcType -> ([TyCoVarBinder], TcType)
splitForAllTyCoVarBinders TcType
ty
tcIsForAllTy :: Type -> Bool
tcIsForAllTy :: TcType -> Bool
tcIsForAllTy TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Bool
tcIsForAllTy TcType
ty'
tcIsForAllTy (ForAllTy {}) = Bool
True
tcIsForAllTy TcType
_ = Bool
False
tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)
tcSplitPredFunTy_maybe :: TcType -> Maybe (TcType, TcType)
tcSplitPredFunTy_maybe TcType
ty
| Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Maybe (TcType, TcType)
tcSplitPredFunTy_maybe TcType
ty'
tcSplitPredFunTy_maybe (FunTy { ft_af :: TcType -> AnonArgFlag
ft_af = AnonArgFlag
InvisArg
, ft_arg :: TcType -> TcType
ft_arg = TcType
arg, ft_res :: TcType -> TcType
ft_res = TcType
res })
= (TcType, TcType) -> Maybe (TcType, TcType)
forall a. a -> Maybe a
Just (TcType
arg, TcType
res)
tcSplitPredFunTy_maybe TcType
_
= Maybe (TcType, TcType)
forall a. Maybe a
Nothing
tcSplitPhiTy :: Type -> (ThetaType, Type)
tcSplitPhiTy :: TcType -> ([TcType], TcType)
tcSplitPhiTy TcType
ty
= TcType -> [TcType] -> ([TcType], TcType)
split TcType
ty []
where
split :: TcType -> [TcType] -> ([TcType], TcType)
split TcType
ty [TcType]
ts
= case TcType -> Maybe (TcType, TcType)
tcSplitPredFunTy_maybe TcType
ty of
Just (TcType
pred, TcType
ty) -> TcType -> [TcType] -> ([TcType], TcType)
split TcType
ty (TcType
predTcType -> [TcType] -> [TcType]
forall a. a -> [a] -> [a]
:[TcType]
ts)
Maybe (TcType, TcType)
Nothing -> ([TcType] -> [TcType]
forall a. [a] -> [a]
reverse [TcType]
ts, TcType
ty)
tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
tcSplitSigmaTy :: TcType -> ([TcTyVar], [TcType], TcType)
tcSplitSigmaTy TcType
ty = case TcType -> ([TcTyVar], TcType)
tcSplitForAllInvisTyVars TcType
ty of
([TcTyVar]
tvs, TcType
rho) -> case TcType -> ([TcType], TcType)
tcSplitPhiTy TcType
rho of
([TcType]
theta, TcType
tau) -> ([TcTyVar]
tvs, [TcType]
theta, TcType
tau)
tcSplitNestedSigmaTys :: Type -> ([TyVar], ThetaType, Type)
tcSplitNestedSigmaTys :: TcType -> ([TcTyVar], [TcType], TcType)
tcSplitNestedSigmaTys TcType
ty
| ([TcTyVar]
tvs1, [TcType]
theta1, TcType
rho1) <- TcType -> ([TcTyVar], [TcType], TcType)
tcSplitSigmaTy TcType
ty
, Bool -> Bool
not ([TcTyVar] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcTyVar]
tvs1 Bool -> Bool -> Bool
&& [TcType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcType]
theta1)
= let ([TcTyVar]
tvs2, [TcType]
theta2, TcType
rho2) = TcType -> ([TcTyVar], [TcType], TcType)
tcSplitNestedSigmaTys TcType
rho1
in ([TcTyVar]
tvs1 [TcTyVar] -> [TcTyVar] -> [TcTyVar]
forall a. [a] -> [a] -> [a]
++ [TcTyVar]
tvs2, [TcType]
theta1 [TcType] -> [TcType] -> [TcType]
forall a. [a] -> [a] -> [a]
++ [TcType]
theta2, TcType
rho2)
| Bool
otherwise = ([], [], TcType
ty)
tcTyConAppTyCon :: Type -> TyCon
tcTyConAppTyCon :: TcType -> TyCon
tcTyConAppTyCon TcType
ty
= case TcType -> Maybe TyCon
tcTyConAppTyCon_maybe TcType
ty of
Just TyCon
tc -> TyCon
tc
Maybe TyCon
Nothing -> String -> SDoc -> TyCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcTyConAppTyCon" (TcType -> SDoc
pprType TcType
ty)
tcTyConAppTyCon_maybe :: Type -> Maybe TyCon
tcTyConAppTyCon_maybe :: TcType -> Maybe TyCon
tcTyConAppTyCon_maybe TcType
ty
| Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Maybe TyCon
tcTyConAppTyCon_maybe TcType
ty'
tcTyConAppTyCon_maybe (TyConApp TyCon
tc [TcType]
_)
= TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just TyCon
tc
tcTyConAppTyCon_maybe (FunTy { ft_af :: TcType -> AnonArgFlag
ft_af = AnonArgFlag
VisArg })
= TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just TyCon
funTyCon
tcTyConAppTyCon_maybe TcType
_
= Maybe TyCon
forall a. Maybe a
Nothing
tcTyConAppArgs :: Type -> [Type]
tcTyConAppArgs :: TcType -> [TcType]
tcTyConAppArgs TcType
ty = case HasCallStack => TcType -> Maybe (TyCon, [TcType])
TcType -> Maybe (TyCon, [TcType])
tcSplitTyConApp_maybe TcType
ty of
Just (TyCon
_, [TcType]
args) -> [TcType]
args
Maybe (TyCon, [TcType])
Nothing -> String -> SDoc -> [TcType]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcTyConAppArgs" (TcType -> SDoc
pprType TcType
ty)
tcSplitTyConApp :: Type -> (TyCon, [Type])
tcSplitTyConApp :: TcType -> (TyCon, [TcType])
tcSplitTyConApp TcType
ty = case HasCallStack => TcType -> Maybe (TyCon, [TcType])
TcType -> Maybe (TyCon, [TcType])
tcSplitTyConApp_maybe TcType
ty of
Just (TyCon, [TcType])
stuff -> (TyCon, [TcType])
stuff
Maybe (TyCon, [TcType])
Nothing -> String -> SDoc -> (TyCon, [TcType])
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcSplitTyConApp" (TcType -> SDoc
pprType TcType
ty)
tcSplitFunTys :: Type -> ([Scaled Type], Type)
tcSplitFunTys :: TcType -> ([Scaled TcType], TcType)
tcSplitFunTys TcType
ty = case TcType -> Maybe (Scaled TcType, TcType)
tcSplitFunTy_maybe TcType
ty of
Maybe (Scaled TcType, TcType)
Nothing -> ([], TcType
ty)
Just (Scaled TcType
arg,TcType
res) -> (Scaled TcType
argScaled TcType -> [Scaled TcType] -> [Scaled TcType]
forall a. a -> [a] -> [a]
:[Scaled TcType]
args, TcType
res')
where
([Scaled TcType]
args,TcType
res') = TcType -> ([Scaled TcType], TcType)
tcSplitFunTys TcType
res
tcSplitFunTy_maybe :: Type -> Maybe (Scaled Type, Type)
tcSplitFunTy_maybe :: TcType -> Maybe (Scaled TcType, TcType)
tcSplitFunTy_maybe TcType
ty
| Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Maybe (Scaled TcType, TcType)
tcSplitFunTy_maybe TcType
ty'
tcSplitFunTy_maybe (FunTy { ft_af :: TcType -> AnonArgFlag
ft_af = AnonArgFlag
af, ft_mult :: TcType -> TcType
ft_mult = TcType
w, ft_arg :: TcType -> TcType
ft_arg = TcType
arg, ft_res :: TcType -> TcType
ft_res = TcType
res })
| AnonArgFlag
VisArg <- AnonArgFlag
af = (Scaled TcType, TcType) -> Maybe (Scaled TcType, TcType)
forall a. a -> Maybe a
Just (TcType -> TcType -> Scaled TcType
forall a. TcType -> a -> Scaled a
Scaled TcType
w TcType
arg, TcType
res)
tcSplitFunTy_maybe TcType
_ = Maybe (Scaled TcType, TcType)
forall a. Maybe a
Nothing
tcSplitFunTysN :: Arity
-> TcRhoType
-> Either Arity
([Scaled TcSigmaType],
TcSigmaType)
tcSplitFunTysN :: Int -> TcType -> Either Int ([Scaled TcType], TcType)
tcSplitFunTysN Int
n TcType
ty
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
= ([Scaled TcType], TcType) -> Either Int ([Scaled TcType], TcType)
forall a b. b -> Either a b
Right ([], TcType
ty)
| Just (Scaled TcType
arg,TcType
res) <- TcType -> Maybe (Scaled TcType, TcType)
tcSplitFunTy_maybe TcType
ty
= case Int -> TcType -> Either Int ([Scaled TcType], TcType)
tcSplitFunTysN (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) TcType
res of
Left Int
m -> Int -> Either Int ([Scaled TcType], TcType)
forall a b. a -> Either a b
Left Int
m
Right ([Scaled TcType]
args,TcType
body) -> ([Scaled TcType], TcType) -> Either Int ([Scaled TcType], TcType)
forall a b. b -> Either a b
Right (Scaled TcType
argScaled TcType -> [Scaled TcType] -> [Scaled TcType]
forall a. a -> [a] -> [a]
:[Scaled TcType]
args, TcType
body)
| Bool
otherwise
= Int -> Either Int ([Scaled TcType], TcType)
forall a b. a -> Either a b
Left Int
n
tcSplitFunTy :: Type -> (Scaled Type, Type)
tcSplitFunTy :: TcType -> (Scaled TcType, TcType)
tcSplitFunTy TcType
ty = String -> Maybe (Scaled TcType, TcType) -> (Scaled TcType, TcType)
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"tcSplitFunTy" (TcType -> Maybe (Scaled TcType, TcType)
tcSplitFunTy_maybe TcType
ty)
tcFunArgTy :: Type -> Scaled Type
tcFunArgTy :: TcType -> Scaled TcType
tcFunArgTy TcType
ty = (Scaled TcType, TcType) -> Scaled TcType
forall a b. (a, b) -> a
fst (TcType -> (Scaled TcType, TcType)
tcSplitFunTy TcType
ty)
tcFunResultTy :: Type -> Type
tcFunResultTy :: TcType -> TcType
tcFunResultTy TcType
ty = (Scaled TcType, TcType) -> TcType
forall a b. (a, b) -> b
snd (TcType -> (Scaled TcType, TcType)
tcSplitFunTy TcType
ty)
tcFunResultTyN :: HasDebugCallStack => Arity -> Type -> Type
tcFunResultTyN :: Int -> TcType -> TcType
tcFunResultTyN Int
n TcType
ty
| Right ([Scaled TcType]
_, TcType
res_ty) <- Int -> TcType -> Either Int ([Scaled TcType], TcType)
tcSplitFunTysN Int
n TcType
ty
= TcType
res_ty
| Bool
otherwise
= String -> SDoc -> TcType
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcFunResultTyN" (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty)
tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
tcSplitAppTy_maybe :: TcType -> Maybe (TcType, TcType)
tcSplitAppTy_maybe TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Maybe (TcType, TcType)
tcSplitAppTy_maybe TcType
ty'
tcSplitAppTy_maybe TcType
ty = TcType -> Maybe (TcType, TcType)
tcRepSplitAppTy_maybe TcType
ty
tcSplitAppTy :: Type -> (Type, Type)
tcSplitAppTy :: TcType -> (TcType, TcType)
tcSplitAppTy TcType
ty = case TcType -> Maybe (TcType, TcType)
tcSplitAppTy_maybe TcType
ty of
Just (TcType, TcType)
stuff -> (TcType, TcType)
stuff
Maybe (TcType, TcType)
Nothing -> String -> SDoc -> (TcType, TcType)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcSplitAppTy" (TcType -> SDoc
pprType TcType
ty)
tcSplitAppTys :: Type -> (Type, [Type])
tcSplitAppTys :: TcType -> (TcType, [TcType])
tcSplitAppTys TcType
ty
= TcType -> [TcType] -> (TcType, [TcType])
go TcType
ty []
where
go :: TcType -> [TcType] -> (TcType, [TcType])
go TcType
ty [TcType]
args = case TcType -> Maybe (TcType, TcType)
tcSplitAppTy_maybe TcType
ty of
Just (TcType
ty', TcType
arg) -> TcType -> [TcType] -> (TcType, [TcType])
go TcType
ty' (TcType
argTcType -> [TcType] -> [TcType]
forall a. a -> [a] -> [a]
:[TcType]
args)
Maybe (TcType, TcType)
Nothing -> (TcType
ty,[TcType]
args)
tcRepGetNumAppTys :: Type -> Arity
tcRepGetNumAppTys :: TcType -> Int
tcRepGetNumAppTys = [TcType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TcType] -> Int) -> (TcType -> [TcType]) -> TcType -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TcType, [TcType]) -> [TcType]
forall a b. (a, b) -> b
snd ((TcType, [TcType]) -> [TcType])
-> (TcType -> (TcType, [TcType])) -> TcType -> [TcType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => TcType -> (TcType, [TcType])
TcType -> (TcType, [TcType])
repSplitAppTys
tcGetCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)
tcGetCastedTyVar_maybe :: TcType -> Maybe (TcTyVar, KindCoercion)
tcGetCastedTyVar_maybe TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Maybe (TcTyVar, KindCoercion)
tcGetCastedTyVar_maybe TcType
ty'
tcGetCastedTyVar_maybe (CastTy (TyVarTy TcTyVar
tv) KindCoercion
co) = (TcTyVar, KindCoercion) -> Maybe (TcTyVar, KindCoercion)
forall a. a -> Maybe a
Just (TcTyVar
tv, KindCoercion
co)
tcGetCastedTyVar_maybe (TyVarTy TcTyVar
tv) = (TcTyVar, KindCoercion) -> Maybe (TcTyVar, KindCoercion)
forall a. a -> Maybe a
Just (TcTyVar
tv, TcType -> KindCoercion
mkNomReflCo (TcTyVar -> TcType
tyVarKind TcTyVar
tv))
tcGetCastedTyVar_maybe TcType
_ = Maybe (TcTyVar, KindCoercion)
forall a. Maybe a
Nothing
tcGetTyVar_maybe :: Type -> Maybe TyVar
tcGetTyVar_maybe :: TcType -> Maybe TcTyVar
tcGetTyVar_maybe TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Maybe TcTyVar
tcGetTyVar_maybe TcType
ty'
tcGetTyVar_maybe (TyVarTy TcTyVar
tv) = TcTyVar -> Maybe TcTyVar
forall a. a -> Maybe a
Just TcTyVar
tv
tcGetTyVar_maybe TcType
_ = Maybe TcTyVar
forall a. Maybe a
Nothing
tcGetTyVar :: String -> Type -> TyVar
tcGetTyVar :: String -> TcType -> TcTyVar
tcGetTyVar String
msg TcType
ty
= case TcType -> Maybe TcTyVar
tcGetTyVar_maybe TcType
ty of
Just TcTyVar
tv -> TcTyVar
tv
Maybe TcTyVar
Nothing -> String -> SDoc -> TcTyVar
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
msg (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty)
tcIsTyVarTy :: Type -> Bool
tcIsTyVarTy :: TcType -> Bool
tcIsTyVarTy TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Bool
tcIsTyVarTy TcType
ty'
tcIsTyVarTy (CastTy TcType
ty KindCoercion
_) = TcType -> Bool
tcIsTyVarTy TcType
ty
tcIsTyVarTy (TyVarTy TcTyVar
_) = Bool
True
tcIsTyVarTy TcType
_ = Bool
False
tcSplitDFunTy :: Type -> ([TyVar], [Type], Class, [Type])
tcSplitDFunTy :: TcType -> ([TcTyVar], [TcType], Class, [TcType])
tcSplitDFunTy TcType
ty
= case TcType -> ([TcTyVar], TcType)
tcSplitForAllInvisTyVars TcType
ty of { ([TcTyVar]
tvs, TcType
rho) ->
case TcType -> ([Scaled TcType], TcType)
splitFunTys TcType
rho of { ([Scaled TcType]
theta, TcType
tau) ->
case TcType -> (Class, [TcType])
tcSplitDFunHead TcType
tau of { (Class
clas, [TcType]
tys) ->
([TcTyVar]
tvs, (Scaled TcType -> TcType) -> [Scaled TcType] -> [TcType]
forall a b. (a -> b) -> [a] -> [b]
map Scaled TcType -> TcType
forall a. Scaled a -> a
scaledThing [Scaled TcType]
theta, Class
clas, [TcType]
tys) }}}
tcSplitDFunHead :: Type -> (Class, [Type])
tcSplitDFunHead :: TcType -> (Class, [TcType])
tcSplitDFunHead = HasDebugCallStack => TcType -> (Class, [TcType])
TcType -> (Class, [TcType])
getClassPredTys
tcSplitMethodTy :: Type -> ([TyVar], PredType, Type)
tcSplitMethodTy :: TcType -> ([TcTyVar], TcType, TcType)
tcSplitMethodTy TcType
ty
| ([TcTyVar]
sel_tyvars,TcType
sel_rho) <- TcType -> ([TcTyVar], TcType)
tcSplitForAllInvisTyVars TcType
ty
, Just (TcType
first_pred, TcType
local_meth_ty) <- TcType -> Maybe (TcType, TcType)
tcSplitPredFunTy_maybe TcType
sel_rho
= ([TcTyVar]
sel_tyvars, TcType
first_pred, TcType
local_meth_ty)
| Bool
otherwise
= String -> SDoc -> ([TcTyVar], TcType, TcType)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcSplitMethodTy" (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty)
tcEqKind :: HasDebugCallStack => TcKind -> TcKind -> Bool
tcEqKind :: TcType -> TcType -> Bool
tcEqKind = HasDebugCallStack => TcType -> TcType -> Bool
TcType -> TcType -> Bool
tcEqType
tcEqType :: HasDebugCallStack => TcType -> TcType -> Bool
tcEqType :: TcType -> TcType -> Bool
tcEqType TcType
ty1 TcType
ty2
= TcType -> TcType -> Bool
tcEqTypeNoSyns TcType
ki1 TcType
ki2
Bool -> Bool -> Bool
&& TcType -> TcType -> Bool
tcEqTypeNoSyns TcType
ty1 TcType
ty2
where
ki1 :: TcType
ki1 = HasDebugCallStack => TcType -> TcType
TcType -> TcType
tcTypeKind TcType
ty1
ki2 :: TcType
ki2 = HasDebugCallStack => TcType -> TcType
TcType -> TcType
tcTypeKind TcType
ty2
tcEqTypeNoKindCheck :: TcType -> TcType -> Bool
tcEqTypeNoKindCheck :: TcType -> TcType -> Bool
tcEqTypeNoKindCheck TcType
ty1 TcType
ty2
= TcType -> TcType -> Bool
tcEqTypeNoSyns TcType
ty1 TcType
ty2
tcEqTyConApps :: TyCon -> [Type] -> TyCon -> [Type] -> Bool
tcEqTyConApps :: TyCon -> [TcType] -> TyCon -> [TcType] -> Bool
tcEqTyConApps TyCon
tc1 [TcType]
args1 TyCon
tc2 [TcType]
args2
= TyCon
tc1 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tc2 Bool -> Bool -> Bool
&&
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((TcType -> TcType -> Bool) -> [TcType] -> [TcType] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith TcType -> TcType -> Bool
tcEqTypeNoKindCheck [TcType]
args1 [TcType]
args2)
tcEqTypeNoSyns :: TcType -> TcType -> Bool
tcEqTypeNoSyns :: TcType -> TcType -> Bool
tcEqTypeNoSyns TcType
ta TcType
tb = Bool -> Bool -> TcType -> TcType -> Bool
tc_eq_type Bool
False Bool
False TcType
ta TcType
tb
tcEqTypeVis :: TcType -> TcType -> Bool
tcEqTypeVis :: TcType -> TcType -> Bool
tcEqTypeVis TcType
ty1 TcType
ty2 = Bool -> Bool -> TcType -> TcType -> Bool
tc_eq_type Bool
False Bool
True TcType
ty1 TcType
ty2
pickyEqType :: TcType -> TcType -> Bool
pickyEqType :: TcType -> TcType -> Bool
pickyEqType TcType
ty1 TcType
ty2 = Bool -> Bool -> TcType -> TcType -> Bool
tc_eq_type Bool
True Bool
False TcType
ty1 TcType
ty2
tc_eq_type :: Bool
-> Bool
-> Type -> Type
-> Bool
tc_eq_type :: Bool -> Bool -> TcType -> TcType -> Bool
tc_eq_type Bool
keep_syns Bool
vis_only TcType
orig_ty1 TcType
orig_ty2
= RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
orig_env TcType
orig_ty1 TcType
orig_ty2
where
go :: RnEnv2 -> Type -> Type -> Bool
go :: RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
_ (TyConApp TyCon
tc1 []) (TyConApp TyCon
tc2 [])
| TyCon
tc1 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tc2
= Bool
True
go RnEnv2
env TcType
t1 TcType
t2 | Bool -> Bool
not Bool
keep_syns, Just TcType
t1' <- TcType -> Maybe TcType
tcView TcType
t1 = RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
t1' TcType
t2
go RnEnv2
env TcType
t1 TcType
t2 | Bool -> Bool
not Bool
keep_syns, Just TcType
t2' <- TcType -> Maybe TcType
tcView TcType
t2 = RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
t1 TcType
t2'
go RnEnv2
env (TyVarTy TcTyVar
tv1) (TyVarTy TcTyVar
tv2)
= RnEnv2 -> TcTyVar -> TcTyVar
rnOccL RnEnv2
env TcTyVar
tv1 TcTyVar -> TcTyVar -> Bool
forall a. Eq a => a -> a -> Bool
== RnEnv2 -> TcTyVar -> TcTyVar
rnOccR RnEnv2
env TcTyVar
tv2
go RnEnv2
_ (LitTy TyLit
lit1) (LitTy TyLit
lit2)
= TyLit
lit1 TyLit -> TyLit -> Bool
forall a. Eq a => a -> a -> Bool
== TyLit
lit2
go RnEnv2
env (ForAllTy (Bndr TcTyVar
tv1 ArgFlag
vis1) TcType
ty1)
(ForAllTy (Bndr TcTyVar
tv2 ArgFlag
vis2) TcType
ty2)
= ArgFlag
vis1 ArgFlag -> ArgFlag -> Bool
`sameVis` ArgFlag
vis2
Bool -> Bool -> Bool
&& (Bool
vis_only Bool -> Bool -> Bool
|| RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env (TcTyVar -> TcType
varType TcTyVar
tv1) (TcTyVar -> TcType
varType TcTyVar
tv2))
Bool -> Bool -> Bool
&& RnEnv2 -> TcType -> TcType -> Bool
go (RnEnv2 -> TcTyVar -> TcTyVar -> RnEnv2
rnBndr2 RnEnv2
env TcTyVar
tv1 TcTyVar
tv2) TcType
ty1 TcType
ty2
go RnEnv2
env (FunTy AnonArgFlag
_ TcType
w1 TcType
arg1 TcType
res1) (FunTy AnonArgFlag
_ TcType
w2 TcType
arg2 TcType
res2)
= Bool
kinds_eq Bool -> Bool -> Bool
&& RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
arg1 TcType
arg2 Bool -> Bool -> Bool
&& RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
res1 TcType
res2 Bool -> Bool -> Bool
&& RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
w1 TcType
w2
where
kinds_eq :: Bool
kinds_eq | Bool
vis_only = Bool
True
| Bool
otherwise = RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env (HasDebugCallStack => TcType -> TcType
TcType -> TcType
typeKind TcType
arg1) (HasDebugCallStack => TcType -> TcType
TcType -> TcType
typeKind TcType
arg2) Bool -> Bool -> Bool
&&
RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env (HasDebugCallStack => TcType -> TcType
TcType -> TcType
typeKind TcType
res1) (HasDebugCallStack => TcType -> TcType
TcType -> TcType
typeKind TcType
res2)
go RnEnv2
env (AppTy TcType
s1 TcType
t1) TcType
ty2
| Just (TcType
s2, TcType
t2) <- TcType -> Maybe (TcType, TcType)
tcRepSplitAppTy_maybe TcType
ty2
= RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
s1 TcType
s2 Bool -> Bool -> Bool
&& RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
t1 TcType
t2
go RnEnv2
env TcType
ty1 (AppTy TcType
s2 TcType
t2)
| Just (TcType
s1, TcType
t1) <- TcType -> Maybe (TcType, TcType)
tcRepSplitAppTy_maybe TcType
ty1
= RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
s1 TcType
s2 Bool -> Bool -> Bool
&& RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
t1 TcType
t2
go RnEnv2
env (TyConApp TyCon
tc1 [TcType]
ts1) (TyConApp TyCon
tc2 [TcType]
ts2)
= TyCon
tc1 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tc2 Bool -> Bool -> Bool
&& RnEnv2 -> [Bool] -> [TcType] -> [TcType] -> Bool
gos RnEnv2
env (TyCon -> [Bool]
tc_vis TyCon
tc1) [TcType]
ts1 [TcType]
ts2
go RnEnv2
env (CastTy TcType
t1 KindCoercion
_) TcType
t2 = RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
t1 TcType
t2
go RnEnv2
env TcType
t1 (CastTy TcType
t2 KindCoercion
_) = RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
t1 TcType
t2
go RnEnv2
_ (CoercionTy {}) (CoercionTy {}) = Bool
True
go RnEnv2
_ TcType
_ TcType
_ = Bool
False
gos :: RnEnv2 -> [Bool] -> [TcType] -> [TcType] -> Bool
gos RnEnv2
_ [Bool]
_ [] [] = Bool
True
gos RnEnv2
env (Bool
ig:[Bool]
igs) (TcType
t1:[TcType]
ts1) (TcType
t2:[TcType]
ts2) = (Bool
ig Bool -> Bool -> Bool
|| RnEnv2 -> TcType -> TcType -> Bool
go RnEnv2
env TcType
t1 TcType
t2)
Bool -> Bool -> Bool
&& RnEnv2 -> [Bool] -> [TcType] -> [TcType] -> Bool
gos RnEnv2
env [Bool]
igs [TcType]
ts1 [TcType]
ts2
gos RnEnv2
_ [Bool]
_ [TcType]
_ [TcType]
_ = Bool
False
tc_vis :: TyCon -> [Bool]
tc_vis :: TyCon -> [Bool]
tc_vis TyCon
tc | Bool
vis_only = [Bool]
inviss [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False
| Bool
otherwise = Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False
where
bndrs :: [TyConBinder]
bndrs = TyCon -> [TyConBinder]
tyConBinders TyCon
tc
inviss :: [Bool]
inviss = (TyConBinder -> Bool) -> [TyConBinder] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map TyConBinder -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder [TyConBinder]
bndrs
orig_env :: RnEnv2
orig_env = InScopeSet -> RnEnv2
mkRnEnv2 (InScopeSet -> RnEnv2) -> InScopeSet -> RnEnv2
forall a b. (a -> b) -> a -> b
$ VarSet -> InScopeSet
mkInScopeSet (VarSet -> InScopeSet) -> VarSet -> InScopeSet
forall a b. (a -> b) -> a -> b
$ [TcType] -> VarSet
tyCoVarsOfTypes [TcType
orig_ty1, TcType
orig_ty2]
{-# INLINE tc_eq_type #-}
isTyVarClassPred :: PredType -> Bool
isTyVarClassPred :: TcType -> Bool
isTyVarClassPred TcType
ty = case TcType -> Maybe (Class, [TcType])
getClassPredTys_maybe TcType
ty of
Just (Class
_, [TcType]
tys) -> (TcType -> Bool) -> [TcType] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TcType -> Bool
isTyVarTy [TcType]
tys
Maybe (Class, [TcType])
_ -> Bool
False
checkValidClsArgs :: Bool -> Class -> [KindOrType] -> Bool
checkValidClsArgs :: Bool -> Class -> [TcType] -> Bool
checkValidClsArgs Bool
flexible_contexts Class
cls [TcType]
kts
| Bool
flexible_contexts = Bool
True
| Bool
otherwise = (TcType -> Bool) -> [TcType] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TcType -> Bool
hasTyVarHead [TcType]
tys
where
tys :: [TcType]
tys = TyCon -> [TcType] -> [TcType]
filterOutInvisibleTypes (Class -> TyCon
classTyCon Class
cls) [TcType]
kts
hasTyVarHead :: Type -> Bool
hasTyVarHead :: TcType -> Bool
hasTyVarHead TcType
ty
| TcType -> Bool
tcIsTyVarTy TcType
ty = Bool
True
| Bool
otherwise
= case TcType -> Maybe (TcType, TcType)
tcSplitAppTy_maybe TcType
ty of
Just (TcType
ty, TcType
_) -> TcType -> Bool
hasTyVarHead TcType
ty
Maybe (TcType, TcType)
Nothing -> Bool
False
evVarPred :: EvVar -> PredType
evVarPred :: TcTyVar -> TcType
evVarPred TcTyVar
var = TcTyVar -> TcType
varType TcTyVar
var
boxEqPred :: EqRel -> Type -> Type -> Maybe (Class, [Type])
boxEqPred :: EqRel -> TcType -> TcType -> Maybe (Class, [TcType])
boxEqPred EqRel
eq_rel TcType
ty1 TcType
ty2
= case EqRel
eq_rel of
EqRel
NomEq | Bool
homo_kind -> (Class, [TcType]) -> Maybe (Class, [TcType])
forall a. a -> Maybe a
Just (Class
eqClass, [TcType
k1, TcType
ty1, TcType
ty2])
| Bool
otherwise -> (Class, [TcType]) -> Maybe (Class, [TcType])
forall a. a -> Maybe a
Just (Class
heqClass, [TcType
k1, TcType
k2, TcType
ty1, TcType
ty2])
EqRel
ReprEq | Bool
homo_kind -> (Class, [TcType]) -> Maybe (Class, [TcType])
forall a. a -> Maybe a
Just (Class
coercibleClass, [TcType
k1, TcType
ty1, TcType
ty2])
| Bool
otherwise -> Maybe (Class, [TcType])
forall a. Maybe a
Nothing
where
k1 :: TcType
k1 = HasDebugCallStack => TcType -> TcType
TcType -> TcType
tcTypeKind TcType
ty1
k2 :: TcType
k2 = HasDebugCallStack => TcType -> TcType
TcType -> TcType
tcTypeKind TcType
ty2
homo_kind :: Bool
homo_kind = TcType
k1 HasDebugCallStack => TcType -> TcType -> Bool
TcType -> TcType -> Bool
`tcEqType` TcType
k2
pickCapturedPreds
:: TyVarSet
-> TcThetaType
-> TcThetaType
pickCapturedPreds :: VarSet -> [TcType] -> [TcType]
pickCapturedPreds VarSet
qtvs [TcType]
theta
= (TcType -> Bool) -> [TcType] -> [TcType]
forall a. (a -> Bool) -> [a] -> [a]
filter TcType -> Bool
captured [TcType]
theta
where
captured :: TcType -> Bool
captured TcType
pred = TcType -> Bool
isIPLikePred TcType
pred Bool -> Bool -> Bool
|| (TcType -> VarSet
tyCoVarsOfType TcType
pred VarSet -> VarSet -> Bool
`intersectsVarSet` VarSet
qtvs)
type PredWithSCs a = (PredType, [PredType], a)
mkMinimalBySCs :: forall a. (a -> PredType) -> [a] -> [a]
mkMinimalBySCs :: (a -> TcType) -> [a] -> [a]
mkMinimalBySCs a -> TcType
get_pred [a]
xs = [PredWithSCs a] -> [PredWithSCs a] -> [a]
go [PredWithSCs a]
preds_with_scs []
where
preds_with_scs :: [PredWithSCs a]
preds_with_scs :: [PredWithSCs a]
preds_with_scs = [ (TcType
pred, TcType -> [TcType]
implicants TcType
pred, a
x)
| a
x <- [a]
xs
, let pred :: TcType
pred = a -> TcType
get_pred a
x ]
go :: [PredWithSCs a]
-> [PredWithSCs a]
-> [a]
go :: [PredWithSCs a] -> [PredWithSCs a] -> [a]
go [] [PredWithSCs a]
min_preds
= [a] -> [a]
forall a. [a] -> [a]
reverse ((PredWithSCs a -> a) -> [PredWithSCs a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map PredWithSCs a -> a
forall a b c. (a, b, c) -> c
thdOf3 [PredWithSCs a]
min_preds)
go (work_item :: PredWithSCs a
work_item@(TcType
p,[TcType]
_,a
_) : [PredWithSCs a]
work_list) [PredWithSCs a]
min_preds
| EqPred EqRel
_ TcType
t1 TcType
t2 <- TcType -> Pred
classifyPredType TcType
p
, TcType
t1 HasDebugCallStack => TcType -> TcType -> Bool
TcType -> TcType -> Bool
`tcEqType` TcType
t2
= [PredWithSCs a] -> [PredWithSCs a] -> [a]
go [PredWithSCs a]
work_list [PredWithSCs a]
min_preds
| TcType
p TcType -> [PredWithSCs a] -> Bool
`in_cloud` [PredWithSCs a]
work_list Bool -> Bool -> Bool
|| TcType
p TcType -> [PredWithSCs a] -> Bool
`in_cloud` [PredWithSCs a]
min_preds
= [PredWithSCs a] -> [PredWithSCs a] -> [a]
go [PredWithSCs a]
work_list [PredWithSCs a]
min_preds
| Bool
otherwise
= [PredWithSCs a] -> [PredWithSCs a] -> [a]
go [PredWithSCs a]
work_list (PredWithSCs a
work_item PredWithSCs a -> [PredWithSCs a] -> [PredWithSCs a]
forall a. a -> [a] -> [a]
: [PredWithSCs a]
min_preds)
in_cloud :: PredType -> [PredWithSCs a] -> Bool
in_cloud :: TcType -> [PredWithSCs a] -> Bool
in_cloud TcType
p [PredWithSCs a]
ps = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ TcType
p HasDebugCallStack => TcType -> TcType -> Bool
TcType -> TcType -> Bool
`tcEqType` TcType
p' | (TcType
_, [TcType]
scs, a
_) <- [PredWithSCs a]
ps, TcType
p' <- [TcType]
scs ]
implicants :: TcType -> [TcType]
implicants TcType
pred
= TcType
pred TcType -> [TcType] -> [TcType]
forall a. a -> [a] -> [a]
: TcType -> [TcType]
eq_extras TcType
pred [TcType] -> [TcType] -> [TcType]
forall a. [a] -> [a] -> [a]
++ TcType -> [TcType]
transSuperClasses TcType
pred
eq_extras :: TcType -> [TcType]
eq_extras TcType
pred
= case TcType -> Pred
classifyPredType TcType
pred of
EqPred EqRel
r TcType
t1 TcType
t2 -> [Role -> TcType -> TcType -> TcType
mkPrimEqPredRole (EqRel -> Role
eqRelRole EqRel
r) TcType
t2 TcType
t1]
ClassPred Class
cls [TcType
k1,TcType
k2,TcType
t1,TcType
t2]
| Class
cls Class -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey -> [Class -> [TcType] -> TcType
mkClassPred Class
cls [TcType
k2, TcType
k1, TcType
t2, TcType
t1]]
ClassPred Class
cls [TcType
k,TcType
t1,TcType
t2]
| Class
cls Class -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey -> [Class -> [TcType] -> TcType
mkClassPred Class
cls [TcType
k, TcType
t2, TcType
t1]]
Pred
_ -> []
transSuperClasses :: PredType -> [PredType]
transSuperClasses :: TcType -> [TcType]
transSuperClasses TcType
p
= NameSet -> TcType -> [TcType]
go NameSet
emptyNameSet TcType
p
where
go :: NameSet -> PredType -> [PredType]
go :: NameSet -> TcType -> [TcType]
go NameSet
rec_clss TcType
p
| ClassPred Class
cls [TcType]
tys <- TcType -> Pred
classifyPredType TcType
p
, let cls_nm :: Name
cls_nm = Class -> Name
className Class
cls
, Bool -> Bool
not (Name
cls_nm Name -> NameSet -> Bool
`elemNameSet` NameSet
rec_clss)
, let rec_clss' :: NameSet
rec_clss' | Class -> Bool
isCTupleClass Class
cls = NameSet
rec_clss
| Bool
otherwise = NameSet
rec_clss NameSet -> Name -> NameSet
`extendNameSet` Name
cls_nm
= [ TcType
p' | TcType
sc <- Class -> [TcType] -> [TcType]
immSuperClasses Class
cls [TcType]
tys
, TcType
p' <- TcType
sc TcType -> [TcType] -> [TcType]
forall a. a -> [a] -> [a]
: NameSet -> TcType -> [TcType]
go NameSet
rec_clss' TcType
sc ]
| Bool
otherwise
= []
immSuperClasses :: Class -> [Type] -> [PredType]
immSuperClasses :: Class -> [TcType] -> [TcType]
immSuperClasses Class
cls [TcType]
tys
= HasDebugCallStack => TCvSubst -> [TcType] -> [TcType]
TCvSubst -> [TcType] -> [TcType]
substTheta ([TcTyVar] -> [TcType] -> TCvSubst
HasDebugCallStack => [TcTyVar] -> [TcType] -> TCvSubst
zipTvSubst [TcTyVar]
tyvars [TcType]
tys) [TcType]
sc_theta
where
([TcTyVar]
tyvars,[TcType]
sc_theta,[TcTyVar]
_,[ClassOpItem]
_) = Class -> ([TcTyVar], [TcType], [TcTyVar], [ClassOpItem])
classBigSig Class
cls
isImprovementPred :: PredType -> Bool
isImprovementPred :: TcType -> Bool
isImprovementPred TcType
ty
= case TcType -> Pred
classifyPredType TcType
ty of
EqPred EqRel
NomEq TcType
t1 TcType
t2 -> Bool -> Bool
not (TcType
t1 HasDebugCallStack => TcType -> TcType -> Bool
TcType -> TcType -> Bool
`tcEqType` TcType
t2)
EqPred EqRel
ReprEq TcType
_ TcType
_ -> Bool
False
ClassPred Class
cls [TcType]
_ -> Class -> Bool
classHasFds Class
cls
IrredPred {} -> Bool
True
ForAllPred {} -> Bool
False
isSigmaTy :: TcType -> Bool
isSigmaTy :: TcType -> Bool
isSigmaTy TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Bool
isSigmaTy TcType
ty'
isSigmaTy (ForAllTy {}) = Bool
True
isSigmaTy (FunTy { ft_af :: TcType -> AnonArgFlag
ft_af = AnonArgFlag
InvisArg }) = Bool
True
isSigmaTy TcType
_ = Bool
False
isRhoTy :: TcType -> Bool
isRhoTy :: TcType -> Bool
isRhoTy TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Bool
isRhoTy TcType
ty'
isRhoTy (ForAllTy {}) = Bool
False
isRhoTy (FunTy { ft_af :: TcType -> AnonArgFlag
ft_af = AnonArgFlag
InvisArg }) = Bool
False
isRhoTy TcType
_ = Bool
True
isRhoExpTy :: ExpType -> Bool
isRhoExpTy :: ExpType -> Bool
isRhoExpTy (Check TcType
ty) = TcType -> Bool
isRhoTy TcType
ty
isRhoExpTy (Infer {}) = Bool
True
isOverloadedTy :: Type -> Bool
isOverloadedTy :: TcType -> Bool
isOverloadedTy TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> Bool
isOverloadedTy TcType
ty'
isOverloadedTy (ForAllTy TyCoVarBinder
_ TcType
ty) = TcType -> Bool
isOverloadedTy TcType
ty
isOverloadedTy (FunTy { ft_af :: TcType -> AnonArgFlag
ft_af = AnonArgFlag
InvisArg }) = Bool
True
isOverloadedTy TcType
_ = Bool
False
isFloatTy, isDoubleTy,
isFloatPrimTy, isDoublePrimTy,
isIntegerTy, isNaturalTy,
isIntTy, isWordTy, isBoolTy,
isUnitTy, isCharTy :: Type -> Bool
isFloatTy :: TcType -> Bool
isFloatTy = Unique -> TcType -> Bool
is_tc Unique
floatTyConKey
isDoubleTy :: TcType -> Bool
isDoubleTy = Unique -> TcType -> Bool
is_tc Unique
doubleTyConKey
isFloatPrimTy :: TcType -> Bool
isFloatPrimTy = Unique -> TcType -> Bool
is_tc Unique
floatPrimTyConKey
isDoublePrimTy :: TcType -> Bool
isDoublePrimTy = Unique -> TcType -> Bool
is_tc Unique
doublePrimTyConKey
isIntegerTy :: TcType -> Bool
isIntegerTy = Unique -> TcType -> Bool
is_tc Unique
integerTyConKey
isNaturalTy :: TcType -> Bool
isNaturalTy = Unique -> TcType -> Bool
is_tc Unique
naturalTyConKey
isIntTy :: TcType -> Bool
isIntTy = Unique -> TcType -> Bool
is_tc Unique
intTyConKey
isWordTy :: TcType -> Bool
isWordTy = Unique -> TcType -> Bool
is_tc Unique
wordTyConKey
isBoolTy :: TcType -> Bool
isBoolTy = Unique -> TcType -> Bool
is_tc Unique
boolTyConKey
isUnitTy :: TcType -> Bool
isUnitTy = Unique -> TcType -> Bool
is_tc Unique
unitTyConKey
isCharTy :: TcType -> Bool
isCharTy = Unique -> TcType -> Bool
is_tc Unique
charTyConKey
anyTy_maybe :: Type -> Maybe Kind
anyTy_maybe :: TcType -> Maybe TcType
anyTy_maybe TcType
ty
| Just (TyCon
tc, [TcType
k]) <- HasDebugCallStack => TcType -> Maybe (TyCon, [TcType])
TcType -> Maybe (TyCon, [TcType])
splitTyConApp_maybe TcType
ty
, TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
tc Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
anyTyConKey
= TcType -> Maybe TcType
forall a. a -> Maybe a
Just TcType
k
| Bool
otherwise
= Maybe TcType
forall a. Maybe a
Nothing
isFloatingPrimTy :: Type -> Bool
isFloatingPrimTy :: TcType -> Bool
isFloatingPrimTy TcType
ty = TcType -> Bool
isFloatPrimTy TcType
ty Bool -> Bool -> Bool
|| TcType -> Bool
isDoublePrimTy TcType
ty
isStringTy :: Type -> Bool
isStringTy :: TcType -> Bool
isStringTy TcType
ty
= case HasCallStack => TcType -> Maybe (TyCon, [TcType])
TcType -> Maybe (TyCon, [TcType])
tcSplitTyConApp_maybe TcType
ty of
Just (TyCon
tc, [TcType
arg_ty]) -> TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
listTyCon Bool -> Bool -> Bool
&& TcType -> Bool
isCharTy TcType
arg_ty
Maybe (TyCon, [TcType])
_ -> Bool
False
is_tc :: Unique -> Type -> Bool
is_tc :: Unique -> TcType -> Bool
is_tc Unique
uniq TcType
ty = case HasCallStack => TcType -> Maybe (TyCon, [TcType])
TcType -> Maybe (TyCon, [TcType])
tcSplitTyConApp_maybe TcType
ty of
Just (TyCon
tc, [TcType]
_) -> Unique
uniq Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
tc
Maybe (TyCon, [TcType])
Nothing -> Bool
False
isRigidTy :: TcType -> Bool
isRigidTy :: TcType -> Bool
isRigidTy TcType
ty
| Just (TyCon
tc,[TcType]
_) <- HasCallStack => TcType -> Maybe (TyCon, [TcType])
TcType -> Maybe (TyCon, [TcType])
tcSplitTyConApp_maybe TcType
ty = TyCon -> Role -> Bool
isGenerativeTyCon TyCon
tc Role
Nominal
| Just {} <- TcType -> Maybe (TcType, TcType)
tcSplitAppTy_maybe TcType
ty = Bool
True
| TcType -> Bool
isForAllTy TcType
ty = Bool
True
| Bool
otherwise = Bool
False
deNoteType :: Type -> Type
deNoteType :: TcType -> TcType
deNoteType TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
coreView TcType
ty = TcType -> TcType
deNoteType TcType
ty'
deNoteType TcType
ty = TcType
ty
tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type)
tcSplitIOType_maybe :: TcType -> Maybe (TyCon, TcType)
tcSplitIOType_maybe TcType
ty
= case HasCallStack => TcType -> Maybe (TyCon, [TcType])
TcType -> Maybe (TyCon, [TcType])
tcSplitTyConApp_maybe TcType
ty of
Just (TyCon
io_tycon, [TcType
io_res_ty])
| TyCon
io_tycon TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ioTyConKey ->
(TyCon, TcType) -> Maybe (TyCon, TcType)
forall a. a -> Maybe a
Just (TyCon
io_tycon, TcType
io_res_ty)
Maybe (TyCon, [TcType])
_ ->
Maybe (TyCon, TcType)
forall a. Maybe a
Nothing
data IllegalForeignTypeReason
= TypeCannotBeMarshaled !Type TypeCannotBeMarshaledReason
| ForeignDynNotPtr
!Type
!Type
| SafeHaskellMustBeInIO
| IOResultExpected
| UnexpectedNestedForall
| LinearTypesNotAllowed
| OneArgExpected
| AtLeastOneArgExpected
data TypeCannotBeMarshaledReason
= NotADataType
| NewtypeDataConNotInScope !(Maybe TyCon)
| UnliftedFFITypesNeeded
| NotABoxedMarshalableTyCon
| ForeignLabelNotAPtr
| NotSimpleUnliftedType
| NotBoxedKindAny
isFFIArgumentTy :: DynFlags -> Safety -> Type -> Validity' IllegalForeignTypeReason
isFFIArgumentTy :: DynFlags -> Safety -> TcType -> Validity' IllegalForeignTypeReason
isFFIArgumentTy DynFlags
dflags Safety
safety TcType
ty
= (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> TcType -> Validity' IllegalForeignTypeReason
checkRepTyCon (DynFlags
-> Safety -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalOutgoingTyCon DynFlags
dflags Safety
safety) TcType
ty
isFFIExternalTy :: Type -> Validity' IllegalForeignTypeReason
isFFIExternalTy :: TcType -> Validity' IllegalForeignTypeReason
isFFIExternalTy TcType
ty = (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> TcType -> Validity' IllegalForeignTypeReason
checkRepTyCon TyCon -> Validity' TypeCannotBeMarshaledReason
legalFEArgTyCon TcType
ty
isFFIImportResultTy :: DynFlags -> Type -> Validity' IllegalForeignTypeReason
isFFIImportResultTy :: DynFlags -> TcType -> Validity' IllegalForeignTypeReason
isFFIImportResultTy DynFlags
dflags TcType
ty
= (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> TcType -> Validity' IllegalForeignTypeReason
checkRepTyCon (DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIResultTyCon DynFlags
dflags) TcType
ty
isFFIExportResultTy :: Type -> Validity' IllegalForeignTypeReason
isFFIExportResultTy :: TcType -> Validity' IllegalForeignTypeReason
isFFIExportResultTy TcType
ty = (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> TcType -> Validity' IllegalForeignTypeReason
checkRepTyCon TyCon -> Validity' TypeCannotBeMarshaledReason
legalFEResultTyCon TcType
ty
isFFIDynTy :: Type -> Type -> Validity' IllegalForeignTypeReason
isFFIDynTy :: TcType -> TcType -> Validity' IllegalForeignTypeReason
isFFIDynTy TcType
expected TcType
ty
| Just (TyCon
tc, [TcType
ty']) <- HasDebugCallStack => TcType -> Maybe (TyCon, [TcType])
TcType -> Maybe (TyCon, [TcType])
splitTyConApp_maybe TcType
ty
, TyCon -> Unique
tyConUnique TyCon
tc Unique -> [Unique] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Unique
ptrTyConKey, Unique
funPtrTyConKey]
, TcType -> TcType -> Bool
eqType TcType
ty' TcType
expected
= Validity' IllegalForeignTypeReason
forall a. Validity' a
IsValid
| Bool
otherwise
= IllegalForeignTypeReason -> Validity' IllegalForeignTypeReason
forall a. a -> Validity' a
NotValid (TcType -> TcType -> IllegalForeignTypeReason
ForeignDynNotPtr TcType
expected TcType
ty)
isFFILabelTy :: Type -> Validity' IllegalForeignTypeReason
isFFILabelTy :: TcType -> Validity' IllegalForeignTypeReason
isFFILabelTy TcType
ty = (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> TcType -> Validity' IllegalForeignTypeReason
checkRepTyCon TyCon -> Validity' TypeCannotBeMarshaledReason
forall a. Uniquable a => a -> Validity' TypeCannotBeMarshaledReason
ok TcType
ty
where
ok :: a -> Validity' TypeCannotBeMarshaledReason
ok a
tc | a
tc a -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
funPtrTyConKey Bool -> Bool -> Bool
|| a
tc a -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ptrTyConKey
= Validity' TypeCannotBeMarshaledReason
forall a. Validity' a
IsValid
| Bool
otherwise
= TypeCannotBeMarshaledReason
-> Validity' TypeCannotBeMarshaledReason
forall a. a -> Validity' a
NotValid TypeCannotBeMarshaledReason
ForeignLabelNotAPtr
checkAnyTy :: Type -> Maybe (Validity' IllegalForeignTypeReason)
checkAnyTy :: TcType -> Maybe (Validity' IllegalForeignTypeReason)
checkAnyTy TcType
ty
| Just TcType
ki <- TcType -> Maybe TcType
anyTy_maybe TcType
ty
= Validity' IllegalForeignTypeReason
-> Maybe (Validity' IllegalForeignTypeReason)
forall a. a -> Maybe a
Just (Validity' IllegalForeignTypeReason
-> Maybe (Validity' IllegalForeignTypeReason))
-> Validity' IllegalForeignTypeReason
-> Maybe (Validity' IllegalForeignTypeReason)
forall a b. (a -> b) -> a -> b
$
if TcType -> Bool
isBoxedTypeKind TcType
ki
then Validity' IllegalForeignTypeReason
forall a. Validity' a
IsValid
else IllegalForeignTypeReason -> Validity' IllegalForeignTypeReason
forall a. a -> Validity' a
NotValid (TcType -> TypeCannotBeMarshaledReason -> IllegalForeignTypeReason
TypeCannotBeMarshaled TcType
ty TypeCannotBeMarshaledReason
NotBoxedKindAny)
| Bool
otherwise
= Maybe (Validity' IllegalForeignTypeReason)
forall a. Maybe a
Nothing
isFFIPrimArgumentTy :: DynFlags -> Type -> Validity' IllegalForeignTypeReason
isFFIPrimArgumentTy :: DynFlags -> TcType -> Validity' IllegalForeignTypeReason
isFFIPrimArgumentTy DynFlags
dflags TcType
ty
| Just Validity' IllegalForeignTypeReason
validity <- TcType -> Maybe (Validity' IllegalForeignTypeReason)
checkAnyTy TcType
ty
= Validity' IllegalForeignTypeReason
validity
| Bool
otherwise
= (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> TcType -> Validity' IllegalForeignTypeReason
checkRepTyCon (DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIPrimArgTyCon DynFlags
dflags) TcType
ty
isFFIPrimResultTy :: DynFlags -> Type -> Validity' IllegalForeignTypeReason
isFFIPrimResultTy :: DynFlags -> TcType -> Validity' IllegalForeignTypeReason
isFFIPrimResultTy DynFlags
dflags TcType
ty
| Just Validity' IllegalForeignTypeReason
validity <- TcType -> Maybe (Validity' IllegalForeignTypeReason)
checkAnyTy TcType
ty
= Validity' IllegalForeignTypeReason
validity
| Bool
otherwise
= (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> TcType -> Validity' IllegalForeignTypeReason
checkRepTyCon (DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIPrimResultTyCon DynFlags
dflags) TcType
ty
isFunPtrTy :: Type -> Bool
isFunPtrTy :: TcType -> Bool
isFunPtrTy TcType
ty
| Just (TyCon
tc, [TcType
_]) <- HasDebugCallStack => TcType -> Maybe (TyCon, [TcType])
TcType -> Maybe (TyCon, [TcType])
splitTyConApp_maybe TcType
ty
= TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
funPtrTyConKey
| Bool
otherwise
= Bool
False
checkRepTyCon
:: (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> Type
-> Validity' IllegalForeignTypeReason
checkRepTyCon :: (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> TcType -> Validity' IllegalForeignTypeReason
checkRepTyCon TyCon -> Validity' TypeCannotBeMarshaledReason
check_tc TcType
ty
= (TypeCannotBeMarshaledReason -> IllegalForeignTypeReason)
-> Validity' TypeCannotBeMarshaledReason
-> Validity' IllegalForeignTypeReason
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TcType -> TypeCannotBeMarshaledReason -> IllegalForeignTypeReason
TypeCannotBeMarshaled TcType
ty) (Validity' TypeCannotBeMarshaledReason
-> Validity' IllegalForeignTypeReason)
-> Validity' TypeCannotBeMarshaledReason
-> Validity' IllegalForeignTypeReason
forall a b. (a -> b) -> a -> b
$ case HasDebugCallStack => TcType -> Maybe (TyCon, [TcType])
TcType -> Maybe (TyCon, [TcType])
splitTyConApp_maybe TcType
ty of
Just (TyCon
tc, [TcType]
tys)
| TyCon -> Bool
isNewTyCon TyCon
tc -> TypeCannotBeMarshaledReason
-> Validity' TypeCannotBeMarshaledReason
forall a. a -> Validity' a
NotValid (TyCon -> [TcType] -> TypeCannotBeMarshaledReason
forall (t :: * -> *) a.
Foldable t =>
TyCon -> t a -> TypeCannotBeMarshaledReason
mk_nt_reason TyCon
tc [TcType]
tys)
| Bool
otherwise -> TyCon -> Validity' TypeCannotBeMarshaledReason
check_tc TyCon
tc
Maybe (TyCon, [TcType])
Nothing -> TypeCannotBeMarshaledReason
-> Validity' TypeCannotBeMarshaledReason
forall a. a -> Validity' a
NotValid TypeCannotBeMarshaledReason
NotADataType
where
mk_nt_reason :: TyCon -> t a -> TypeCannotBeMarshaledReason
mk_nt_reason TyCon
tc t a
tys
| t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
tys = Maybe TyCon -> TypeCannotBeMarshaledReason
NewtypeDataConNotInScope Maybe TyCon
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe TyCon -> TypeCannotBeMarshaledReason
NewtypeDataConNotInScope (TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just TyCon
tc)
legalFEArgTyCon :: TyCon -> Validity' TypeCannotBeMarshaledReason
legalFEArgTyCon :: TyCon -> Validity' TypeCannotBeMarshaledReason
legalFEArgTyCon TyCon
tc
= TyCon -> Validity' TypeCannotBeMarshaledReason
boxedMarshalableTyCon TyCon
tc
legalFIResultTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIResultTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIResultTyCon DynFlags
dflags TyCon
tc
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
unitTyCon = Validity' TypeCannotBeMarshaledReason
forall a. Validity' a
IsValid
| Bool
otherwise = DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
marshalableTyCon DynFlags
dflags TyCon
tc
legalFEResultTyCon :: TyCon -> Validity' TypeCannotBeMarshaledReason
legalFEResultTyCon :: TyCon -> Validity' TypeCannotBeMarshaledReason
legalFEResultTyCon TyCon
tc
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
unitTyCon = Validity' TypeCannotBeMarshaledReason
forall a. Validity' a
IsValid
| Bool
otherwise = TyCon -> Validity' TypeCannotBeMarshaledReason
boxedMarshalableTyCon TyCon
tc
legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalOutgoingTyCon :: DynFlags
-> Safety -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalOutgoingTyCon DynFlags
dflags Safety
_ TyCon
tc
= DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
marshalableTyCon DynFlags
dflags TyCon
tc
marshalablePrimTyCon :: TyCon -> Bool
marshalablePrimTyCon :: TyCon -> Bool
marshalablePrimTyCon TyCon
tc = TyCon -> Bool
isPrimTyCon TyCon
tc Bool -> Bool -> Bool
&& Bool -> Bool
not (TcType -> Bool
isLiftedTypeKind (TyCon -> TcType
tyConResKind TyCon
tc))
marshalableTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
marshalableTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
marshalableTyCon DynFlags
dflags TyCon
tc
| TyCon -> Bool
marshalablePrimTyCon TyCon
tc
, Bool -> Bool
not ([PrimRep] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (HasDebugCallStack => TyCon -> [PrimRep]
TyCon -> [PrimRep]
tyConPrimRep TyCon
tc))
= DynFlags -> Validity' TypeCannotBeMarshaledReason
validIfUnliftedFFITypes DynFlags
dflags
| Bool
otherwise
= TyCon -> Validity' TypeCannotBeMarshaledReason
boxedMarshalableTyCon TyCon
tc
boxedMarshalableTyCon :: TyCon -> Validity' TypeCannotBeMarshaledReason
boxedMarshalableTyCon :: TyCon -> Validity' TypeCannotBeMarshaledReason
boxedMarshalableTyCon TyCon
tc
| TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
tc Unique -> [Unique] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Unique
intTyConKey, Unique
int8TyConKey, Unique
int16TyConKey
, Unique
int32TyConKey, Unique
int64TyConKey
, Unique
wordTyConKey, Unique
word8TyConKey, Unique
word16TyConKey
, Unique
word32TyConKey, Unique
word64TyConKey
, Unique
floatTyConKey, Unique
doubleTyConKey
, Unique
ptrTyConKey, Unique
funPtrTyConKey
, Unique
charTyConKey
, Unique
stablePtrTyConKey
, Unique
boolTyConKey
]
= Validity' TypeCannotBeMarshaledReason
forall a. Validity' a
IsValid
| Bool
otherwise = TypeCannotBeMarshaledReason
-> Validity' TypeCannotBeMarshaledReason
forall a. a -> Validity' a
NotValid TypeCannotBeMarshaledReason
NotABoxedMarshalableTyCon
legalFIPrimArgTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIPrimArgTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIPrimArgTyCon DynFlags
dflags TyCon
tc
| TyCon -> Bool
marshalablePrimTyCon TyCon
tc
= DynFlags -> Validity' TypeCannotBeMarshaledReason
validIfUnliftedFFITypes DynFlags
dflags
| Bool
otherwise
= TypeCannotBeMarshaledReason
-> Validity' TypeCannotBeMarshaledReason
forall a. a -> Validity' a
NotValid TypeCannotBeMarshaledReason
NotSimpleUnliftedType
legalFIPrimResultTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIPrimResultTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIPrimResultTyCon DynFlags
dflags TyCon
tc
| TyCon -> Bool
marshalablePrimTyCon TyCon
tc
, Bool -> Bool
not ([PrimRep] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (HasDebugCallStack => TyCon -> [PrimRep]
TyCon -> [PrimRep]
tyConPrimRep TyCon
tc))
= DynFlags -> Validity' TypeCannotBeMarshaledReason
validIfUnliftedFFITypes DynFlags
dflags
| TyCon -> Bool
isUnboxedTupleTyCon TyCon
tc Bool -> Bool -> Bool
|| TyCon -> Bool
isUnboxedSumTyCon TyCon
tc
= DynFlags -> Validity' TypeCannotBeMarshaledReason
validIfUnliftedFFITypes DynFlags
dflags
| Bool
otherwise
= TypeCannotBeMarshaledReason
-> Validity' TypeCannotBeMarshaledReason
forall a. a -> Validity' a
NotValid (TypeCannotBeMarshaledReason
-> Validity' TypeCannotBeMarshaledReason)
-> TypeCannotBeMarshaledReason
-> Validity' TypeCannotBeMarshaledReason
forall a b. (a -> b) -> a -> b
$ TypeCannotBeMarshaledReason
NotSimpleUnliftedType
validIfUnliftedFFITypes :: DynFlags -> Validity' TypeCannotBeMarshaledReason
validIfUnliftedFFITypes :: DynFlags -> Validity' TypeCannotBeMarshaledReason
validIfUnliftedFFITypes DynFlags
dflags
| Extension -> DynFlags -> Bool
xopt Extension
LangExt.UnliftedFFITypes DynFlags
dflags = Validity' TypeCannotBeMarshaledReason
forall a. Validity' a
IsValid
| Bool
otherwise = TypeCannotBeMarshaledReason
-> Validity' TypeCannotBeMarshaledReason
forall a. a -> Validity' a
NotValid TypeCannotBeMarshaledReason
UnliftedFFITypesNeeded
type TypeSize = IntWithInf
sizeType :: Type -> TypeSize
sizeType :: TcType -> TypeSize
sizeType = TcType -> TypeSize
go
where
go :: TcType -> TypeSize
go TcType
ty | Just TcType
exp_ty <- TcType -> Maybe TcType
tcView TcType
ty = TcType -> TypeSize
go TcType
exp_ty
go (TyVarTy {}) = TypeSize
1
go (TyConApp TyCon
tc [TcType]
tys)
| TyCon -> Bool
isTypeFamilyTyCon TyCon
tc = TypeSize
infinity
| Bool
otherwise = [TcType] -> TypeSize
sizeTypes (TyCon -> [TcType] -> [TcType]
filterOutInvisibleTypes TyCon
tc [TcType]
tys) TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ TypeSize
1
go (LitTy {}) = TypeSize
1
go (FunTy AnonArgFlag
_ TcType
w TcType
arg TcType
res) = TcType -> TypeSize
go TcType
w TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ TcType -> TypeSize
go TcType
arg TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ TcType -> TypeSize
go TcType
res TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ TypeSize
1
go (AppTy TcType
fun TcType
arg) = TcType -> TypeSize
go TcType
fun TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ TcType -> TypeSize
go TcType
arg
go (ForAllTy (Bndr TcTyVar
tv ArgFlag
vis) TcType
ty)
| ArgFlag -> Bool
isVisibleArgFlag ArgFlag
vis = TcType -> TypeSize
go (TcTyVar -> TcType
tyVarKind TcTyVar
tv) TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ TcType -> TypeSize
go TcType
ty TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ TypeSize
1
| Bool
otherwise = TcType -> TypeSize
go TcType
ty TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ TypeSize
1
go (CastTy TcType
ty KindCoercion
_) = TcType -> TypeSize
go TcType
ty
go (CoercionTy {}) = TypeSize
0
sizeTypes :: [Type] -> TypeSize
sizeTypes :: [TcType] -> TypeSize
sizeTypes [TcType]
tys = [TypeSize] -> TypeSize
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((TcType -> TypeSize) -> [TcType] -> [TypeSize]
forall a b. (a -> b) -> [a] -> [b]
map TcType -> TypeSize
sizeType [TcType]
tys)
tcTyConVisibilities :: TyCon -> [Bool]
tcTyConVisibilities :: TyCon -> [Bool]
tcTyConVisibilities TyCon
tc = [Bool]
tc_binder_viss [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool]
tc_return_kind_viss [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True
where
tc_binder_viss :: [Bool]
tc_binder_viss = (TyConBinder -> Bool) -> [TyConBinder] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map TyConBinder -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isVisibleTyConBinder (TyCon -> [TyConBinder]
tyConBinders TyCon
tc)
tc_return_kind_viss :: [Bool]
tc_return_kind_viss = (TyBinder -> Bool) -> [TyBinder] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map TyBinder -> Bool
isVisibleBinder (([TyBinder], TcType) -> [TyBinder]
forall a b. (a, b) -> a
fst (([TyBinder], TcType) -> [TyBinder])
-> ([TyBinder], TcType) -> [TyBinder]
forall a b. (a -> b) -> a -> b
$ TcType -> ([TyBinder], TcType)
tcSplitPiTys (TyCon -> TcType
tyConResKind TyCon
tc))
isNextTyConArgVisible :: TyCon -> [Type] -> Bool
isNextTyConArgVisible :: TyCon -> [TcType] -> Bool
isNextTyConArgVisible TyCon
tc [TcType]
tys
= TyCon -> [Bool]
tcTyConVisibilities TyCon
tc [Bool] -> Int -> Bool
forall a. Outputable a => [a] -> Int -> a
`getNth` [TcType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TcType]
tys
isNextArgVisible :: TcType -> Bool
isNextArgVisible :: TcType -> Bool
isNextArgVisible TcType
ty
| Just (TyBinder
bndr, TcType
_) <- TcType -> Maybe (TyBinder, TcType)
tcSplitPiTy_maybe TcType
ty = TyBinder -> Bool
isVisibleBinder TyBinder
bndr
| Bool
otherwise = Bool
True