{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Tc.Utils.TcType (
TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
TcTyVar, TcTyVarSet, TcDTyVarSet, TcTyCoVarSet, TcDTyCoVarSet,
TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcInvisTVBinder, TcReqTVBinder,
TcTyCon, KnotTied,
ExpType(..), InferResult(..), ExpSigmaType, ExpRhoType, mkCheckExpType,
SyntaxOpType(..), synKnownType, mkSynFunTys,
TcLevel(..), topTcLevel, pushTcLevel, isTopTcLevel,
strictlyDeeperThan, deeperThanOrSame, sameDepthAs,
tcTypeLevel, tcTyVarLevel, maxTcLevel,
promoteSkolem, promoteSkolemX, promoteSkolemsX,
TcTyVarDetails(..), pprTcTyVarDetails, vanillaSkolemTv, superSkolemTv,
MetaDetails(Flexi, Indirect), MetaInfo(..),
isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isMetaTyVarTy, isTyVarTy,
tcIsTcTyVar, isTyVarTyVar, isOverlappableTyVar, isTyConableTyVar,
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,
isFloatingTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
isIntegerTy, isNaturalTy,
isBoolTy, isUnitTy, isCharTy, isCallStackTy, isCallStackPred,
isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,
isPredTy, isTyVarClassPred,
checkValidClsArgs, hasTyVarHead,
isRigidTy,
deNoteType,
orphNamesOfType, orphNamesOfCo,
orphNamesOfTypes, orphNamesOfCoCon,
getDFunTyKey, evVarPred,
mkMinimalBySCs, transSuperClasses,
pickQuantifiablePreds, pickCapturedPreds,
immSuperClasses, boxEqPred,
isImprovementPred,
tcTyFamInsts, tcTyFamInstsAndVis, tcTyConAppTyFamInstsAndVis, isTyFamFree,
exactTyCoVarsOfType, exactTyCoVarsOfTypes,
anyRewritableTyVar, anyRewritableTyFamApp, anyRewritableCanEqLHS,
isFFIArgumentTy,
isFFIImportResultTy,
isFFIExportResultTy,
isFFIExternalTy,
isFFIDynTy,
isFFIPrimArgumentTy,
isFFIPrimResultTy,
isFFILabelTy,
isFFITy,
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, isKindLevPoly,
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
#include "HsVersions.h"
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 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.Data.FastString
import GHC.Utils.Error( Validity(..), isValid )
import qualified GHC.LanguageExtensions as LangExt
import Data.List ( mapAccumL )
import Data.IORef
import Data.List.NonEmpty( NonEmpty(..) )
type TcCoVar = CoVar
type TcType = Type
type TcTyCoVar = Var
type TcTyVarBinder = TyVarBinder
type TcInvisTVBinder = InvisTVBinder
type TcReqTVBinder = ReqTVBinder
type TcTyCon = TyCon
type TcPredType = PredType
type TcThetaType = ThetaType
type TcSigmaType = TcType
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 -> IORef (Maybe Type)
ir_ref :: IORef (Maybe TcType) }
type ExpSigmaType = ExpType
type ExpRhoType = ExpType
instance Outputable ExpType where
ppr :: ExpType -> SDoc
ppr (Check Type
ty) = String -> SDoc
text String
"Check" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (forall a. Outputable a => a -> SDoc
ppr Type
ty)
ppr (Infer InferResult
ir) = 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 })
= String -> SDoc
text String
"Infer" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (forall a. Outputable a => a -> SDoc
ppr Unique
u SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr TcLevel
lvl)
mkCheckExpType :: TcType -> ExpType
mkCheckExpType :: Type -> ExpType
mkCheckExpType = Type -> ExpType
Check
data SyntaxOpType
= SynAny
| SynRho
| SynList
| SynFun SyntaxOpType SyntaxOpType
| SynType ExpType
infixr 0 `SynFun`
synKnownType :: TcType -> SyntaxOpType
synKnownType :: Type -> SyntaxOpType
synKnownType = ExpType -> SyntaxOpType
SynType forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> ExpType
mkCheckExpType
mkSynFunTys :: [SyntaxOpType] -> ExpType -> SyntaxOpType
mkSynFunTys :: [SyntaxOpType] -> ExpType -> SyntaxOpType
mkSynFunTys [SyntaxOpType]
arg_tys ExpType
res_ty = 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
TcLevel
Bool
| RuntimeUnk
| MetaTv { TcTyVarDetails -> MetaInfo
mtv_info :: MetaInfo
, TcTyVarDetails -> IORef MetaDetails
mtv_ref :: IORef MetaDetails
, TcTyVarDetails -> TcLevel
mtv_tclvl :: TcLevel }
vanillaSkolemTv, superSkolemTv :: TcTyVarDetails
vanillaSkolemTv :: TcTyVarDetails
vanillaSkolemTv = TcLevel -> Bool -> TcTyVarDetails
SkolemTv TcLevel
topTcLevel Bool
False
superSkolemTv :: TcTyVarDetails
superSkolemTv = TcLevel -> Bool -> TcTyVarDetails
SkolemTv TcLevel
topTcLevel Bool
True
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 TcLevel
lvl Bool
True) = String -> SDoc
text String
"ssk" SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr TcLevel
lvl
pprTcTyVarDetails (SkolemTv TcLevel
lvl Bool
False) = String -> SDoc
text String
"sk" SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> 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 })
= forall a. Outputable a => a -> SDoc
ppr MetaInfo
info SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr TcLevel
tclvl
data MetaDetails
= Flexi
| Indirect TcType
data MetaInfo
= TauTv
| TyVarTv
| RuntimeUnkTv
| CycleBreakerTv
instance Outputable MetaDetails where
ppr :: MetaDetails -> SDoc
ppr MetaDetails
Flexi = String -> SDoc
text String
"Flexi"
ppr (Indirect Type
ty) = String -> SDoc
text String
"Indirect" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Type
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"
newtype TcLevel = TcLevel Int deriving( TcLevel -> TcLevel -> Bool
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
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
Ord )
maxTcLevel :: TcLevel -> TcLevel -> TcLevel
maxTcLevel :: TcLevel -> TcLevel -> TcLevel
maxTcLevel (TcLevel Arity
a) (TcLevel Arity
b) = Arity -> TcLevel
TcLevel (Arity
a forall a. Ord a => a -> a -> a
`max` Arity
b)
topTcLevel :: TcLevel
topTcLevel :: TcLevel
topTcLevel = Arity -> TcLevel
TcLevel Arity
0
isTopTcLevel :: TcLevel -> Bool
isTopTcLevel :: TcLevel -> Bool
isTopTcLevel (TcLevel Arity
0) = Bool
True
isTopTcLevel TcLevel
_ = Bool
False
pushTcLevel :: TcLevel -> TcLevel
pushTcLevel :: TcLevel -> TcLevel
pushTcLevel (TcLevel Arity
us) = Arity -> TcLevel
TcLevel (Arity
us forall a. Num a => a -> a -> a
+ Arity
1)
strictlyDeeperThan :: TcLevel -> TcLevel -> Bool
strictlyDeeperThan :: TcLevel -> TcLevel -> Bool
strictlyDeeperThan (TcLevel Arity
tv_tclvl) (TcLevel Arity
ctxt_tclvl)
= Arity
tv_tclvl forall a. Ord a => a -> a -> Bool
> Arity
ctxt_tclvl
deeperThanOrSame :: TcLevel -> TcLevel -> Bool
deeperThanOrSame :: TcLevel -> TcLevel -> Bool
deeperThanOrSame (TcLevel Arity
tv_tclvl) (TcLevel Arity
ctxt_tclvl)
= Arity
tv_tclvl forall a. Ord a => a -> a -> Bool
>= Arity
ctxt_tclvl
sameDepthAs :: TcLevel -> TcLevel -> Bool
sameDepthAs :: TcLevel -> TcLevel -> Bool
sameDepthAs (TcLevel Arity
ctxt_tclvl) (TcLevel Arity
tv_tclvl)
= Arity
ctxt_tclvl forall a. Eq a => a -> a -> Bool
== Arity
tv_tclvl
checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool
checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool
checkTcLevelInvariant (TcLevel Arity
ctxt_tclvl) (TcLevel Arity
tv_tclvl)
= Arity
ctxt_tclvl forall a. Ord a => a -> a -> Bool
>= Arity
tv_tclvl
tcTyVarLevel :: TcTyVar -> TcLevel
tcTyVarLevel :: Var -> TcLevel
tcTyVarLevel Var
tv
= case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
MetaTv { mtv_tclvl :: TcTyVarDetails -> TcLevel
mtv_tclvl = TcLevel
tv_lvl } -> TcLevel
tv_lvl
SkolemTv TcLevel
tv_lvl Bool
_ -> TcLevel
tv_lvl
TcTyVarDetails
RuntimeUnk -> TcLevel
topTcLevel
tcTypeLevel :: TcType -> TcLevel
tcTypeLevel :: Type -> TcLevel
tcTypeLevel Type
ty
= forall a. (Var -> a -> a) -> a -> DVarSet -> a
nonDetStrictFoldDVarSet Var -> TcLevel -> TcLevel
add TcLevel
topTcLevel (Type -> DVarSet
tyCoVarsOfTypeDSet Type
ty)
where
add :: Var -> TcLevel -> TcLevel
add Var
v TcLevel
lvl
| Var -> Bool
isTcTyVar Var
v = TcLevel
lvl TcLevel -> TcLevel -> TcLevel
`maxTcLevel` Var -> TcLevel
tcTyVarLevel Var
v
| Bool
otherwise = TcLevel
lvl
instance Outputable TcLevel where
ppr :: TcLevel -> SDoc
ppr (TcLevel Arity
us) = forall a. Outputable a => a -> SDoc
ppr Arity
us
promoteSkolem :: TcLevel -> TcTyVar -> TcTyVar
promoteSkolem :: TcLevel -> Var -> Var
promoteSkolem TcLevel
tclvl Var
skol
| TcLevel
tclvl forall a. Ord a => a -> a -> Bool
< Var -> TcLevel
tcTyVarLevel Var
skol
= ASSERT( isTcTyVar skol && isSkolemTyVar skol )
Var -> TcTyVarDetails -> Var
setTcTyVarDetails Var
skol (TcLevel -> Bool -> TcTyVarDetails
SkolemTv TcLevel
tclvl (Var -> Bool
isOverlappableTyVar Var
skol))
| Bool
otherwise
= Var
skol
promoteSkolemX :: TcLevel -> TCvSubst -> TcTyVar -> (TCvSubst, TcTyVar)
promoteSkolemX :: TcLevel -> TCvSubst -> Var -> (TCvSubst, Var)
promoteSkolemX TcLevel
tclvl TCvSubst
subst Var
skol
= ASSERT( isTcTyVar skol && isSkolemTyVar skol )
(TCvSubst
new_subst, Var
new_skol)
where
new_skol :: Var
new_skol
| TcLevel
tclvl forall a. Ord a => a -> a -> Bool
< Var -> TcLevel
tcTyVarLevel Var
skol
= Var -> TcTyVarDetails -> Var
setTcTyVarDetails ((Type -> Type) -> Var -> Var
updateTyVarKind (HasCallStack => TCvSubst -> Type -> Type
substTy TCvSubst
subst) Var
skol)
(TcLevel -> Bool -> TcTyVarDetails
SkolemTv TcLevel
tclvl (Var -> Bool
isOverlappableTyVar Var
skol))
| Bool
otherwise
= (Type -> Type) -> Var -> Var
updateTyVarKind (HasCallStack => TCvSubst -> Type -> Type
substTy TCvSubst
subst) Var
skol
new_subst :: TCvSubst
new_subst = TCvSubst -> Var -> Var -> TCvSubst
extendTvSubstWithClone TCvSubst
subst Var
skol Var
new_skol
promoteSkolemsX :: TcLevel -> TCvSubst -> [TcTyVar] -> (TCvSubst, [TcTyVar])
promoteSkolemsX :: TcLevel -> TCvSubst -> [Var] -> (TCvSubst, [Var])
promoteSkolemsX TcLevel
tclvl = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (TcLevel -> TCvSubst -> Var -> (TCvSubst, Var)
promoteSkolemX TcLevel
tclvl)
tcTyFamInsts :: Type -> [(TyCon, [Type])]
tcTyFamInsts :: Type -> [(TyCon, [Type])]
tcTyFamInsts = forall a b. (a -> b) -> [a] -> [b]
map (\(Bool
_,TyCon
b,[Type]
c) -> (TyCon
b,[Type]
c)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVis
tcTyFamInstsAndVis :: Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVis :: Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVis = Bool -> Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVisX Bool
False
tcTyFamInstsAndVisX
:: Bool
-> Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVisX :: Bool -> Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVisX = Bool -> Type -> [(Bool, TyCon, [Type])]
go
where
go :: Bool -> Type -> [(Bool, TyCon, [Type])]
go Bool
is_invis_arg Type
ty
| Just Type
exp_ty <- Type -> Maybe Type
tcView Type
ty = Bool -> Type -> [(Bool, TyCon, [Type])]
go Bool
is_invis_arg Type
exp_ty
go Bool
_ (TyVarTy Var
_) = []
go Bool
is_invis_arg (TyConApp TyCon
tc [Type]
tys)
| TyCon -> Bool
isTypeFamilyTyCon TyCon
tc
= [(Bool
is_invis_arg, TyCon
tc, forall a. Arity -> [a] -> [a]
take (TyCon -> Arity
tyConArity TyCon
tc) [Type]
tys)]
| Bool
otherwise
= Bool -> TyCon -> [Type] -> [(Bool, TyCon, [Type])]
tcTyConAppTyFamInstsAndVisX Bool
is_invis_arg TyCon
tc [Type]
tys
go Bool
_ (LitTy {}) = []
go Bool
is_invis_arg (ForAllTy TyCoVarBinder
bndr Type
ty) = Bool -> Type -> [(Bool, TyCon, [Type])]
go Bool
is_invis_arg (forall argf. VarBndr Var argf -> Type
binderType TyCoVarBinder
bndr)
forall a. [a] -> [a] -> [a]
++ Bool -> Type -> [(Bool, TyCon, [Type])]
go Bool
is_invis_arg Type
ty
go Bool
is_invis_arg (FunTy AnonArgFlag
_ Type
w Type
ty1 Type
ty2) = Bool -> Type -> [(Bool, TyCon, [Type])]
go Bool
is_invis_arg Type
w
forall a. [a] -> [a] -> [a]
++ Bool -> Type -> [(Bool, TyCon, [Type])]
go Bool
is_invis_arg Type
ty1
forall a. [a] -> [a] -> [a]
++ Bool -> Type -> [(Bool, TyCon, [Type])]
go Bool
is_invis_arg Type
ty2
go Bool
is_invis_arg ty :: Type
ty@(AppTy Type
_ Type
_) =
let (Type
ty_head, [Type]
ty_args) = Type -> (Type, [Type])
splitAppTys Type
ty
ty_arg_flags :: [ArgFlag]
ty_arg_flags = Type -> [Type] -> [ArgFlag]
appTyArgFlags Type
ty_head [Type]
ty_args
in Bool -> Type -> [(Bool, TyCon, [Type])]
go Bool
is_invis_arg Type
ty_head
forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ArgFlag
flag -> Bool -> Type -> [(Bool, TyCon, [Type])]
go (ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
flag))
[ArgFlag]
ty_arg_flags [Type]
ty_args)
go Bool
is_invis_arg (CastTy Type
ty KindCoercion
_) = Bool -> Type -> [(Bool, TyCon, [Type])]
go Bool
is_invis_arg Type
ty
go Bool
_ (CoercionTy KindCoercion
_) = []
tcTyConAppTyFamInstsAndVis :: TyCon -> [Type] -> [(Bool, TyCon, [Type])]
tcTyConAppTyFamInstsAndVis :: TyCon -> [Type] -> [(Bool, TyCon, [Type])]
tcTyConAppTyFamInstsAndVis = Bool -> TyCon -> [Type] -> [(Bool, TyCon, [Type])]
tcTyConAppTyFamInstsAndVisX Bool
False
tcTyConAppTyFamInstsAndVisX
:: Bool
-> TyCon -> [Type] -> [(Bool, TyCon, [Type])]
tcTyConAppTyFamInstsAndVisX :: Bool -> TyCon -> [Type] -> [(Bool, TyCon, [Type])]
tcTyConAppTyFamInstsAndVisX Bool
is_invis_arg TyCon
tc [Type]
tys =
let ([Type]
invis_tys, [Type]
vis_tys) = TyCon -> [Type] -> ([Type], [Type])
partitionInvisibleTypes TyCon
tc [Type]
tys
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVisX Bool
True) [Type]
invis_tys
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVisX Bool
is_invis_arg) [Type]
vis_tys
isTyFamFree :: Type -> Bool
isTyFamFree :: Type -> Bool
isTyFamFree = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> [(TyCon, [Type])]
tcTyFamInsts
any_rewritable :: Bool
-> EqRel
-> (EqRel -> TcTyVar -> Bool)
-> (EqRel -> TyCon -> [TcType] -> Bool)
-> (TyCon -> Bool)
-> TcType -> Bool
{-# INLINE any_rewritable #-}
any_rewritable :: Bool
-> EqRel
-> (EqRel -> Var -> Bool)
-> (EqRel -> TyCon -> [Type] -> Bool)
-> (TyCon -> Bool)
-> Type
-> Bool
any_rewritable Bool
ignore_cos EqRel
role EqRel -> Var -> Bool
tv_pred EqRel -> TyCon -> [Type] -> Bool
tc_pred TyCon -> Bool
should_expand
= EqRel -> VarSet -> Type -> Bool
go EqRel
role VarSet
emptyVarSet
where
go_tv :: EqRel -> VarSet -> Var -> Bool
go_tv EqRel
rl VarSet
bvs Var
tv | Var
tv Var -> VarSet -> Bool
`elemVarSet` VarSet
bvs = Bool
False
| Bool
otherwise = EqRel -> Var -> Bool
tv_pred EqRel
rl Var
tv
go :: EqRel -> VarSet -> Type -> Bool
go EqRel
rl VarSet
bvs ty :: Type
ty@(TyConApp TyCon
tc [Type]
tys)
| TyCon -> Bool
isTypeSynonymTyCon TyCon
tc
, TyCon -> Bool
should_expand TyCon
tc
, Just Type
ty' <- Type -> Maybe Type
tcView Type
ty
= EqRel -> VarSet -> Type -> Bool
go EqRel
rl VarSet
bvs Type
ty'
| EqRel -> TyCon -> [Type] -> Bool
tc_pred EqRel
rl TyCon
tc [Type]
tys
= Bool
True
| Bool
otherwise
= EqRel -> VarSet -> TyCon -> [Type] -> Bool
go_tc EqRel
rl VarSet
bvs TyCon
tc [Type]
tys
go EqRel
rl VarSet
bvs (TyVarTy Var
tv) = EqRel -> VarSet -> Var -> Bool
go_tv EqRel
rl VarSet
bvs Var
tv
go EqRel
_ VarSet
_ (LitTy {}) = Bool
False
go EqRel
rl VarSet
bvs (AppTy Type
fun Type
arg) = EqRel -> VarSet -> Type -> Bool
go EqRel
rl VarSet
bvs Type
fun Bool -> Bool -> Bool
|| EqRel -> VarSet -> Type -> Bool
go EqRel
NomEq VarSet
bvs Type
arg
go EqRel
rl VarSet
bvs (FunTy AnonArgFlag
_ Type
w Type
arg Type
res) = EqRel -> VarSet -> Type -> Bool
go EqRel
NomEq VarSet
bvs Type
arg_rep Bool -> Bool -> Bool
|| EqRel -> VarSet -> Type -> Bool
go EqRel
NomEq VarSet
bvs Type
res_rep Bool -> Bool -> Bool
||
EqRel -> VarSet -> Type -> Bool
go EqRel
rl VarSet
bvs Type
arg Bool -> Bool -> Bool
|| EqRel -> VarSet -> Type -> Bool
go EqRel
rl VarSet
bvs Type
res Bool -> Bool -> Bool
|| EqRel -> VarSet -> Type -> Bool
go EqRel
NomEq VarSet
bvs Type
w
where arg_rep :: Type
arg_rep = HasDebugCallStack => Type -> Type
getRuntimeRep Type
arg
res_rep :: Type
res_rep = HasDebugCallStack => Type -> Type
getRuntimeRep Type
res
go EqRel
rl VarSet
bvs (ForAllTy TyCoVarBinder
tv Type
ty) = EqRel -> VarSet -> Type -> Bool
go EqRel
rl (VarSet
bvs VarSet -> Var -> VarSet
`extendVarSet` forall tv argf. VarBndr tv argf -> tv
binderVar TyCoVarBinder
tv) Type
ty
go EqRel
rl VarSet
bvs (CastTy Type
ty KindCoercion
co) = EqRel -> VarSet -> Type -> Bool
go EqRel
rl VarSet
bvs Type
ty Bool -> Bool -> Bool
|| EqRel -> VarSet -> KindCoercion -> Bool
go_co EqRel
rl VarSet
bvs KindCoercion
co
go EqRel
rl VarSet
bvs (CoercionTy KindCoercion
co) = EqRel -> VarSet -> KindCoercion -> Bool
go_co EqRel
rl VarSet
bvs KindCoercion
co
go_tc :: EqRel -> VarSet -> TyCon -> [Type] -> Bool
go_tc EqRel
NomEq VarSet
bvs TyCon
_ [Type]
tys = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (EqRel -> VarSet -> Type -> Bool
go EqRel
NomEq VarSet
bvs) [Type]
tys
go_tc EqRel
ReprEq VarSet
bvs TyCon
tc [Type]
tys = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (VarSet -> (Role, Type) -> Bool
go_arg VarSet
bvs)
(TyCon -> [Role]
tyConRolesRepresentational TyCon
tc forall a b. [a] -> [b] -> [(a, b)]
`zip` [Type]
tys)
go_arg :: VarSet -> (Role, Type) -> Bool
go_arg VarSet
bvs (Role
Nominal, Type
ty) = EqRel -> VarSet -> Type -> Bool
go EqRel
NomEq VarSet
bvs Type
ty
go_arg VarSet
bvs (Role
Representational, Type
ty) = EqRel -> VarSet -> Type -> Bool
go EqRel
ReprEq VarSet
bvs Type
ty
go_arg VarSet
_ (Role
Phantom, Type
_) = Bool
False
go_co :: EqRel -> VarSet -> KindCoercion -> Bool
go_co EqRel
rl VarSet
bvs KindCoercion
co
| Bool
ignore_cos = Bool
False
| Bool
otherwise = (Var -> Bool) -> VarSet -> Bool
anyVarSet (EqRel -> VarSet -> Var -> Bool
go_tv EqRel
rl VarSet
bvs) (KindCoercion -> VarSet
tyCoVarsOfCo KindCoercion
co)
anyRewritableTyVar :: Bool
-> EqRel
-> (EqRel -> TcTyVar -> Bool)
-> TcType -> Bool
anyRewritableTyVar :: Bool -> EqRel -> (EqRel -> Var -> Bool) -> Type -> Bool
anyRewritableTyVar Bool
ignore_cos EqRel
role EqRel -> Var -> Bool
pred
= Bool
-> EqRel
-> (EqRel -> Var -> Bool)
-> (EqRel -> TyCon -> [Type] -> Bool)
-> (TyCon -> Bool)
-> Type
-> Bool
any_rewritable Bool
ignore_cos EqRel
role EqRel -> Var -> Bool
pred
(\ EqRel
_ TyCon
_ [Type]
_ -> Bool
False)
(\ TyCon
_ -> Bool
False)
anyRewritableTyFamApp :: EqRel
-> (EqRel -> TyCon -> [TcType] -> Bool)
-> TcType -> Bool
anyRewritableTyFamApp :: EqRel -> (EqRel -> TyCon -> [Type] -> Bool) -> Type -> Bool
anyRewritableTyFamApp EqRel
role EqRel -> TyCon -> [Type] -> Bool
check_tyconapp
= Bool
-> EqRel
-> (EqRel -> Var -> Bool)
-> (EqRel -> TyCon -> [Type] -> Bool)
-> (TyCon -> Bool)
-> Type
-> Bool
any_rewritable Bool
True EqRel
role (\ EqRel
_ Var
_ -> Bool
False) EqRel -> TyCon -> [Type] -> Bool
check_tyconapp (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Bool
isFamFreeTyCon)
anyRewritableCanEqLHS :: EqRel
-> (EqRel -> TcTyVar -> Bool)
-> (EqRel -> TyCon -> [TcType] -> Bool)
-> TcType -> Bool
anyRewritableCanEqLHS :: EqRel
-> (EqRel -> Var -> Bool)
-> (EqRel -> TyCon -> [Type] -> Bool)
-> Type
-> Bool
anyRewritableCanEqLHS EqRel
role EqRel -> Var -> Bool
check_tyvar EqRel -> TyCon -> [Type] -> Bool
check_tyconapp
= Bool
-> EqRel
-> (EqRel -> Var -> Bool)
-> (EqRel -> TyCon -> [Type] -> Bool)
-> (TyCon -> Bool)
-> Type
-> Bool
any_rewritable Bool
False EqRel
role EqRel -> Var -> Bool
check_tyvar EqRel -> TyCon -> [Type] -> Bool
check_tyconapp (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Bool
isFamFreeTyCon)
exactTyCoVarsOfType :: Type -> TyCoVarSet
exactTyCoVarsOfTypes :: [Type] -> TyCoVarSet
exactTyCoVarsOfType :: Type -> VarSet
exactTyCoVarsOfType Type
ty = Endo VarSet -> VarSet
runTyCoVars (Type -> Endo VarSet
exact_ty Type
ty)
exactTyCoVarsOfTypes :: [Type] -> VarSet
exactTyCoVarsOfTypes [Type]
tys = Endo VarSet -> VarSet
runTyCoVars ([Type] -> Endo VarSet
exact_tys [Type]
tys)
exact_ty :: Type -> Endo TyCoVarSet
exact_tys :: [Type] -> Endo TyCoVarSet
(Type -> Endo VarSet
exact_ty, [Type] -> Endo VarSet
exact_tys, KindCoercion -> Endo VarSet
_, [KindCoercion] -> Endo VarSet
_) = forall a env.
Monoid a =>
TyCoFolder env a
-> env
-> (Type -> a, [Type] -> 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 :: Type -> Maybe Type
tcf_view = Type -> Maybe Type
tcView }
tcIsTcTyVar :: TcTyVar -> Bool
tcIsTcTyVar :: Var -> Bool
tcIsTcTyVar Var
tv = Var -> Bool
isTyVar Var
tv
isPromotableMetaTyVar :: TcTyVar -> Bool
isPromotableMetaTyVar :: Var -> Bool
isPromotableMetaTyVar Var
tv
| Var -> Bool
isTyVar Var
tv
, MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
info } <- Var -> TcTyVarDetails
tcTyVarDetails Var
tv
= MetaInfo -> Bool
isTouchableInfo MetaInfo
info
| Bool
otherwise
= Bool
False
isTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool
isTouchableMetaTyVar :: TcLevel -> Var -> Bool
isTouchableMetaTyVar TcLevel
ctxt_tclvl Var
tv
| Var -> Bool
isTyVar Var
tv
, MetaTv { mtv_tclvl :: TcTyVarDetails -> TcLevel
mtv_tclvl = TcLevel
tv_tclvl, mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
info } <- Var -> TcTyVarDetails
tcTyVarDetails Var
tv
, MetaInfo -> Bool
isTouchableInfo MetaInfo
info
= ASSERT2( checkTcLevelInvariant ctxt_tclvl tv_tclvl,
ppr tv $$ ppr tv_tclvl $$ ppr ctxt_tclvl )
TcLevel
tv_tclvl TcLevel -> TcLevel -> Bool
`sameDepthAs` TcLevel
ctxt_tclvl
| Bool
otherwise = Bool
False
isImmutableTyVar :: TyVar -> Bool
isImmutableTyVar :: Var -> Bool
isImmutableTyVar Var
tv = Var -> Bool
isSkolemTyVar Var
tv
isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar,
isMetaTyVar, isAmbiguousTyVar, isCycleBreakerTyVar :: TcTyVar -> Bool
isTyConableTyVar :: Var -> Bool
isTyConableTyVar Var
tv
| Var -> Bool
isTyVar Var
tv
= case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
TyVarTv } -> Bool
False
TcTyVarDetails
_ -> Bool
True
| Bool
otherwise = Bool
True
isSkolemTyVar :: Var -> Bool
isSkolemTyVar Var
tv
= ASSERT2( tcIsTcTyVar tv, ppr tv )
case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
MetaTv {} -> Bool
False
TcTyVarDetails
_other -> Bool
True
isOverlappableTyVar :: Var -> Bool
isOverlappableTyVar Var
tv
| Var -> Bool
isTyVar Var
tv
= case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
SkolemTv TcLevel
_ Bool
overlappable -> Bool
overlappable
TcTyVarDetails
_ -> Bool
False
| Bool
otherwise = Bool
False
isMetaTyVar :: Var -> Bool
isMetaTyVar Var
tv
| Var -> Bool
isTyVar Var
tv
= case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
MetaTv {} -> Bool
True
TcTyVarDetails
_ -> Bool
False
| Bool
otherwise = Bool
False
isAmbiguousTyVar :: Var -> Bool
isAmbiguousTyVar Var
tv
| Var -> Bool
isTyVar Var
tv
= case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
MetaTv {} -> Bool
True
RuntimeUnk {} -> Bool
True
TcTyVarDetails
_ -> Bool
False
| Bool
otherwise = Bool
False
isCycleBreakerTyVar :: Var -> Bool
isCycleBreakerTyVar Var
tv
| Var -> Bool
isTyVar Var
tv
, MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
CycleBreakerTv } <- Var -> TcTyVarDetails
tcTyVarDetails Var
tv
= Bool
True
| Bool
otherwise
= Bool
False
isMetaTyVarTy :: TcType -> Bool
isMetaTyVarTy :: Type -> Bool
isMetaTyVarTy (TyVarTy Var
tv) = Var -> Bool
isMetaTyVar Var
tv
isMetaTyVarTy Type
_ = Bool
False
metaTyVarInfo :: TcTyVar -> MetaInfo
metaTyVarInfo :: Var -> MetaInfo
metaTyVarInfo Var
tv
= case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = MetaInfo
info } -> MetaInfo
info
TcTyVarDetails
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarInfo" (forall a. Outputable a => a -> SDoc
ppr Var
tv)
isTouchableInfo :: MetaInfo -> Bool
isTouchableInfo :: MetaInfo -> Bool
isTouchableInfo MetaInfo
info
| MetaInfo
CycleBreakerTv <- MetaInfo
info = Bool
False
| Bool
otherwise = Bool
True
metaTyVarTcLevel :: TcTyVar -> TcLevel
metaTyVarTcLevel :: Var -> TcLevel
metaTyVarTcLevel Var
tv
= case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
MetaTv { mtv_tclvl :: TcTyVarDetails -> TcLevel
mtv_tclvl = TcLevel
tclvl } -> TcLevel
tclvl
TcTyVarDetails
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarTcLevel" (forall a. Outputable a => a -> SDoc
ppr Var
tv)
metaTyVarTcLevel_maybe :: TcTyVar -> Maybe TcLevel
metaTyVarTcLevel_maybe :: Var -> Maybe TcLevel
metaTyVarTcLevel_maybe Var
tv
= case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
MetaTv { mtv_tclvl :: TcTyVarDetails -> TcLevel
mtv_tclvl = TcLevel
tclvl } -> forall a. a -> Maybe a
Just TcLevel
tclvl
TcTyVarDetails
_ -> forall a. Maybe a
Nothing
metaTyVarRef :: TyVar -> IORef MetaDetails
metaTyVarRef :: Var -> IORef MetaDetails
metaTyVarRef Var
tv
= case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
MetaTv { mtv_ref :: TcTyVarDetails -> IORef MetaDetails
mtv_ref = IORef MetaDetails
ref } -> IORef MetaDetails
ref
TcTyVarDetails
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarRef" (forall a. Outputable a => a -> SDoc
ppr Var
tv)
setMetaTyVarTcLevel :: TcTyVar -> TcLevel -> TcTyVar
setMetaTyVarTcLevel :: Var -> TcLevel -> Var
setMetaTyVarTcLevel Var
tv TcLevel
tclvl
= case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
details :: TcTyVarDetails
details@(MetaTv {}) -> Var -> TcTyVarDetails -> Var
setTcTyVarDetails Var
tv (TcTyVarDetails
details { mtv_tclvl :: TcLevel
mtv_tclvl = TcLevel
tclvl })
TcTyVarDetails
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarTcLevel" (forall a. Outputable a => a -> SDoc
ppr Var
tv)
isTyVarTyVar :: Var -> Bool
isTyVarTyVar :: Var -> Bool
isTyVarTyVar Var
tv
= case Var -> TcTyVarDetails
tcTyVarDetails Var
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 Type
_) = Bool
True
isIndirect MetaDetails
_ = Bool
False
isRuntimeUnkSkol :: TyVar -> Bool
isRuntimeUnkSkol :: Var -> Bool
isRuntimeUnkSkol Var
x
| TcTyVarDetails
RuntimeUnk <- Var -> TcTyVarDetails
tcTyVarDetails Var
x = Bool
True
| Bool
otherwise = Bool
False
mkTyVarNamePairs :: [TyVar] -> [(Name,TyVar)]
mkTyVarNamePairs :: [Var] -> [(Name, Var)]
mkTyVarNamePairs [Var]
tvs = [(Var -> Name
tyVarName Var
tv, Var
tv) | Var
tv <- [Var]
tvs]
findDupTyVarTvs :: [(Name,TcTyVar)] -> [(Name,Name)]
findDupTyVarTvs :: [(Name, Var)] -> [(Name, Name)]
findDupTyVarTvs [(Name, Var)]
prs
= forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b} {b}. NonEmpty (b, b) -> [(b, b)]
mk_result_prs forall a b. (a -> b) -> a -> b
$
forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
findDupsEq forall {a} {a} {a}. Eq a => (a, a) -> (a, a) -> Bool
eq_snd [(Name, Var)]
prs
where
eq_snd :: (a, a) -> (a, a) -> Bool
eq_snd (a
_,a
tv1) (a
_,a
tv2) = a
tv1 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) = forall a b. (a -> b) -> [a] -> [b]
map (\(b
n2,b
_) -> (b
n1,b
n2)) [(b, b)]
xs
mkSigmaTy :: [TyCoVarBinder] -> [PredType] -> Type -> Type
mkSigmaTy :: [TyCoVarBinder] -> [Type] -> Type -> Type
mkSigmaTy [TyCoVarBinder]
bndrs [Type]
theta Type
tau = [TyCoVarBinder] -> Type -> Type
mkForAllTys [TyCoVarBinder]
bndrs ([Type] -> Type -> Type
mkPhiTy [Type]
theta Type
tau)
mkInfSigmaTy :: [TyCoVar] -> [PredType] -> Type -> Type
mkInfSigmaTy :: [Var] -> [Type] -> Type -> Type
mkInfSigmaTy [Var]
tyvars [Type]
theta Type
ty = [TyCoVarBinder] -> [Type] -> Type -> Type
mkSigmaTy (forall vis. vis -> [Var] -> [VarBndr Var vis]
mkTyCoVarBinders ArgFlag
Inferred [Var]
tyvars) [Type]
theta Type
ty
mkSpecSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
mkSpecSigmaTy :: [Var] -> [Type] -> Type -> Type
mkSpecSigmaTy [Var]
tyvars [Type]
preds Type
ty = [TyCoVarBinder] -> [Type] -> Type -> Type
mkSigmaTy (forall vis. vis -> [Var] -> [VarBndr Var vis]
mkTyCoVarBinders ArgFlag
Specified [Var]
tyvars) [Type]
preds Type
ty
mkPhiTy :: [PredType] -> Type -> Type
mkPhiTy :: [Type] -> Type -> Type
mkPhiTy = [Type] -> Type -> Type
mkInvisFunTysMany
getDFunTyKey :: Type -> OccName
getDFunTyKey :: Type -> OccName
getDFunTyKey Type
ty | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> OccName
getDFunTyKey Type
ty'
getDFunTyKey (TyVarTy Var
tv) = forall a. NamedThing a => a -> OccName
getOccName Var
tv
getDFunTyKey (TyConApp TyCon
tc [Type]
_) = forall a. NamedThing a => a -> OccName
getOccName TyCon
tc
getDFunTyKey (LitTy TyLit
x) = TyLit -> OccName
getDFunTyLitKey TyLit
x
getDFunTyKey (AppTy Type
fun Type
_) = Type -> OccName
getDFunTyKey Type
fun
getDFunTyKey (FunTy {}) = forall a. NamedThing a => a -> OccName
getOccName TyCon
funTyCon
getDFunTyKey (ForAllTy TyCoVarBinder
_ Type
t) = Type -> OccName
getDFunTyKey Type
t
getDFunTyKey (CastTy Type
ty KindCoercion
_) = Type -> OccName
getDFunTyKey Type
ty
getDFunTyKey t :: Type
t@(CoercionTy KindCoercion
_) = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getDFunTyKey" (forall a. Outputable a => a -> SDoc
ppr Type
t)
getDFunTyLitKey :: TyLit -> OccName
getDFunTyLitKey :: TyLit -> OccName
getDFunTyLitKey (NumTyLit Integer
n) = NameSpace -> String -> OccName
mkOccName NameSpace
Name.varName (forall a. Show a => a -> String
show Integer
n)
getDFunTyLitKey (StrTyLit FastString
n) = NameSpace -> String -> OccName
mkOccName NameSpace
Name.varName (forall a. Show a => a -> String
show FastString
n)
getDFunTyLitKey (CharTyLit Char
n) = NameSpace -> String -> OccName
mkOccName NameSpace
Name.varName (forall a. Show a => a -> String
show Char
n)
mkTcAppTys :: Type -> [Type] -> Type
mkTcAppTys :: Type -> [Type] -> Type
mkTcAppTys = Type -> [Type] -> Type
mkAppTys
mkTcAppTy :: Type -> Type -> Type
mkTcAppTy :: Type -> Type -> Type
mkTcAppTy = Type -> Type -> Type
mkAppTy
mkTcCastTy :: Type -> Coercion -> Type
mkTcCastTy :: Type -> KindCoercion -> Type
mkTcCastTy = Type -> KindCoercion -> Type
mkCastTy
tcSplitPiTys :: Type -> ([TyBinder], Type)
tcSplitPiTys :: Type -> ([TyBinder], Type)
tcSplitPiTys Type
ty
= ASSERT( all isTyBinder (fst sty) ) sty
where sty :: ([TyBinder], Type)
sty = Type -> ([TyBinder], Type)
splitPiTys Type
ty
tcSplitPiTy_maybe :: Type -> Maybe (TyBinder, Type)
tcSplitPiTy_maybe :: Type -> Maybe (TyBinder, Type)
tcSplitPiTy_maybe Type
ty
= ASSERT( isMaybeTyBinder sty ) sty
where
sty :: Maybe (TyBinder, Type)
sty = Type -> Maybe (TyBinder, Type)
splitPiTy_maybe Type
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 :: Type -> Maybe (TyCoVarBinder, Type)
tcSplitForAllTyVarBinder_maybe Type
ty | Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Maybe (TyCoVarBinder, Type)
tcSplitForAllTyVarBinder_maybe Type
ty'
tcSplitForAllTyVarBinder_maybe (ForAllTy TyCoVarBinder
tv Type
ty) = ASSERT( isTyVarBinder tv ) Just (tv, ty)
tcSplitForAllTyVarBinder_maybe Type
_ = forall a. Maybe a
Nothing
tcSplitForAllTyVars :: Type -> ([TyVar], Type)
tcSplitForAllTyVars :: Type -> ([Var], Type)
tcSplitForAllTyVars Type
ty
= ASSERT( all isTyVar (fst sty) ) sty
where sty :: ([Var], Type)
sty = Type -> ([Var], Type)
splitForAllTyCoVars Type
ty
tcSplitForAllInvisTyVars :: Type -> ([TyVar], Type)
tcSplitForAllInvisTyVars :: Type -> ([Var], Type)
tcSplitForAllInvisTyVars Type
ty = (ArgFlag -> Bool) -> Type -> ([Var], Type)
tcSplitSomeForAllTyVars ArgFlag -> Bool
isInvisibleArgFlag Type
ty
tcSplitSomeForAllTyVars :: (ArgFlag -> Bool) -> Type -> ([TyVar], Type)
tcSplitSomeForAllTyVars :: (ArgFlag -> Bool) -> Type -> ([Var], Type)
tcSplitSomeForAllTyVars ArgFlag -> Bool
argf_pred Type
ty
= Type -> Type -> [Var] -> ([Var], Type)
split Type
ty Type
ty []
where
split :: Type -> Type -> [Var] -> ([Var], Type)
split Type
_ (ForAllTy (Bndr Var
tv ArgFlag
argf) Type
ty) [Var]
tvs
| ArgFlag -> Bool
argf_pred ArgFlag
argf = Type -> Type -> [Var] -> ([Var], Type)
split Type
ty Type
ty (Var
tvforall a. a -> [a] -> [a]
:[Var]
tvs)
split Type
orig_ty Type
ty [Var]
tvs | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> Type -> [Var] -> ([Var], Type)
split Type
orig_ty Type
ty' [Var]
tvs
split Type
orig_ty Type
_ [Var]
tvs = (forall a. [a] -> [a]
reverse [Var]
tvs, Type
orig_ty)
tcSplitForAllReqTVBinders :: Type -> ([TcReqTVBinder], Type)
tcSplitForAllReqTVBinders :: Type -> ([TcReqTVBinder], Type)
tcSplitForAllReqTVBinders Type
ty = ASSERT( all (isTyVar . binderVar) (fst sty) ) sty
where sty :: ([TcReqTVBinder], Type)
sty = Type -> ([TcReqTVBinder], Type)
splitForAllReqTVBinders Type
ty
tcSplitForAllInvisTVBinders :: Type -> ([TcInvisTVBinder], Type)
tcSplitForAllInvisTVBinders :: Type -> ([TcInvisTVBinder], Type)
tcSplitForAllInvisTVBinders Type
ty = ASSERT( all (isTyVar . binderVar) (fst sty) ) sty
where sty :: ([TcInvisTVBinder], Type)
sty = Type -> ([TcInvisTVBinder], Type)
splitForAllInvisTVBinders Type
ty
tcSplitForAllTyVarBinders :: Type -> ([TyVarBinder], Type)
tcSplitForAllTyVarBinders :: Type -> ([TyCoVarBinder], Type)
tcSplitForAllTyVarBinders Type
ty = ASSERT( all isTyVarBinder (fst sty)) sty
where sty :: ([TyCoVarBinder], Type)
sty = Type -> ([TyCoVarBinder], Type)
splitForAllTyCoVarBinders Type
ty
tcIsForAllTy :: Type -> Bool
tcIsForAllTy :: Type -> Bool
tcIsForAllTy Type
ty | Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Bool
tcIsForAllTy Type
ty'
tcIsForAllTy (ForAllTy {}) = Bool
True
tcIsForAllTy Type
_ = Bool
False
tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)
tcSplitPredFunTy_maybe :: Type -> Maybe (Type, Type)
tcSplitPredFunTy_maybe Type
ty
| Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Maybe (Type, Type)
tcSplitPredFunTy_maybe Type
ty'
tcSplitPredFunTy_maybe (FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
InvisArg
, ft_arg :: Type -> Type
ft_arg = Type
arg, ft_res :: Type -> Type
ft_res = Type
res })
= forall a. a -> Maybe a
Just (Type
arg, Type
res)
tcSplitPredFunTy_maybe Type
_
= forall a. Maybe a
Nothing
tcSplitPhiTy :: Type -> (ThetaType, Type)
tcSplitPhiTy :: Type -> ([Type], Type)
tcSplitPhiTy Type
ty
= Type -> [Type] -> ([Type], Type)
split Type
ty []
where
split :: Type -> [Type] -> ([Type], Type)
split Type
ty [Type]
ts
= case Type -> Maybe (Type, Type)
tcSplitPredFunTy_maybe Type
ty of
Just (Type
pred, Type
ty) -> Type -> [Type] -> ([Type], Type)
split Type
ty (Type
predforall a. a -> [a] -> [a]
:[Type]
ts)
Maybe (Type, Type)
Nothing -> (forall a. [a] -> [a]
reverse [Type]
ts, Type
ty)
tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
tcSplitSigmaTy :: Type -> ([Var], [Type], Type)
tcSplitSigmaTy Type
ty = case Type -> ([Var], Type)
tcSplitForAllInvisTyVars Type
ty of
([Var]
tvs, Type
rho) -> case Type -> ([Type], Type)
tcSplitPhiTy Type
rho of
([Type]
theta, Type
tau) -> ([Var]
tvs, [Type]
theta, Type
tau)
tcSplitNestedSigmaTys :: Type -> ([TyVar], ThetaType, Type)
tcSplitNestedSigmaTys :: Type -> ([Var], [Type], Type)
tcSplitNestedSigmaTys Type
ty
| ([Scaled Type]
arg_tys, Type
body_ty) <- Type -> ([Scaled Type], Type)
tcSplitFunTys Type
ty
, ([Var]
tvs1, [Type]
theta1, Type
rho1) <- Type -> ([Var], [Type], Type)
tcSplitSigmaTy Type
body_ty
, Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Var]
tvs1 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
theta1)
= let ([Var]
tvs2, [Type]
theta2, Type
rho2) = Type -> ([Var], [Type], Type)
tcSplitNestedSigmaTys Type
rho1
in ([Var]
tvs1 forall a. [a] -> [a] -> [a]
++ [Var]
tvs2, [Type]
theta1 forall a. [a] -> [a] -> [a]
++ [Type]
theta2, [Scaled Type] -> Type -> Type
mkVisFunTys [Scaled Type]
arg_tys Type
rho2)
| Bool
otherwise = ([], [], Type
ty)
tcTyConAppTyCon :: Type -> TyCon
tcTyConAppTyCon :: Type -> TyCon
tcTyConAppTyCon Type
ty
= case Type -> Maybe TyCon
tcTyConAppTyCon_maybe Type
ty of
Just TyCon
tc -> TyCon
tc
Maybe TyCon
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcTyConAppTyCon" (Type -> SDoc
pprType Type
ty)
tcTyConAppTyCon_maybe :: Type -> Maybe TyCon
tcTyConAppTyCon_maybe :: Type -> Maybe TyCon
tcTyConAppTyCon_maybe Type
ty
| Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Maybe TyCon
tcTyConAppTyCon_maybe Type
ty'
tcTyConAppTyCon_maybe (TyConApp TyCon
tc [Type]
_)
= forall a. a -> Maybe a
Just TyCon
tc
tcTyConAppTyCon_maybe (FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
VisArg })
= forall a. a -> Maybe a
Just TyCon
funTyCon
tcTyConAppTyCon_maybe Type
_
= forall a. Maybe a
Nothing
tcTyConAppArgs :: Type -> [Type]
tcTyConAppArgs :: Type -> [Type]
tcTyConAppArgs Type
ty = case HasCallStack => Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty of
Just (TyCon
_, [Type]
args) -> [Type]
args
Maybe (TyCon, [Type])
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcTyConAppArgs" (Type -> SDoc
pprType Type
ty)
tcSplitTyConApp :: Type -> (TyCon, [Type])
tcSplitTyConApp :: Type -> (TyCon, [Type])
tcSplitTyConApp Type
ty = case HasCallStack => Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty of
Just (TyCon, [Type])
stuff -> (TyCon, [Type])
stuff
Maybe (TyCon, [Type])
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcSplitTyConApp" (Type -> SDoc
pprType Type
ty)
tcSplitFunTys :: Type -> ([Scaled Type], Type)
tcSplitFunTys :: Type -> ([Scaled Type], Type)
tcSplitFunTys Type
ty = case Type -> Maybe (Scaled Type, Type)
tcSplitFunTy_maybe Type
ty of
Maybe (Scaled Type, Type)
Nothing -> ([], Type
ty)
Just (Scaled Type
arg,Type
res) -> (Scaled Type
argforall a. a -> [a] -> [a]
:[Scaled Type]
args, Type
res')
where
([Scaled Type]
args,Type
res') = Type -> ([Scaled Type], Type)
tcSplitFunTys Type
res
tcSplitFunTy_maybe :: Type -> Maybe (Scaled Type, Type)
tcSplitFunTy_maybe :: Type -> Maybe (Scaled Type, Type)
tcSplitFunTy_maybe Type
ty
| Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Maybe (Scaled Type, Type)
tcSplitFunTy_maybe Type
ty'
tcSplitFunTy_maybe (FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
af, ft_mult :: Type -> Type
ft_mult = Type
w, ft_arg :: Type -> Type
ft_arg = Type
arg, ft_res :: Type -> Type
ft_res = Type
res })
| AnonArgFlag
VisArg <- AnonArgFlag
af = forall a. a -> Maybe a
Just (forall a. Type -> a -> Scaled a
Scaled Type
w Type
arg, Type
res)
tcSplitFunTy_maybe Type
_ = forall a. Maybe a
Nothing
tcSplitFunTysN :: Arity
-> TcRhoType
-> Either Arity
([Scaled TcSigmaType],
TcSigmaType)
tcSplitFunTysN :: Arity -> Type -> Either Arity ([Scaled Type], Type)
tcSplitFunTysN Arity
n Type
ty
| Arity
n forall a. Eq a => a -> a -> Bool
== Arity
0
= forall a b. b -> Either a b
Right ([], Type
ty)
| Just (Scaled Type
arg,Type
res) <- Type -> Maybe (Scaled Type, Type)
tcSplitFunTy_maybe Type
ty
= case Arity -> Type -> Either Arity ([Scaled Type], Type)
tcSplitFunTysN (Arity
nforall a. Num a => a -> a -> a
-Arity
1) Type
res of
Left Arity
m -> forall a b. a -> Either a b
Left Arity
m
Right ([Scaled Type]
args,Type
body) -> forall a b. b -> Either a b
Right (Scaled Type
argforall a. a -> [a] -> [a]
:[Scaled Type]
args, Type
body)
| Bool
otherwise
= forall a b. a -> Either a b
Left Arity
n
tcSplitFunTy :: Type -> (Scaled Type, Type)
tcSplitFunTy :: Type -> (Scaled Type, Type)
tcSplitFunTy Type
ty = forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"tcSplitFunTy" (Type -> Maybe (Scaled Type, Type)
tcSplitFunTy_maybe Type
ty)
tcFunArgTy :: Type -> Scaled Type
tcFunArgTy :: Type -> Scaled Type
tcFunArgTy Type
ty = forall a b. (a, b) -> a
fst (Type -> (Scaled Type, Type)
tcSplitFunTy Type
ty)
tcFunResultTy :: Type -> Type
tcFunResultTy :: Type -> Type
tcFunResultTy Type
ty = forall a b. (a, b) -> b
snd (Type -> (Scaled Type, Type)
tcSplitFunTy Type
ty)
tcFunResultTyN :: HasDebugCallStack => Arity -> Type -> Type
tcFunResultTyN :: HasDebugCallStack => Arity -> Type -> Type
tcFunResultTyN Arity
n Type
ty
| Right ([Scaled Type]
_, Type
res_ty) <- Arity -> Type -> Either Arity ([Scaled Type], Type)
tcSplitFunTysN Arity
n Type
ty
= Type
res_ty
| Bool
otherwise
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcFunResultTyN" (forall a. Outputable a => a -> SDoc
ppr Arity
n SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Type
ty)
tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
tcSplitAppTy_maybe Type
ty | Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Maybe (Type, Type)
tcSplitAppTy_maybe Type
ty'
tcSplitAppTy_maybe Type
ty = Type -> Maybe (Type, Type)
tcRepSplitAppTy_maybe Type
ty
tcSplitAppTy :: Type -> (Type, Type)
tcSplitAppTy :: Type -> (Type, Type)
tcSplitAppTy Type
ty = case Type -> Maybe (Type, Type)
tcSplitAppTy_maybe Type
ty of
Just (Type, Type)
stuff -> (Type, Type)
stuff
Maybe (Type, Type)
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcSplitAppTy" (Type -> SDoc
pprType Type
ty)
tcSplitAppTys :: Type -> (Type, [Type])
tcSplitAppTys :: Type -> (Type, [Type])
tcSplitAppTys Type
ty
= Type -> [Type] -> (Type, [Type])
go Type
ty []
where
go :: Type -> [Type] -> (Type, [Type])
go Type
ty [Type]
args = case Type -> Maybe (Type, Type)
tcSplitAppTy_maybe Type
ty of
Just (Type
ty', Type
arg) -> Type -> [Type] -> (Type, [Type])
go Type
ty' (Type
argforall a. a -> [a] -> [a]
:[Type]
args)
Maybe (Type, Type)
Nothing -> (Type
ty,[Type]
args)
tcRepGetNumAppTys :: Type -> Arity
tcRepGetNumAppTys :: Type -> Arity
tcRepGetNumAppTys = forall (t :: * -> *) a. Foldable t => t a -> Arity
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Type -> (Type, [Type])
repSplitAppTys
tcGetCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)
tcGetCastedTyVar_maybe :: Type -> Maybe (Var, KindCoercion)
tcGetCastedTyVar_maybe Type
ty | Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Maybe (Var, KindCoercion)
tcGetCastedTyVar_maybe Type
ty'
tcGetCastedTyVar_maybe (CastTy (TyVarTy Var
tv) KindCoercion
co) = forall a. a -> Maybe a
Just (Var
tv, KindCoercion
co)
tcGetCastedTyVar_maybe (TyVarTy Var
tv) = forall a. a -> Maybe a
Just (Var
tv, Type -> KindCoercion
mkNomReflCo (Var -> Type
tyVarKind Var
tv))
tcGetCastedTyVar_maybe Type
_ = forall a. Maybe a
Nothing
tcGetTyVar_maybe :: Type -> Maybe TyVar
tcGetTyVar_maybe :: Type -> Maybe Var
tcGetTyVar_maybe Type
ty | Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Maybe Var
tcGetTyVar_maybe Type
ty'
tcGetTyVar_maybe (TyVarTy Var
tv) = forall a. a -> Maybe a
Just Var
tv
tcGetTyVar_maybe Type
_ = forall a. Maybe a
Nothing
tcGetTyVar :: String -> Type -> TyVar
tcGetTyVar :: String -> Type -> Var
tcGetTyVar String
msg Type
ty
= case Type -> Maybe Var
tcGetTyVar_maybe Type
ty of
Just Var
tv -> Var
tv
Maybe Var
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
msg (forall a. Outputable a => a -> SDoc
ppr Type
ty)
tcIsTyVarTy :: Type -> Bool
tcIsTyVarTy :: Type -> Bool
tcIsTyVarTy Type
ty | Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Bool
tcIsTyVarTy Type
ty'
tcIsTyVarTy (CastTy Type
ty KindCoercion
_) = Type -> Bool
tcIsTyVarTy Type
ty
tcIsTyVarTy (TyVarTy Var
_) = Bool
True
tcIsTyVarTy Type
_ = Bool
False
tcSplitDFunTy :: Type -> ([TyVar], [Type], Class, [Type])
tcSplitDFunTy :: Type -> ([Var], [Type], Class, [Type])
tcSplitDFunTy Type
ty
= case Type -> ([Var], Type)
tcSplitForAllInvisTyVars Type
ty of { ([Var]
tvs, Type
rho) ->
case Type -> ([Scaled Type], Type)
splitFunTys Type
rho of { ([Scaled Type]
theta, Type
tau) ->
case Type -> (Class, [Type])
tcSplitDFunHead Type
tau of { (Class
clas, [Type]
tys) ->
([Var]
tvs, forall a b. (a -> b) -> [a] -> [b]
map forall a. Scaled a -> a
scaledThing [Scaled Type]
theta, Class
clas, [Type]
tys) }}}
tcSplitDFunHead :: Type -> (Class, [Type])
tcSplitDFunHead :: Type -> (Class, [Type])
tcSplitDFunHead = HasDebugCallStack => Type -> (Class, [Type])
getClassPredTys
tcSplitMethodTy :: Type -> ([TyVar], PredType, Type)
tcSplitMethodTy :: Type -> ([Var], Type, Type)
tcSplitMethodTy Type
ty
| ([Var]
sel_tyvars,Type
sel_rho) <- Type -> ([Var], Type)
tcSplitForAllInvisTyVars Type
ty
, Just (Type
first_pred, Type
local_meth_ty) <- Type -> Maybe (Type, Type)
tcSplitPredFunTy_maybe Type
sel_rho
= ([Var]
sel_tyvars, Type
first_pred, Type
local_meth_ty)
| Bool
otherwise
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcSplitMethodTy" (forall a. Outputable a => a -> SDoc
ppr Type
ty)
tcEqKind :: HasDebugCallStack => TcKind -> TcKind -> Bool
tcEqKind :: HasDebugCallStack => Type -> Type -> Bool
tcEqKind = HasDebugCallStack => Type -> Type -> Bool
tcEqType
tcEqType :: HasDebugCallStack => TcType -> TcType -> Bool
tcEqType :: HasDebugCallStack => Type -> Type -> Bool
tcEqType Type
ty1 Type
ty2
= Type -> Type -> Bool
tcEqTypeNoSyns Type
ki1 Type
ki2
Bool -> Bool -> Bool
&& Type -> Type -> Bool
tcEqTypeNoSyns Type
ty1 Type
ty2
where
ki1 :: Type
ki1 = HasDebugCallStack => Type -> Type
tcTypeKind Type
ty1
ki2 :: Type
ki2 = HasDebugCallStack => Type -> Type
tcTypeKind Type
ty2
tcEqTypeNoKindCheck :: TcType -> TcType -> Bool
tcEqTypeNoKindCheck :: Type -> Type -> Bool
tcEqTypeNoKindCheck Type
ty1 Type
ty2
= Type -> Type -> Bool
tcEqTypeNoSyns Type
ty1 Type
ty2
tcEqTyConApps :: TyCon -> [Type] -> TyCon -> [Type] -> Bool
tcEqTyConApps :: TyCon -> [Type] -> TyCon -> [Type] -> Bool
tcEqTyConApps TyCon
tc1 [Type]
args1 TyCon
tc2 [Type]
args2
= TyCon
tc1 forall a. Eq a => a -> a -> Bool
== TyCon
tc2 Bool -> Bool -> Bool
&&
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Type -> Type -> Bool
tcEqTypeNoKindCheck [Type]
args1 [Type]
args2)
tcEqTypeNoSyns :: TcType -> TcType -> Bool
tcEqTypeNoSyns :: Type -> Type -> Bool
tcEqTypeNoSyns Type
ta Type
tb = Bool -> Bool -> Type -> Type -> Bool
tc_eq_type Bool
False Bool
False Type
ta Type
tb
tcEqTypeVis :: TcType -> TcType -> Bool
tcEqTypeVis :: Type -> Type -> Bool
tcEqTypeVis Type
ty1 Type
ty2 = Bool -> Bool -> Type -> Type -> Bool
tc_eq_type Bool
False Bool
True Type
ty1 Type
ty2
pickyEqType :: TcType -> TcType -> Bool
pickyEqType :: Type -> Type -> Bool
pickyEqType Type
ty1 Type
ty2 = Bool -> Bool -> Type -> Type -> Bool
tc_eq_type Bool
True Bool
False Type
ty1 Type
ty2
tc_eq_type :: Bool
-> Bool
-> Type -> Type
-> Bool
tc_eq_type :: Bool -> Bool -> Type -> Type -> Bool
tc_eq_type Bool
keep_syns Bool
vis_only Type
orig_ty1 Type
orig_ty2
= RnEnv2 -> Type -> Type -> Bool
go RnEnv2
orig_env Type
orig_ty1 Type
orig_ty2
where
go :: RnEnv2 -> Type -> Type -> Bool
go :: RnEnv2 -> Type -> Type -> Bool
go RnEnv2
_ (TyConApp TyCon
tc1 []) (TyConApp TyCon
tc2 [])
| TyCon
tc1 forall a. Eq a => a -> a -> Bool
== TyCon
tc2
= Bool
True
go RnEnv2
env Type
t1 Type
t2 | Bool -> Bool
not Bool
keep_syns, Just Type
t1' <- Type -> Maybe Type
tcView Type
t1 = RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
t1' Type
t2
go RnEnv2
env Type
t1 Type
t2 | Bool -> Bool
not Bool
keep_syns, Just Type
t2' <- Type -> Maybe Type
tcView Type
t2 = RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
t1 Type
t2'
go RnEnv2
env (TyVarTy Var
tv1) (TyVarTy Var
tv2)
= RnEnv2 -> Var -> Var
rnOccL RnEnv2
env Var
tv1 forall a. Eq a => a -> a -> Bool
== RnEnv2 -> Var -> Var
rnOccR RnEnv2
env Var
tv2
go RnEnv2
_ (LitTy TyLit
lit1) (LitTy TyLit
lit2)
= TyLit
lit1 forall a. Eq a => a -> a -> Bool
== TyLit
lit2
go RnEnv2
env (ForAllTy (Bndr Var
tv1 ArgFlag
vis1) Type
ty1)
(ForAllTy (Bndr Var
tv2 ArgFlag
vis2) Type
ty2)
= ArgFlag
vis1 ArgFlag -> ArgFlag -> Bool
`sameVis` ArgFlag
vis2
Bool -> Bool -> Bool
&& (Bool
vis_only Bool -> Bool -> Bool
|| RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env (Var -> Type
varType Var
tv1) (Var -> Type
varType Var
tv2))
Bool -> Bool -> Bool
&& RnEnv2 -> Type -> Type -> Bool
go (RnEnv2 -> Var -> Var -> RnEnv2
rnBndr2 RnEnv2
env Var
tv1 Var
tv2) Type
ty1 Type
ty2
go RnEnv2
env (FunTy AnonArgFlag
_ Type
w1 Type
arg1 Type
res1) (FunTy AnonArgFlag
_ Type
w2 Type
arg2 Type
res2)
= Bool
kinds_eq Bool -> Bool -> Bool
&& RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
arg1 Type
arg2 Bool -> Bool -> Bool
&& RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
res1 Type
res2 Bool -> Bool -> Bool
&& RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
w1 Type
w2
where
kinds_eq :: Bool
kinds_eq | Bool
vis_only = Bool
True
| Bool
otherwise = RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env (HasDebugCallStack => Type -> Type
typeKind Type
arg1) (HasDebugCallStack => Type -> Type
typeKind Type
arg2) Bool -> Bool -> Bool
&&
RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env (HasDebugCallStack => Type -> Type
typeKind Type
res1) (HasDebugCallStack => Type -> Type
typeKind Type
res2)
go RnEnv2
env (AppTy Type
s1 Type
t1) Type
ty2
| Just (Type
s2, Type
t2) <- Type -> Maybe (Type, Type)
tcRepSplitAppTy_maybe Type
ty2
= RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
s1 Type
s2 Bool -> Bool -> Bool
&& RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
t1 Type
t2
go RnEnv2
env Type
ty1 (AppTy Type
s2 Type
t2)
| Just (Type
s1, Type
t1) <- Type -> Maybe (Type, Type)
tcRepSplitAppTy_maybe Type
ty1
= RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
s1 Type
s2 Bool -> Bool -> Bool
&& RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
t1 Type
t2
go RnEnv2
env (TyConApp TyCon
tc1 [Type]
ts1) (TyConApp TyCon
tc2 [Type]
ts2)
= TyCon
tc1 forall a. Eq a => a -> a -> Bool
== TyCon
tc2 Bool -> Bool -> Bool
&& RnEnv2 -> [Bool] -> [Type] -> [Type] -> Bool
gos RnEnv2
env (TyCon -> [Bool]
tc_vis TyCon
tc1) [Type]
ts1 [Type]
ts2
go RnEnv2
env (CastTy Type
t1 KindCoercion
_) Type
t2 = RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
t1 Type
t2
go RnEnv2
env Type
t1 (CastTy Type
t2 KindCoercion
_) = RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
t1 Type
t2
go RnEnv2
_ (CoercionTy {}) (CoercionTy {}) = Bool
True
go RnEnv2
_ Type
_ Type
_ = Bool
False
gos :: RnEnv2 -> [Bool] -> [Type] -> [Type] -> Bool
gos RnEnv2
_ [Bool]
_ [] [] = Bool
True
gos RnEnv2
env (Bool
ig:[Bool]
igs) (Type
t1:[Type]
ts1) (Type
t2:[Type]
ts2) = (Bool
ig Bool -> Bool -> Bool
|| RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
t1 Type
t2)
Bool -> Bool -> Bool
&& RnEnv2 -> [Bool] -> [Type] -> [Type] -> Bool
gos RnEnv2
env [Bool]
igs [Type]
ts1 [Type]
ts2
gos RnEnv2
_ [Bool]
_ [Type]
_ [Type]
_ = Bool
False
tc_vis :: TyCon -> [Bool]
tc_vis :: TyCon -> [Bool]
tc_vis TyCon
tc | Bool
vis_only = [Bool]
inviss forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Bool
False
| Bool
otherwise = forall a. a -> [a]
repeat Bool
False
where
bndrs :: [TyConBinder]
bndrs = TyCon -> [TyConBinder]
tyConBinders TyCon
tc
inviss :: [Bool]
inviss = forall a b. (a -> b) -> [a] -> [b]
map forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder [TyConBinder]
bndrs
orig_env :: RnEnv2
orig_env = InScopeSet -> RnEnv2
mkRnEnv2 forall a b. (a -> b) -> a -> b
$ VarSet -> InScopeSet
mkInScopeSet forall a b. (a -> b) -> a -> b
$ [Type] -> VarSet
tyCoVarsOfTypes [Type
orig_ty1, Type
orig_ty2]
{-# INLINE tc_eq_type #-}
isTyVarClassPred :: PredType -> Bool
isTyVarClassPred :: Type -> Bool
isTyVarClassPred Type
ty = case Type -> Maybe (Class, [Type])
getClassPredTys_maybe Type
ty of
Just (Class
_, [Type]
tys) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Type -> Bool
isTyVarTy [Type]
tys
Maybe (Class, [Type])
_ -> Bool
False
checkValidClsArgs :: Bool -> Class -> [KindOrType] -> Bool
checkValidClsArgs :: Bool -> Class -> [Type] -> Bool
checkValidClsArgs Bool
flexible_contexts Class
cls [Type]
kts
| Bool
flexible_contexts = Bool
True
| Bool
otherwise = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Type -> Bool
hasTyVarHead [Type]
tys
where
tys :: [Type]
tys = TyCon -> [Type] -> [Type]
filterOutInvisibleTypes (Class -> TyCon
classTyCon Class
cls) [Type]
kts
hasTyVarHead :: Type -> Bool
hasTyVarHead :: Type -> Bool
hasTyVarHead Type
ty
| Type -> Bool
tcIsTyVarTy Type
ty = Bool
True
| Bool
otherwise
= case Type -> Maybe (Type, Type)
tcSplitAppTy_maybe Type
ty of
Just (Type
ty, Type
_) -> Type -> Bool
hasTyVarHead Type
ty
Maybe (Type, Type)
Nothing -> Bool
False
evVarPred :: EvVar -> PredType
evVarPred :: Var -> Type
evVarPred Var
var = Var -> Type
varType Var
var
pickQuantifiablePreds
:: TyVarSet
-> TcThetaType
-> TcThetaType
pickQuantifiablePreds :: VarSet -> [Type] -> [Type]
pickQuantifiablePreds VarSet
qtvs [Type]
theta
= let flex_ctxt :: Bool
flex_ctxt = Bool
True in
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Bool -> Type -> Maybe Type
pick_me Bool
flex_ctxt) [Type]
theta
where
pick_me :: Bool -> Type -> Maybe Type
pick_me Bool
flex_ctxt Type
pred
= case Type -> Pred
classifyPredType Type
pred of
ClassPred Class
cls [Type]
tys
| Just {} <- Class -> [Type] -> Maybe FastString
isCallStackPred Class
cls [Type]
tys
-> forall a. Maybe a
Nothing
| Class -> Bool
isIPClass Class
cls
-> forall a. a -> Maybe a
Just Type
pred
| Bool -> Class -> [Type] -> Bool
pick_cls_pred Bool
flex_ctxt Class
cls [Type]
tys
-> forall a. a -> Maybe a
Just Type
pred
EqPred EqRel
eq_rel Type
ty1 Type
ty2
| EqRel -> Type -> Type -> Bool
quantify_equality EqRel
eq_rel Type
ty1 Type
ty2
, Just (Class
cls, [Type]
tys) <- EqRel -> Type -> Type -> Maybe (Class, [Type])
boxEqPred EqRel
eq_rel Type
ty1 Type
ty2
, Bool -> Class -> [Type] -> Bool
pick_cls_pred Bool
flex_ctxt Class
cls [Type]
tys
-> forall a. a -> Maybe a
Just (Class -> [Type] -> Type
mkClassPred Class
cls [Type]
tys)
IrredPred Type
ty
| Type -> VarSet
tyCoVarsOfType Type
ty VarSet -> VarSet -> Bool
`intersectsVarSet` VarSet
qtvs
-> forall a. a -> Maybe a
Just Type
pred
Pred
_ -> forall a. Maybe a
Nothing
pick_cls_pred :: Bool -> Class -> [Type] -> Bool
pick_cls_pred Bool
flex_ctxt Class
cls [Type]
tys
= [Type] -> VarSet
tyCoVarsOfTypes [Type]
tys VarSet -> VarSet -> Bool
`intersectsVarSet` VarSet
qtvs
Bool -> Bool -> Bool
&& (Bool -> Class -> [Type] -> Bool
checkValidClsArgs Bool
flex_ctxt Class
cls [Type]
tys)
quantify_equality :: EqRel -> Type -> Type -> Bool
quantify_equality EqRel
NomEq Type
ty1 Type
ty2 = Type -> Bool
quant_fun Type
ty1 Bool -> Bool -> Bool
|| Type -> Bool
quant_fun Type
ty2
quantify_equality EqRel
ReprEq Type
_ Type
_ = Bool
True
quant_fun :: Type -> Bool
quant_fun Type
ty
= case HasCallStack => Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty of
Just (TyCon
tc, [Type]
tys) | TyCon -> Bool
isTypeFamilyTyCon TyCon
tc
-> [Type] -> VarSet
tyCoVarsOfTypes [Type]
tys VarSet -> VarSet -> Bool
`intersectsVarSet` VarSet
qtvs
Maybe (TyCon, [Type])
_ -> Bool
False
boxEqPred :: EqRel -> Type -> Type -> Maybe (Class, [Type])
boxEqPred :: EqRel -> Type -> Type -> Maybe (Class, [Type])
boxEqPred EqRel
eq_rel Type
ty1 Type
ty2
= case EqRel
eq_rel of
EqRel
NomEq | Bool
homo_kind -> forall a. a -> Maybe a
Just (Class
eqClass, [Type
k1, Type
ty1, Type
ty2])
| Bool
otherwise -> forall a. a -> Maybe a
Just (Class
heqClass, [Type
k1, Type
k2, Type
ty1, Type
ty2])
EqRel
ReprEq | Bool
homo_kind -> forall a. a -> Maybe a
Just (Class
coercibleClass, [Type
k1, Type
ty1, Type
ty2])
| Bool
otherwise -> forall a. Maybe a
Nothing
where
k1 :: Type
k1 = HasDebugCallStack => Type -> Type
tcTypeKind Type
ty1
k2 :: Type
k2 = HasDebugCallStack => Type -> Type
tcTypeKind Type
ty2
homo_kind :: Bool
homo_kind = Type
k1 HasDebugCallStack => Type -> Type -> Bool
`tcEqType` Type
k2
pickCapturedPreds
:: TyVarSet
-> TcThetaType
-> TcThetaType
pickCapturedPreds :: VarSet -> [Type] -> [Type]
pickCapturedPreds VarSet
qtvs [Type]
theta
= forall a. (a -> Bool) -> [a] -> [a]
filter Type -> Bool
captured [Type]
theta
where
captured :: Type -> Bool
captured Type
pred = Type -> Bool
isIPLikePred Type
pred Bool -> Bool -> Bool
|| (Type -> VarSet
tyCoVarsOfType Type
pred VarSet -> VarSet -> Bool
`intersectsVarSet` VarSet
qtvs)
type PredWithSCs a = (PredType, [PredType], a)
mkMinimalBySCs :: forall a. (a -> PredType) -> [a] -> [a]
mkMinimalBySCs :: forall a. (a -> Type) -> [a] -> [a]
mkMinimalBySCs a -> Type
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 = [ (Type
pred, Type -> [Type]
implicants Type
pred, a
x)
| a
x <- [a]
xs
, let pred :: Type
pred = a -> Type
get_pred a
x ]
go :: [PredWithSCs a]
-> [PredWithSCs a]
-> [a]
go :: [PredWithSCs a] -> [PredWithSCs a] -> [a]
go [] [PredWithSCs a]
min_preds
= forall a. [a] -> [a]
reverse (forall a b. (a -> b) -> [a] -> [b]
map forall a b c. (a, b, c) -> c
thdOf3 [PredWithSCs a]
min_preds)
go (work_item :: PredWithSCs a
work_item@(Type
p,[Type]
_,a
_) : [PredWithSCs a]
work_list) [PredWithSCs a]
min_preds
| EqPred EqRel
_ Type
t1 Type
t2 <- Type -> Pred
classifyPredType Type
p
, Type
t1 HasDebugCallStack => Type -> Type -> Bool
`tcEqType` Type
t2
= [PredWithSCs a] -> [PredWithSCs a] -> [a]
go [PredWithSCs a]
work_list [PredWithSCs a]
min_preds
| Type
p Type -> [PredWithSCs a] -> Bool
`in_cloud` [PredWithSCs a]
work_list Bool -> Bool -> Bool
|| Type
p Type -> [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 forall a. a -> [a] -> [a]
: [PredWithSCs a]
min_preds)
in_cloud :: PredType -> [PredWithSCs a] -> Bool
in_cloud :: Type -> [PredWithSCs a] -> Bool
in_cloud Type
p [PredWithSCs a]
ps = forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ Type
p HasDebugCallStack => Type -> Type -> Bool
`tcEqType` Type
p' | (Type
_, [Type]
scs, a
_) <- [PredWithSCs a]
ps, Type
p' <- [Type]
scs ]
implicants :: Type -> [Type]
implicants Type
pred
= Type
pred forall a. a -> [a] -> [a]
: Type -> [Type]
eq_extras Type
pred forall a. [a] -> [a] -> [a]
++ Type -> [Type]
transSuperClasses Type
pred
eq_extras :: Type -> [Type]
eq_extras Type
pred
= case Type -> Pred
classifyPredType Type
pred of
EqPred EqRel
r Type
t1 Type
t2 -> [Role -> Type -> Type -> Type
mkPrimEqPredRole (EqRel -> Role
eqRelRole EqRel
r) Type
t2 Type
t1]
ClassPred Class
cls [Type
k1,Type
k2,Type
t1,Type
t2]
| Class
cls forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey -> [Class -> [Type] -> Type
mkClassPred Class
cls [Type
k2, Type
k1, Type
t2, Type
t1]]
ClassPred Class
cls [Type
k,Type
t1,Type
t2]
| Class
cls forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey -> [Class -> [Type] -> Type
mkClassPred Class
cls [Type
k, Type
t2, Type
t1]]
Pred
_ -> []
transSuperClasses :: PredType -> [PredType]
transSuperClasses :: Type -> [Type]
transSuperClasses Type
p
= NameSet -> Type -> [Type]
go NameSet
emptyNameSet Type
p
where
go :: NameSet -> PredType -> [PredType]
go :: NameSet -> Type -> [Type]
go NameSet
rec_clss Type
p
| ClassPred Class
cls [Type]
tys <- Type -> Pred
classifyPredType Type
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
= [ Type
p' | Type
sc <- Class -> [Type] -> [Type]
immSuperClasses Class
cls [Type]
tys
, Type
p' <- Type
sc forall a. a -> [a] -> [a]
: NameSet -> Type -> [Type]
go NameSet
rec_clss' Type
sc ]
| Bool
otherwise
= []
immSuperClasses :: Class -> [Type] -> [PredType]
immSuperClasses :: Class -> [Type] -> [Type]
immSuperClasses Class
cls [Type]
tys
= HasCallStack => TCvSubst -> [Type] -> [Type]
substTheta (HasDebugCallStack => [Var] -> [Type] -> TCvSubst
zipTvSubst [Var]
tyvars [Type]
tys) [Type]
sc_theta
where
([Var]
tyvars,[Type]
sc_theta,[Var]
_,[ClassOpItem]
_) = Class -> ([Var], [Type], [Var], [ClassOpItem])
classBigSig Class
cls
isImprovementPred :: PredType -> Bool
isImprovementPred :: Type -> Bool
isImprovementPred Type
ty
= case Type -> Pred
classifyPredType Type
ty of
EqPred EqRel
NomEq Type
t1 Type
t2 -> Bool -> Bool
not (Type
t1 HasDebugCallStack => Type -> Type -> Bool
`tcEqType` Type
t2)
EqPred EqRel
ReprEq Type
_ Type
_ -> Bool
False
ClassPred Class
cls [Type]
_ -> Class -> Bool
classHasFds Class
cls
IrredPred {} -> Bool
True
ForAllPred {} -> Bool
False
isSigmaTy :: TcType -> Bool
isSigmaTy :: Type -> Bool
isSigmaTy Type
ty | Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Bool
isSigmaTy Type
ty'
isSigmaTy (ForAllTy {}) = Bool
True
isSigmaTy (FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
InvisArg }) = Bool
True
isSigmaTy Type
_ = Bool
False
isRhoTy :: TcType -> Bool
isRhoTy :: Type -> Bool
isRhoTy Type
ty | Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Bool
isRhoTy Type
ty'
isRhoTy (ForAllTy {}) = Bool
False
isRhoTy (FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
InvisArg }) = Bool
False
isRhoTy Type
_ = Bool
True
isRhoExpTy :: ExpType -> Bool
isRhoExpTy :: ExpType -> Bool
isRhoExpTy (Check Type
ty) = Type -> Bool
isRhoTy Type
ty
isRhoExpTy (Infer {}) = Bool
True
isOverloadedTy :: Type -> Bool
isOverloadedTy :: Type -> Bool
isOverloadedTy Type
ty | Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = Type -> Bool
isOverloadedTy Type
ty'
isOverloadedTy (ForAllTy TyCoVarBinder
_ Type
ty) = Type -> Bool
isOverloadedTy Type
ty
isOverloadedTy (FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
InvisArg }) = Bool
True
isOverloadedTy Type
_ = Bool
False
isFloatTy, isDoubleTy, isIntegerTy, isNaturalTy,
isIntTy, isWordTy, isBoolTy,
isUnitTy, isCharTy, isAnyTy :: Type -> Bool
isFloatTy :: Type -> Bool
isFloatTy = Unique -> Type -> Bool
is_tc Unique
floatTyConKey
isDoubleTy :: Type -> Bool
isDoubleTy = Unique -> Type -> Bool
is_tc Unique
doubleTyConKey
isIntegerTy :: Type -> Bool
isIntegerTy = Unique -> Type -> Bool
is_tc Unique
integerTyConKey
isNaturalTy :: Type -> Bool
isNaturalTy = Unique -> Type -> Bool
is_tc Unique
naturalTyConKey
isIntTy :: Type -> Bool
isIntTy = Unique -> Type -> Bool
is_tc Unique
intTyConKey
isWordTy :: Type -> Bool
isWordTy = Unique -> Type -> Bool
is_tc Unique
wordTyConKey
isBoolTy :: Type -> Bool
isBoolTy = Unique -> Type -> Bool
is_tc Unique
boolTyConKey
isUnitTy :: Type -> Bool
isUnitTy = Unique -> Type -> Bool
is_tc Unique
unitTyConKey
isCharTy :: Type -> Bool
isCharTy = Unique -> Type -> Bool
is_tc Unique
charTyConKey
isAnyTy :: Type -> Bool
isAnyTy = Unique -> Type -> Bool
is_tc Unique
anyTyConKey
isFloatingTy :: Type -> Bool
isFloatingTy :: Type -> Bool
isFloatingTy Type
ty = Type -> Bool
isFloatTy Type
ty Bool -> Bool -> Bool
|| Type -> Bool
isDoubleTy Type
ty
isStringTy :: Type -> Bool
isStringTy :: Type -> Bool
isStringTy Type
ty
= case HasCallStack => Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty of
Just (TyCon
tc, [Type
arg_ty]) -> TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
listTyCon Bool -> Bool -> Bool
&& Type -> Bool
isCharTy Type
arg_ty
Maybe (TyCon, [Type])
_ -> Bool
False
isCallStackTy :: Type -> Bool
isCallStackTy :: Type -> Bool
isCallStackTy Type
ty
| Just TyCon
tc <- Type -> Maybe TyCon
tyConAppTyCon_maybe Type
ty
= TyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
callStackTyConKey
| Bool
otherwise
= Bool
False
isCallStackPred :: Class -> [Type] -> Maybe FastString
isCallStackPred :: Class -> [Type] -> Maybe FastString
isCallStackPred Class
cls [Type]
tys
| [Type
ty1, Type
ty2] <- [Type]
tys
, Class -> Bool
isIPClass Class
cls
, Type -> Bool
isCallStackTy Type
ty2
= Type -> Maybe FastString
isStrLitTy Type
ty1
| Bool
otherwise
= forall a. Maybe a
Nothing
is_tc :: Unique -> Type -> Bool
is_tc :: Unique -> Type -> Bool
is_tc Unique
uniq Type
ty = case HasCallStack => Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty of
Just (TyCon
tc, [Type]
_) -> Unique
uniq forall a. Eq a => a -> a -> Bool
== forall a. Uniquable a => a -> Unique
getUnique TyCon
tc
Maybe (TyCon, [Type])
Nothing -> Bool
False
isRigidTy :: TcType -> Bool
isRigidTy :: Type -> Bool
isRigidTy Type
ty
| Just (TyCon
tc,[Type]
_) <- HasCallStack => Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty = TyCon -> Role -> Bool
isGenerativeTyCon TyCon
tc Role
Nominal
| Just {} <- Type -> Maybe (Type, Type)
tcSplitAppTy_maybe Type
ty = Bool
True
| Type -> Bool
isForAllTy Type
ty = Bool
True
| Bool
otherwise = Bool
False
deNoteType :: Type -> Type
deNoteType :: Type -> Type
deNoteType Type
ty | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> Type
deNoteType Type
ty'
deNoteType Type
ty = Type
ty
tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type)
tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type)
tcSplitIOType_maybe Type
ty
= case HasCallStack => Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty of
Just (TyCon
io_tycon, [Type
io_res_ty])
| TyCon
io_tycon forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ioTyConKey ->
forall a. a -> Maybe a
Just (TyCon
io_tycon, Type
io_res_ty)
Maybe (TyCon, [Type])
_ ->
forall a. Maybe a
Nothing
isFFITy :: Type -> Bool
isFFITy :: Type -> Bool
isFFITy Type
ty = Validity -> Bool
isValid ((TyCon -> Validity) -> Type -> Validity
checkRepTyCon TyCon -> Validity
legalFFITyCon Type
ty)
isFFIArgumentTy :: DynFlags -> Safety -> Type -> Validity
isFFIArgumentTy :: DynFlags -> Safety -> Type -> Validity
isFFIArgumentTy DynFlags
dflags Safety
safety Type
ty
= (TyCon -> Validity) -> Type -> Validity
checkRepTyCon (DynFlags -> Safety -> TyCon -> Validity
legalOutgoingTyCon DynFlags
dflags Safety
safety) Type
ty
isFFIExternalTy :: Type -> Validity
isFFIExternalTy :: Type -> Validity
isFFIExternalTy Type
ty = (TyCon -> Validity) -> Type -> Validity
checkRepTyCon TyCon -> Validity
legalFEArgTyCon Type
ty
isFFIImportResultTy :: DynFlags -> Type -> Validity
isFFIImportResultTy :: DynFlags -> Type -> Validity
isFFIImportResultTy DynFlags
dflags Type
ty
= (TyCon -> Validity) -> Type -> Validity
checkRepTyCon (DynFlags -> TyCon -> Validity
legalFIResultTyCon DynFlags
dflags) Type
ty
isFFIExportResultTy :: Type -> Validity
isFFIExportResultTy :: Type -> Validity
isFFIExportResultTy Type
ty = (TyCon -> Validity) -> Type -> Validity
checkRepTyCon TyCon -> Validity
legalFEResultTyCon Type
ty
isFFIDynTy :: Type -> Type -> Validity
isFFIDynTy :: Type -> Type -> Validity
isFFIDynTy Type
expected Type
ty
| Just (TyCon
tc, [Type
ty']) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty
, TyCon -> Unique
tyConUnique TyCon
tc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Unique
ptrTyConKey, Unique
funPtrTyConKey]
, Type -> Type -> Bool
eqType Type
ty' Type
expected
= Validity
IsValid
| Bool
otherwise
= SDoc -> Validity
NotValid ([SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Expected: Ptr/FunPtr" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprParendType Type
expected SDoc -> SDoc -> SDoc
<> SDoc
comma
, String -> SDoc
text String
" Actual:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Type
ty ])
isFFILabelTy :: Type -> Validity
isFFILabelTy :: Type -> Validity
isFFILabelTy Type
ty = (TyCon -> Validity) -> Type -> Validity
checkRepTyCon forall {a}. Uniquable a => a -> Validity
ok Type
ty
where
ok :: a -> Validity
ok a
tc | a
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
funPtrTyConKey Bool -> Bool -> Bool
|| a
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ptrTyConKey
= Validity
IsValid
| Bool
otherwise
= SDoc -> Validity
NotValid (String -> SDoc
text String
"A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)")
isFFIPrimArgumentTy :: DynFlags -> Type -> Validity
isFFIPrimArgumentTy :: DynFlags -> Type -> Validity
isFFIPrimArgumentTy DynFlags
dflags Type
ty
| Type -> Bool
isAnyTy Type
ty = Validity
IsValid
| Bool
otherwise = (TyCon -> Validity) -> Type -> Validity
checkRepTyCon (DynFlags -> TyCon -> Validity
legalFIPrimArgTyCon DynFlags
dflags) Type
ty
isFFIPrimResultTy :: DynFlags -> Type -> Validity
isFFIPrimResultTy :: DynFlags -> Type -> Validity
isFFIPrimResultTy DynFlags
dflags Type
ty
| Type -> Bool
isAnyTy Type
ty = Validity
IsValid
| Bool
otherwise = (TyCon -> Validity) -> Type -> Validity
checkRepTyCon (DynFlags -> TyCon -> Validity
legalFIPrimResultTyCon DynFlags
dflags) Type
ty
isFunPtrTy :: Type -> Bool
isFunPtrTy :: Type -> Bool
isFunPtrTy Type
ty
| Just (TyCon
tc, [Type
_]) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty
= TyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
funPtrTyConKey
| Bool
otherwise
= Bool
False
checkRepTyCon :: (TyCon -> Validity) -> Type -> Validity
checkRepTyCon :: (TyCon -> Validity) -> Type -> Validity
checkRepTyCon TyCon -> Validity
check_tc Type
ty
= case HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty of
Just (TyCon
tc, [Type]
tys)
| TyCon -> Bool
isNewTyCon TyCon
tc -> SDoc -> Validity
NotValid (SDoc -> Arity -> SDoc -> SDoc
hang SDoc
msg Arity
2 (forall {t :: * -> *} {a} {a}.
(Foldable t, Outputable a) =>
a -> t a -> SDoc
mk_nt_reason TyCon
tc [Type]
tys SDoc -> SDoc -> SDoc
$$ SDoc
nt_fix))
| Bool
otherwise -> case TyCon -> Validity
check_tc TyCon
tc of
Validity
IsValid -> Validity
IsValid
NotValid SDoc
extra -> SDoc -> Validity
NotValid (SDoc
msg SDoc -> SDoc -> SDoc
$$ SDoc
extra)
Maybe (TyCon, [Type])
Nothing -> SDoc -> Validity
NotValid (SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not a data type")
where
msg :: SDoc
msg = SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"cannot be marshalled in a foreign call"
mk_nt_reason :: a -> t a -> SDoc
mk_nt_reason a
tc t a
tys
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
tys = String -> SDoc
text String
"because its data constructor is not in scope"
| Bool
otherwise = String -> SDoc
text String
"because the data constructor for"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr a
tc) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not in scope"
nt_fix :: SDoc
nt_fix = String -> SDoc
text String
"Possible fix: import the data constructor to bring it into scope"
legalFEArgTyCon :: TyCon -> Validity
legalFEArgTyCon :: TyCon -> Validity
legalFEArgTyCon TyCon
tc
= TyCon -> Validity
boxedMarshalableTyCon TyCon
tc
legalFIResultTyCon :: DynFlags -> TyCon -> Validity
legalFIResultTyCon :: DynFlags -> TyCon -> Validity
legalFIResultTyCon DynFlags
dflags TyCon
tc
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
unitTyCon = Validity
IsValid
| Bool
otherwise = DynFlags -> TyCon -> Validity
marshalableTyCon DynFlags
dflags TyCon
tc
legalFEResultTyCon :: TyCon -> Validity
legalFEResultTyCon :: TyCon -> Validity
legalFEResultTyCon TyCon
tc
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
unitTyCon = Validity
IsValid
| Bool
otherwise = TyCon -> Validity
boxedMarshalableTyCon TyCon
tc
legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Validity
legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Validity
legalOutgoingTyCon DynFlags
dflags Safety
_ TyCon
tc
= DynFlags -> TyCon -> Validity
marshalableTyCon DynFlags
dflags TyCon
tc
legalFFITyCon :: TyCon -> Validity
legalFFITyCon :: TyCon -> Validity
legalFFITyCon TyCon
tc
| TyCon -> Bool
isUnliftedTyCon TyCon
tc = Validity
IsValid
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
unitTyCon = Validity
IsValid
| Bool
otherwise = TyCon -> Validity
boxedMarshalableTyCon TyCon
tc
marshalableTyCon :: DynFlags -> TyCon -> Validity
marshalableTyCon :: DynFlags -> TyCon -> Validity
marshalableTyCon DynFlags
dflags TyCon
tc
| TyCon -> Bool
isUnliftedTyCon TyCon
tc
, Bool -> Bool
not (TyCon -> Bool
isUnboxedTupleTyCon TyCon
tc Bool -> Bool -> Bool
|| TyCon -> Bool
isUnboxedSumTyCon TyCon
tc)
, Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (HasDebugCallStack => TyCon -> [PrimRep]
tyConPrimRep TyCon
tc))
= DynFlags -> Validity
validIfUnliftedFFITypes DynFlags
dflags
| Bool
otherwise
= TyCon -> Validity
boxedMarshalableTyCon TyCon
tc
boxedMarshalableTyCon :: TyCon -> Validity
boxedMarshalableTyCon :: TyCon -> Validity
boxedMarshalableTyCon TyCon
tc
| forall a. Uniquable a => a -> Unique
getUnique TyCon
tc 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
IsValid
| Bool
otherwise = SDoc -> Validity
NotValid SDoc
empty
legalFIPrimArgTyCon :: DynFlags -> TyCon -> Validity
legalFIPrimArgTyCon :: DynFlags -> TyCon -> Validity
legalFIPrimArgTyCon DynFlags
dflags TyCon
tc
| TyCon -> Bool
isUnliftedTyCon TyCon
tc
, Bool -> Bool
not (TyCon -> Bool
isUnboxedTupleTyCon TyCon
tc Bool -> Bool -> Bool
|| TyCon -> Bool
isUnboxedSumTyCon TyCon
tc)
= DynFlags -> Validity
validIfUnliftedFFITypes DynFlags
dflags
| Bool
otherwise
= SDoc -> Validity
NotValid SDoc
unlifted_only
legalFIPrimResultTyCon :: DynFlags -> TyCon -> Validity
legalFIPrimResultTyCon :: DynFlags -> TyCon -> Validity
legalFIPrimResultTyCon DynFlags
dflags TyCon
tc
| TyCon -> Bool
isUnliftedTyCon TyCon
tc
, TyCon -> Bool
isUnboxedTupleTyCon TyCon
tc Bool -> Bool -> Bool
|| TyCon -> Bool
isUnboxedSumTyCon TyCon
tc
Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (HasDebugCallStack => TyCon -> [PrimRep]
tyConPrimRep TyCon
tc))
= DynFlags -> Validity
validIfUnliftedFFITypes DynFlags
dflags
| Bool
otherwise
= SDoc -> Validity
NotValid SDoc
unlifted_only
unlifted_only :: SDoc
unlifted_only :: SDoc
unlifted_only = String -> SDoc
text String
"foreign import prim only accepts simple unlifted types"
validIfUnliftedFFITypes :: DynFlags -> Validity
validIfUnliftedFFITypes :: DynFlags -> Validity
validIfUnliftedFFITypes DynFlags
dflags
| Extension -> DynFlags -> Bool
xopt Extension
LangExt.UnliftedFFITypes DynFlags
dflags = Validity
IsValid
| Bool
otherwise = SDoc -> Validity
NotValid (String -> SDoc
text String
"To marshal unlifted types, use UnliftedFFITypes")
type TypeSize = IntWithInf
sizeType :: Type -> TypeSize
sizeType :: Type -> TypeSize
sizeType = Type -> TypeSize
go
where
go :: Type -> TypeSize
go Type
ty | Just Type
exp_ty <- Type -> Maybe Type
tcView Type
ty = Type -> TypeSize
go Type
exp_ty
go (TyVarTy {}) = TypeSize
1
go (TyConApp TyCon
tc [Type]
tys)
| TyCon -> Bool
isTypeFamilyTyCon TyCon
tc = TypeSize
infinity
| Bool
otherwise = [Type] -> TypeSize
sizeTypes (TyCon -> [Type] -> [Type]
filterOutInvisibleTypes TyCon
tc [Type]
tys) forall a. Num a => a -> a -> a
+ TypeSize
1
go (LitTy {}) = TypeSize
1
go (FunTy AnonArgFlag
_ Type
w Type
arg Type
res) = Type -> TypeSize
go Type
w forall a. Num a => a -> a -> a
+ Type -> TypeSize
go Type
arg forall a. Num a => a -> a -> a
+ Type -> TypeSize
go Type
res forall a. Num a => a -> a -> a
+ TypeSize
1
go (AppTy Type
fun Type
arg) = Type -> TypeSize
go Type
fun forall a. Num a => a -> a -> a
+ Type -> TypeSize
go Type
arg
go (ForAllTy (Bndr Var
tv ArgFlag
vis) Type
ty)
| ArgFlag -> Bool
isVisibleArgFlag ArgFlag
vis = Type -> TypeSize
go (Var -> Type
tyVarKind Var
tv) forall a. Num a => a -> a -> a
+ Type -> TypeSize
go Type
ty forall a. Num a => a -> a -> a
+ TypeSize
1
| Bool
otherwise = Type -> TypeSize
go Type
ty forall a. Num a => a -> a -> a
+ TypeSize
1
go (CastTy Type
ty KindCoercion
_) = Type -> TypeSize
go Type
ty
go (CoercionTy {}) = TypeSize
0
sizeTypes :: [Type] -> TypeSize
sizeTypes :: [Type] -> TypeSize
sizeTypes [Type]
tys = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map Type -> TypeSize
sizeType [Type]
tys)
tcTyConVisibilities :: TyCon -> [Bool]
tcTyConVisibilities :: TyCon -> [Bool]
tcTyConVisibilities TyCon
tc = [Bool]
tc_binder_viss forall a. [a] -> [a] -> [a]
++ [Bool]
tc_return_kind_viss forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Bool
True
where
tc_binder_viss :: [Bool]
tc_binder_viss = forall a b. (a -> b) -> [a] -> [b]
map forall tv. VarBndr tv TyConBndrVis -> Bool
isVisibleTyConBinder (TyCon -> [TyConBinder]
tyConBinders TyCon
tc)
tc_return_kind_viss :: [Bool]
tc_return_kind_viss = forall a b. (a -> b) -> [a] -> [b]
map TyBinder -> Bool
isVisibleBinder (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Type -> ([TyBinder], Type)
tcSplitPiTys (TyCon -> Type
tyConResKind TyCon
tc))
isNextTyConArgVisible :: TyCon -> [Type] -> Bool
isNextTyConArgVisible :: TyCon -> [Type] -> Bool
isNextTyConArgVisible TyCon
tc [Type]
tys
= TyCon -> [Bool]
tcTyConVisibilities TyCon
tc forall a. Outputable a => [a] -> Arity -> a
`getNth` forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Type]
tys
isNextArgVisible :: TcType -> Bool
isNextArgVisible :: Type -> Bool
isNextArgVisible Type
ty
| Just (TyBinder
bndr, Type
_) <- Type -> Maybe (TyBinder, Type)
tcSplitPiTy_maybe Type
ty = TyBinder -> Bool
isVisibleBinder TyBinder
bndr
| Bool
otherwise = Bool
True