{-# 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 Type)
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 Type
ty) = String -> SDoc
text String
"Check" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
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 :: 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 (ExpType -> SyntaxOpType)
-> (Type -> ExpType) -> Type -> SyntaxOpType
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 = (SyntaxOpType -> SyntaxOpType -> SyntaxOpType)
-> SyntaxOpType -> [SyntaxOpType] -> SyntaxOpType
forall a b. (a -> b -> b) -> b -> [a] -> b
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 :: HasCallStack => 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 Type
ty) = String -> SDoc
text String
"Indirect" SDoc -> SDoc -> SDoc
<+> Type -> 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"
  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
$c== :: TcLevel -> TcLevel -> Bool
== :: TcLevel -> TcLevel -> Bool
$c/= :: TcLevel -> TcLevel -> Bool
/= :: 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
$ccompare :: TcLevel -> TcLevel -> Ordering
compare :: TcLevel -> TcLevel -> Ordering
$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
>= :: TcLevel -> TcLevel -> Bool
$cmax :: TcLevel -> TcLevel -> TcLevel
max :: TcLevel -> TcLevel -> TcLevel
$cmin :: TcLevel -> TcLevel -> TcLevel
min :: TcLevel -> TcLevel -> TcLevel
Ord )
  
  
maxTcLevel :: TcLevel -> TcLevel -> TcLevel
maxTcLevel :: TcLevel -> TcLevel -> TcLevel
maxTcLevel (TcLevel Arity
a) (TcLevel Arity
b) = Arity -> TcLevel
TcLevel (Arity
a Arity -> Arity -> Arity
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 Arity -> Arity -> Arity
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 Arity -> Arity -> Bool
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 Arity -> Arity -> Bool
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 Arity -> Arity -> Bool
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 Arity -> Arity -> Bool
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 SkolemInfo
_ TcLevel
tv_lvl Bool
_           -> TcLevel
tv_lvl
          TcTyVarDetails
RuntimeUnk                    -> TcLevel
topTcLevel
tcTypeLevel :: TcType -> TcLevel
tcTypeLevel :: Type -> TcLevel
tcTypeLevel Type
ty
  = (Var -> TcLevel -> TcLevel) -> TcLevel -> DVarSet -> TcLevel
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) = Arity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Arity
us
tcTyFamInsts :: Type -> [(TyCon, [Type])]
tcTyFamInsts :: Type -> [(TyCon, [Type])]
tcTyFamInsts = ((Bool, TyCon, [Type]) -> (TyCon, [Type]))
-> [(Bool, TyCon, [Type])] -> [(TyCon, [Type])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Bool
_,TyCon
b,[Type]
c) -> (TyCon
b,[Type]
c)) ([(Bool, TyCon, [Type])] -> [(TyCon, [Type])])
-> (Type -> [(Bool, TyCon, [Type])]) -> Type -> [(TyCon, [Type])]
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, Arity -> [Type] -> [Type]
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 (TyCoVarBinder -> Type
forall argf. VarBndr Var argf -> Type
binderType TyCoVarBinder
bndr)
                                         [(Bool, TyCon, [Type])]
-> [(Bool, TyCon, [Type])] -> [(Bool, TyCon, [Type])]
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
                                         [(Bool, TyCon, [Type])]
-> [(Bool, TyCon, [Type])] -> [(Bool, TyCon, [Type])]
forall a. [a] -> [a] -> [a]
++ Bool -> Type -> [(Bool, TyCon, [Type])]
go Bool
is_invis_arg Type
ty1
                                         [(Bool, TyCon, [Type])]
-> [(Bool, TyCon, [Type])] -> [(Bool, TyCon, [Type])]
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
         [(Bool, TyCon, [Type])]
-> [(Bool, TyCon, [Type])] -> [(Bool, TyCon, [Type])]
forall a. [a] -> [a] -> [a]
++ [[(Bool, TyCon, [Type])]] -> [(Bool, TyCon, [Type])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((ArgFlag -> Type -> [(Bool, TyCon, [Type])])
-> [ArgFlag] -> [Type] -> [[(Bool, TyCon, [Type])]]
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 [[(Bool, TyCon, [Type])]] -> [(Bool, TyCon, [Type])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Bool, TyCon, [Type])]] -> [(Bool, TyCon, [Type])])
-> [[(Bool, TyCon, [Type])]] -> [(Bool, TyCon, [Type])]
forall a b. (a -> b) -> a -> b
$ (Type -> [(Bool, TyCon, [Type])])
-> [Type] -> [[(Bool, TyCon, [Type])]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVisX Bool
True)         [Type]
invis_tys
           [[(Bool, TyCon, [Type])]]
-> [[(Bool, TyCon, [Type])]] -> [[(Bool, TyCon, [Type])]]
forall a. [a] -> [a] -> [a]
++ (Type -> [(Bool, TyCon, [Type])])
-> [Type] -> [[(Bool, TyCon, [Type])]]
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 = [(TyCon, [Type])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(TyCon, [Type])] -> Bool)
-> (Type -> [(TyCon, [Type])]) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> [(TyCon, [Type])]
tcTyFamInsts
any_rewritable :: EqRel   
               -> (EqRel -> TcTyVar -> Bool)           
               -> (EqRel -> TyCon -> [TcType] -> Bool) 
               -> (TyCon -> Bool)                      
               -> TcType -> Bool
{-# INLINE any_rewritable #-} 
any_rewritable :: EqRel
-> (EqRel -> Var -> Bool)
-> (EqRel -> TyCon -> [Type] -> Bool)
-> (TyCon -> Bool)
-> Type
-> Bool
any_rewritable 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 = (() :: Constraint) => Type -> Type
Type -> Type
getRuntimeRep Type
arg 
            res_rep :: Type
res_rep = (() :: Constraint) => Type -> Type
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` TyCoVarBinder -> Var
forall tv argf. VarBndr tv argf -> tv
binderVar TyCoVarBinder
tv) Type
ty
    go EqRel
rl VarSet
bvs (CastTy Type
ty KindCoercion
_)      = EqRel -> VarSet -> Type -> Bool
go EqRel
rl VarSet
bvs Type
ty
    go EqRel
_  VarSet
_   (CoercionTy KindCoercion
_)     = Bool
False
    go_tc :: EqRel -> VarSet -> TyCon -> [Type] -> Bool
go_tc EqRel
NomEq  VarSet
bvs TyCon
_  [Type]
tys = (Type -> Bool) -> [Type] -> Bool
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 = ((Role, Type) -> Bool) -> [(Role, Type)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (VarSet -> (Role, Type) -> Bool
go_arg VarSet
bvs)
                              (TyCon -> [Role]
tyConRolesRepresentational TyCon
tc [Role] -> [Type] -> [(Role, Type)]
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  
anyRewritableTyVar :: EqRel    
                   -> (EqRel -> TcTyVar -> Bool)  
                   -> TcType -> Bool
anyRewritableTyVar :: EqRel -> (EqRel -> Var -> Bool) -> Type -> Bool
anyRewritableTyVar EqRel
role EqRel -> Var -> Bool
pred
  = EqRel
-> (EqRel -> Var -> Bool)
-> (EqRel -> TyCon -> [Type] -> Bool)
-> (TyCon -> Bool)
-> Type
-> Bool
any_rewritable 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
  = EqRel
-> (EqRel -> Var -> Bool)
-> (EqRel -> TyCon -> [Type] -> Bool)
-> (TyCon -> Bool)
-> Type
-> Bool
any_rewritable EqRel
role (\ EqRel
_ Var
_ -> Bool
False) EqRel -> TyCon -> [Type] -> 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 :: 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
_) = TyCoFolder VarSet (Endo VarSet)
-> VarSet
-> (Type -> Endo VarSet, [Type] -> Endo VarSet,
    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
  = Bool -> SDoc -> Bool -> Bool
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (TcLevel -> TcLevel -> Bool
checkTcLevelInvariant TcLevel
ctxt_tclvl TcLevel
tv_tclvl)
              (Var -> SDoc
forall a. Outputable a => a -> SDoc
ppr Var
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 :: 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
  = Bool -> SDoc -> Bool -> Bool
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Var -> Bool
tcIsTcTyVar Var
tv) (Var -> SDoc
forall a. Outputable a => a -> SDoc
ppr Var
tv) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
        MetaTv {} -> Bool
False
        TcTyVarDetails
_other    -> Bool
True
skolemSkolInfo :: TcTyVar -> SkolemInfo
skolemSkolInfo :: Var -> SkolemInfo
skolemSkolInfo Var
tv
  = Bool -> SkolemInfo -> SkolemInfo
forall a. HasCallStack => Bool -> a -> a
assert (Var -> Bool
isSkolemTyVar Var
tv) (SkolemInfo -> SkolemInfo) -> SkolemInfo -> SkolemInfo
forall a b. (a -> b) -> a -> b
$
    case Var -> TcTyVarDetails
tcTyVarDetails Var
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 :: Var -> Bool
isOverlappableTyVar Var
tv
  | Var -> Bool
isTyVar Var
tv 
  = case Var -> TcTyVarDetails
tcTyVarDetails Var
tv of
        SkolemTv SkolemInfo
_ 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
isConcreteTyVar_maybe :: TcTyVar -> Maybe ConcreteTvOrigin
isConcreteTyVar_maybe :: Var -> Maybe ConcreteTvOrigin
isConcreteTyVar_maybe Var
tv
  | Var -> Bool
isTcTyVar Var
tv
  , MetaTv { mtv_info :: TcTyVarDetails -> MetaInfo
mtv_info = ConcreteTv ConcreteTvOrigin
conc_orig } <- Var -> TcTyVarDetails
tcTyVarDetails Var
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 :: Var -> Bool
isConcreteTyVar = Maybe ConcreteTvOrigin -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ConcreteTvOrigin -> Bool)
-> (Var -> Maybe ConcreteTvOrigin) -> Var -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Maybe ConcreteTvOrigin
isConcreteTyVar_maybe
isConcreteTyVarTy :: TcType -> Bool
isConcreteTyVarTy :: Type -> Bool
isConcreteTyVarTy = Maybe (Var, ConcreteTvOrigin) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Var, ConcreteTvOrigin) -> Bool)
-> (Type -> Maybe (Var, ConcreteTvOrigin)) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Maybe (Var, ConcreteTvOrigin)
isConcreteTyVarTy_maybe
isConcreteTyVarTy_maybe :: TcType -> Maybe (TcTyVar, ConcreteTvOrigin)
isConcreteTyVarTy_maybe :: Type -> Maybe (Var, ConcreteTvOrigin)
isConcreteTyVarTy_maybe (TyVarTy Var
tv) = (Var
tv, ) (ConcreteTvOrigin -> (Var, ConcreteTvOrigin))
-> Maybe ConcreteTvOrigin -> Maybe (Var, ConcreteTvOrigin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Var -> Maybe ConcreteTvOrigin
isConcreteTyVar_maybe Var
tv
isConcreteTyVarTy_maybe Type
_            = Maybe (Var, ConcreteTvOrigin)
forall a. Maybe a
Nothing
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
_ -> String -> SDoc -> MetaInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarInfo" (Var -> SDoc
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
_ -> String -> SDoc -> TcLevel
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarTcLevel" (Var -> SDoc
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 } -> TcLevel -> Maybe TcLevel
forall a. a -> Maybe a
Just TcLevel
tclvl
      TcTyVarDetails
_                            -> Maybe TcLevel
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
_ -> String -> SDoc -> IORef MetaDetails
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarRef" (Var -> SDoc
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
_ -> String -> SDoc -> Var
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"metaTyVarTcLevel" (Var -> SDoc
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
  = (NonEmpty (Name, Var) -> [(Name, Name)])
-> [NonEmpty (Name, Var)] -> [(Name, Name)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (Name, Var) -> [(Name, Name)]
forall {b} {b}. NonEmpty (b, b) -> [(b, b)]
mk_result_prs ([NonEmpty (Name, Var)] -> [(Name, Name)])
-> [NonEmpty (Name, Var)] -> [(Name, Name)]
forall a b. (a -> b) -> a -> b
$
    ((Name, Var) -> (Name, Var) -> Bool)
-> [(Name, Var)] -> [NonEmpty (Name, Var)]
forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
findDupsEq (Name, Var) -> (Name, Var) -> Bool
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 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 :: Type -> ([Var], [Var])
ambigTkvsOfTy Type
ty
  = (Var -> Bool) -> [Var] -> ([Var], [Var])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Var -> VarSet -> Bool
`elemVarSet` VarSet
dep_tkv_set) [Var]
ambig_tkvs
  where
    tkvs :: [Var]
tkvs        = Type -> [Var]
tyCoVarsOfTypeList Type
ty
    ambig_tkvs :: [Var]
ambig_tkvs  = (Var -> Bool) -> [Var] -> [Var]
forall a. (a -> Bool) -> [a] -> [a]
filter Var -> Bool
isAmbiguousTyVar [Var]
tkvs
    dep_tkv_set :: VarSet
dep_tkv_set = [Type] -> VarSet
tyCoVarsOfTypes ((Var -> Type) -> [Var] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Type
tyVarKind [Var]
tkvs)
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 (ArgFlag -> [Var] -> [TyCoVarBinder]
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 (ArgFlag -> [Var] -> [TyCoVarBinder]
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)            = Var -> OccName
forall a. NamedThing a => a -> OccName
getOccName Var
tv
getDFunTyKey (TyConApp TyCon
tc [Type]
_)         = TyCon -> OccName
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 {})              = TyCon -> OccName
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
_)        = String -> SDoc -> OccName
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getDFunTyKey" (Type -> SDoc
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 (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 :: 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
  = Bool -> ([TyBinder], Type) -> ([TyBinder], Type)
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], Type) -> [TyBinder]
forall a b. (a, b) -> a
fst ([TyBinder], Type)
sty) ) ([TyBinder], Type)
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
  = Bool -> Maybe (TyBinder, Type) -> Maybe (TyBinder, Type)
forall a. HasCallStack => Bool -> a -> a
assert (Maybe (TyBinder, Type) -> Bool
forall {b}. Maybe (TyBinder, b) -> Bool
isMaybeTyBinder Maybe (TyBinder, Type)
sty ) Maybe (TyBinder, Type)
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) = Bool
-> ((TyCoVarBinder, Type) -> Maybe (TyCoVarBinder, Type))
-> (TyCoVarBinder, Type)
-> Maybe (TyCoVarBinder, Type)
forall a. HasCallStack => Bool -> a -> a
assert (TyCoVarBinder -> Bool
isTyVarBinder TyCoVarBinder
tv ) (TyCoVarBinder, Type) -> Maybe (TyCoVarBinder, Type)
forall a. a -> Maybe a
Just (TyCoVarBinder
tv, Type
ty)
tcSplitForAllTyVarBinder_maybe Type
_                = Maybe (TyCoVarBinder, Type)
forall a. Maybe a
Nothing
tcSplitForAllTyVars :: Type -> ([TyVar], Type)
tcSplitForAllTyVars :: Type -> ([Var], Type)
tcSplitForAllTyVars Type
ty
  = Bool -> ([Var], Type) -> ([Var], Type)
forall a. HasCallStack => Bool -> a -> a
assert ((Var -> Bool) -> [Var] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Var -> Bool
isTyVar (([Var], Type) -> [Var]
forall a b. (a, b) -> a
fst ([Var], Type)
sty) ) ([Var], Type)
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
tvVar -> [Var] -> [Var]
forall 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 = ([Var] -> [Var]
forall a. [a] -> [a]
reverse [Var]
tvs, Type
orig_ty)
tcSplitForAllReqTVBinders :: Type -> ([TcReqTVBinder], Type)
tcSplitForAllReqTVBinders :: Type -> ([TcReqTVBinder], Type)
tcSplitForAllReqTVBinders Type
ty = Bool -> ([TcReqTVBinder], Type) -> ([TcReqTVBinder], Type)
forall a. HasCallStack => Bool -> a -> a
assert ((TcReqTVBinder -> Bool) -> [TcReqTVBinder] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Var -> Bool
isTyVar (Var -> Bool) -> (TcReqTVBinder -> Var) -> TcReqTVBinder -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcReqTVBinder -> Var
forall tv argf. VarBndr tv argf -> tv
binderVar) (([TcReqTVBinder], Type) -> [TcReqTVBinder]
forall a b. (a, b) -> a
fst ([TcReqTVBinder], Type)
sty) ) ([TcReqTVBinder], Type)
sty
  where sty :: ([TcReqTVBinder], Type)
sty = Type -> ([TcReqTVBinder], Type)
splitForAllReqTVBinders Type
ty
tcSplitForAllInvisTVBinders :: Type -> ([TcInvisTVBinder], Type)
tcSplitForAllInvisTVBinders :: Type -> ([TcInvisTVBinder], Type)
tcSplitForAllInvisTVBinders Type
ty = Bool -> ([TcInvisTVBinder], Type) -> ([TcInvisTVBinder], Type)
forall a. HasCallStack => Bool -> a -> a
assert ((TcInvisTVBinder -> Bool) -> [TcInvisTVBinder] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Var -> Bool
isTyVar (Var -> Bool)
-> (TcInvisTVBinder -> Var) -> TcInvisTVBinder -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcInvisTVBinder -> Var
forall tv argf. VarBndr tv argf -> tv
binderVar) (([TcInvisTVBinder], Type) -> [TcInvisTVBinder]
forall a b. (a, b) -> a
fst ([TcInvisTVBinder], Type)
sty) ) ([TcInvisTVBinder], Type)
sty
  where sty :: ([TcInvisTVBinder], Type)
sty = Type -> ([TcInvisTVBinder], Type)
splitForAllInvisTVBinders Type
ty
tcSplitForAllTyVarBinders :: Type -> ([TyVarBinder], Type)
tcSplitForAllTyVarBinders :: Type -> ([TyCoVarBinder], Type)
tcSplitForAllTyVarBinders Type
ty = Bool -> ([TyCoVarBinder], Type) -> ([TyCoVarBinder], Type)
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], Type) -> [TyCoVarBinder]
forall a b. (a, b) -> a
fst ([TyCoVarBinder], Type)
sty)) ([TyCoVarBinder], Type)
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 })
  = (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
arg, Type
res)
tcSplitPredFunTy_maybe Type
_
  = Maybe (Type, 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
predType -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:[Type]
ts)
          Maybe (Type, Type)
Nothing         -> ([Type] -> [Type]
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 ([Var] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Var]
tvs1 Bool -> Bool -> Bool
&& [Type] -> Bool
forall a. [a] -> 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 [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
tvs2, [Type]
theta1 [Type] -> [Type] -> [Type]
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 -> String -> SDoc -> TyCon
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]
_)
  = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just TyCon
tc
tcTyConAppTyCon_maybe (FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
VisArg })
  = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just TyCon
funTyCon  
                   
tcTyConAppTyCon_maybe Type
_
  = Maybe TyCon
forall a. Maybe a
Nothing
tcTyConAppArgs :: Type -> [Type]
tcTyConAppArgs :: Type -> [Type]
tcTyConAppArgs Type
ty = case HasCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty of
                        Just (TyCon
_, [Type]
args) -> [Type]
args
                        Maybe (TyCon, [Type])
Nothing        -> String -> SDoc -> [Type]
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])
Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty of
                        Just (TyCon, [Type])
stuff -> (TyCon, [Type])
stuff
                        Maybe (TyCon, [Type])
Nothing    -> String -> SDoc -> (TyCon, [Type])
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
argScaled Type -> [Scaled Type] -> [Scaled Type]
forall 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 = (Scaled Type, Type) -> Maybe (Scaled Type, Type)
forall a. a -> Maybe a
Just (Type -> Type -> Scaled Type
forall a. Type -> a -> Scaled a
Scaled Type
w Type
arg, Type
res)
tcSplitFunTy_maybe Type
_ = Maybe (Scaled Type, 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 Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
0
 = ([Scaled Type], Type) -> Either Arity ([Scaled Type], Type)
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
nArity -> Arity -> Arity
forall a. Num a => a -> a -> a
-Arity
1) Type
res of
     Left Arity
m            -> Arity -> Either Arity ([Scaled Type], Type)
forall a b. a -> Either a b
Left Arity
m
     Right ([Scaled Type]
args,Type
body) -> ([Scaled Type], Type) -> Either Arity ([Scaled Type], Type)
forall a b. b -> Either a b
Right (Scaled Type
argScaled Type -> [Scaled Type] -> [Scaled Type]
forall a. a -> [a] -> [a]
:[Scaled Type]
args, Type
body)
 | Bool
otherwise
 = Arity -> Either Arity ([Scaled Type], Type)
forall a b. a -> Either a b
Left Arity
n
tcSplitFunTy :: Type -> (Scaled Type, Type)
tcSplitFunTy :: Type -> (Scaled Type, Type)
tcSplitFunTy  Type
ty = String -> Maybe (Scaled Type, Type) -> (Scaled Type, Type)
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 = (Scaled Type, Type) -> Scaled Type
forall a b. (a, b) -> a
fst (Type -> (Scaled Type, Type)
tcSplitFunTy Type
ty)
tcFunResultTy :: Type -> Type
tcFunResultTy :: Type -> Type
tcFunResultTy Type
ty = (Scaled Type, Type) -> Type
forall a b. (a, b) -> b
snd (Type -> (Scaled Type, Type)
tcSplitFunTy Type
ty)
tcFunResultTyN :: HasDebugCallStack => Arity -> Type -> Type
tcFunResultTyN :: (() :: Constraint) => 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
  = String -> SDoc -> Type
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcFunResultTyN" (Arity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Arity
n SDoc -> SDoc -> SDoc
<+> Type -> 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    -> String -> SDoc -> (Type, Type)
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
argType -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:[Type]
args)
                   Maybe (Type, Type)
Nothing         -> (Type
ty,[Type]
args)
tcRepGetNumAppTys :: Type -> Arity
tcRepGetNumAppTys :: Type -> Arity
tcRepGetNumAppTys = [Type] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length ([Type] -> Arity) -> (Type -> [Type]) -> Type -> Arity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type, [Type]) -> [Type]
forall a b. (a, b) -> b
snd ((Type, [Type]) -> [Type])
-> (Type -> (Type, [Type])) -> Type -> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() :: Constraint) => Type -> (Type, [Type])
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) = (Var, KindCoercion) -> Maybe (Var, KindCoercion)
forall a. a -> Maybe a
Just (Var
tv, KindCoercion
co)
tcGetCastedTyVar_maybe (TyVarTy Var
tv)             = (Var, KindCoercion) -> Maybe (Var, KindCoercion)
forall a. a -> Maybe a
Just (Var
tv, Type -> KindCoercion
mkNomReflCo (Var -> Type
tyVarKind Var
tv))
tcGetCastedTyVar_maybe Type
_                        = Maybe (Var, KindCoercion)
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)   = Var -> Maybe Var
forall a. a -> Maybe a
Just Var
tv
tcGetTyVar_maybe Type
_              = Maybe Var
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 -> String -> SDoc -> Var
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
msg (Type -> SDoc
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, (Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Scaled Type -> Type
forall a. Scaled a -> a
scaledThing [Scaled Type]
theta, Class
clas, [Type]
tys) }}}
tcSplitDFunHead :: Type -> (Class, [Type])
tcSplitDFunHead :: Type -> (Class, [Type])
tcSplitDFunHead = (() :: Constraint) => Type -> (Class, [Type])
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
  = String -> SDoc -> ([Var], Type, Type)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcSplitMethodTy" (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
tcEqKind :: HasDebugCallStack => TcKind -> TcKind -> Bool
tcEqKind :: (() :: Constraint) => Type -> Type -> Bool
tcEqKind = (() :: Constraint) => Type -> Type -> Bool
Type -> Type -> Bool
tcEqType
tcEqType :: HasDebugCallStack => TcType -> TcType -> Bool
tcEqType :: (() :: Constraint) => 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 = (() :: Constraint) => Type -> Type
Type -> Type
tcTypeKind Type
ty1
    ki2 :: Type
ki2 = (() :: Constraint) => Type -> Type
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 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 ((Type -> Type -> Bool) -> [Type] -> [Type] -> [Bool]
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 TyCon -> TyCon -> Bool
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 Var -> Var -> Bool
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 TyLit -> TyLit -> Bool
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 ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
arg1) ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
arg2) Bool -> Bool -> Bool
&&
                               RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
res1) ((() :: Constraint) => Type -> Type
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 TyCon -> TyCon -> Bool
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 [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
$ [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) -> (Type -> Bool) -> [Type] -> Bool
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         = (Type -> Bool) -> [Type] -> Bool
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
  
  
  
  
  
  
  
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 -> (Class, [Type]) -> Maybe (Class, [Type])
forall a. a -> Maybe a
Just (Class
eqClass,        [Type
k1,     Type
ty1, Type
ty2])
             | Bool
otherwise -> (Class, [Type]) -> Maybe (Class, [Type])
forall a. a -> Maybe a
Just (Class
heqClass,       [Type
k1, Type
k2, Type
ty1, Type
ty2])
      EqRel
ReprEq | Bool
homo_kind -> (Class, [Type]) -> Maybe (Class, [Type])
forall a. a -> Maybe a
Just (Class
coercibleClass, [Type
k1,     Type
ty1, Type
ty2])
             | Bool
otherwise -> Maybe (Class, [Type])
forall a. Maybe a
Nothing 
                                    
                                    
 where
   k1 :: Type
k1 = (() :: Constraint) => Type -> Type
Type -> Type
tcTypeKind Type
ty1
   k2 :: Type
k2 = (() :: Constraint) => Type -> Type
Type -> Type
tcTypeKind Type
ty2
   homo_kind :: Bool
homo_kind = Type
k1 (() :: Constraint) => Type -> Type -> Bool
Type -> Type -> Bool
`tcEqType` Type
k2
pickCapturedPreds
  :: TyVarSet           
  -> TcThetaType        
  -> TcThetaType        
pickCapturedPreds :: VarSet -> [Type] -> [Type]
pickCapturedPreds VarSet
qtvs [Type]
theta
  = (Type -> Bool) -> [Type] -> [Type]
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
     = [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@(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 (() :: Constraint) => Type -> Type -> Bool
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 PredWithSCs a -> [PredWithSCs a] -> [PredWithSCs a]
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 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ Type
p (() :: Constraint) => Type -> Type -> Bool
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 Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: Type -> [Type]
eq_extras Type
pred [Type] -> [Type] -> [Type]
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 Class -> Unique -> Bool
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 Class -> Unique -> Bool
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 Type -> [Type] -> [Type]
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
  = (() :: Constraint) => TCvSubst -> [Type] -> [Type]
TCvSubst -> [Type] -> [Type]
substTheta ([Var] -> [Type] -> TCvSubst
(() :: Constraint) => [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 (() :: Constraint) => Type -> Type -> Bool
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,
    isFloatPrimTy, isDoublePrimTy,
    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
isFloatPrimTy :: Type -> Bool
isFloatPrimTy  = Unique -> Type -> Bool
is_tc Unique
floatPrimTyConKey
isDoublePrimTy :: Type -> Bool
isDoublePrimTy = Unique -> Type -> Bool
is_tc Unique
doublePrimTyConKey
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
isFloatingPrimTy :: Type -> Bool
isFloatingPrimTy :: Type -> Bool
isFloatingPrimTy Type
ty = Type -> Bool
isFloatPrimTy Type
ty Bool -> Bool -> Bool
|| Type -> Bool
isDoublePrimTy Type
ty
isStringTy :: Type -> Bool
isStringTy :: Type -> Bool
isStringTy Type
ty
  = case HasCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty of
      Just (TyCon
tc, [Type
arg_ty]) -> TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
listTyCon Bool -> Bool -> Bool
&& Type -> Bool
isCharTy Type
arg_ty
      Maybe (TyCon, [Type])
_                   -> Bool
False
is_tc :: Unique -> Type -> Bool
is_tc :: Unique -> Type -> Bool
is_tc Unique
uniq Type
ty = case HasCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty of
                        Just (TyCon
tc, [Type]
_) -> 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, [Type])
Nothing      -> Bool
False
isRigidTy :: TcType -> Bool
isRigidTy :: Type -> Bool
isRigidTy Type
ty
  | Just (TyCon
tc,[Type]
_) <- HasCallStack => Type -> Maybe (TyCon, [Type])
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])
Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty of
        Just (TyCon
io_tycon, [Type
io_res_ty])
         | TyCon
io_tycon TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ioTyConKey ->
            (TyCon, Type) -> Maybe (TyCon, Type)
forall a. a -> Maybe a
Just (TyCon
io_tycon, Type
io_res_ty)
        Maybe (TyCon, [Type])
_ ->
            Maybe (TyCon, Type)
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
isFFIArgumentTy :: DynFlags -> Safety -> Type -> Validity' IllegalForeignTypeReason
isFFIArgumentTy :: DynFlags -> Safety -> Type -> Validity' IllegalForeignTypeReason
isFFIArgumentTy DynFlags
dflags Safety
safety Type
ty
   = (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> Type -> Validity' IllegalForeignTypeReason
checkRepTyCon (DynFlags
-> Safety -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalOutgoingTyCon DynFlags
dflags Safety
safety) Type
ty
isFFIExternalTy :: Type -> Validity' IllegalForeignTypeReason
isFFIExternalTy :: Type -> Validity' IllegalForeignTypeReason
isFFIExternalTy Type
ty = (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> Type -> Validity' IllegalForeignTypeReason
checkRepTyCon TyCon -> Validity' TypeCannotBeMarshaledReason
legalFEArgTyCon Type
ty
isFFIImportResultTy :: DynFlags -> Type -> Validity' IllegalForeignTypeReason
isFFIImportResultTy :: DynFlags -> Type -> Validity' IllegalForeignTypeReason
isFFIImportResultTy DynFlags
dflags Type
ty
  = (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> Type -> Validity' IllegalForeignTypeReason
checkRepTyCon (DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIResultTyCon DynFlags
dflags) Type
ty
isFFIExportResultTy :: Type -> Validity' IllegalForeignTypeReason
isFFIExportResultTy :: Type -> Validity' IllegalForeignTypeReason
isFFIExportResultTy Type
ty = (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> Type -> Validity' IllegalForeignTypeReason
checkRepTyCon TyCon -> Validity' TypeCannotBeMarshaledReason
legalFEResultTyCon Type
ty
isFFIDynTy :: Type -> Type -> Validity' IllegalForeignTypeReason
isFFIDynTy :: Type -> Type -> Validity' IllegalForeignTypeReason
isFFIDynTy Type
expected Type
ty
    
    
    
    | Just (TyCon
tc, [Type
ty']) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty
    , TyCon -> Unique
tyConUnique TyCon
tc Unique -> [Unique] -> Bool
forall a. Eq a => a -> [a] -> Bool
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' IllegalForeignTypeReason
forall a. Validity' a
IsValid
    | Bool
otherwise
    = IllegalForeignTypeReason -> Validity' IllegalForeignTypeReason
forall a. a -> Validity' a
NotValid (Type -> Type -> IllegalForeignTypeReason
ForeignDynNotPtr Type
expected Type
ty)
isFFILabelTy :: Type -> Validity' IllegalForeignTypeReason
isFFILabelTy :: Type -> Validity' IllegalForeignTypeReason
isFFILabelTy Type
ty = (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> Type -> Validity' IllegalForeignTypeReason
checkRepTyCon TyCon -> Validity' TypeCannotBeMarshaledReason
forall {a}.
Uniquable a =>
a -> Validity' TypeCannotBeMarshaledReason
ok Type
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
isFFIPrimArgumentTy :: DynFlags -> Type -> Validity' IllegalForeignTypeReason
isFFIPrimArgumentTy :: DynFlags -> Type -> Validity' IllegalForeignTypeReason
isFFIPrimArgumentTy DynFlags
dflags Type
ty
  | Type -> Bool
isAnyTy Type
ty = Validity' IllegalForeignTypeReason
forall a. Validity' a
IsValid
  | Bool
otherwise  = (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> Type -> Validity' IllegalForeignTypeReason
checkRepTyCon (DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIPrimArgTyCon DynFlags
dflags) Type
ty
isFFIPrimResultTy :: DynFlags -> Type -> Validity' IllegalForeignTypeReason
isFFIPrimResultTy :: DynFlags -> Type -> Validity' IllegalForeignTypeReason
isFFIPrimResultTy DynFlags
dflags Type
ty
  | Type -> Bool
isAnyTy Type
ty = Validity' IllegalForeignTypeReason
forall a. Validity' a
IsValid
  | Bool
otherwise = (TyCon -> Validity' TypeCannotBeMarshaledReason)
-> Type -> Validity' IllegalForeignTypeReason
checkRepTyCon (DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
legalFIPrimResultTyCon DynFlags
dflags) Type
ty
isFunPtrTy :: Type -> Bool
isFunPtrTy :: Type -> Bool
isFunPtrTy Type
ty
  | Just (TyCon
tc, [Type
_]) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
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)
-> Type -> Validity' IllegalForeignTypeReason
checkRepTyCon TyCon -> Validity' TypeCannotBeMarshaledReason
check_tc Type
ty
  = (TypeCannotBeMarshaledReason -> IllegalForeignTypeReason)
-> Validity' TypeCannotBeMarshaledReason
-> Validity' IllegalForeignTypeReason
forall a b. (a -> b) -> Validity' a -> Validity' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Type -> TypeCannotBeMarshaledReason -> IllegalForeignTypeReason
TypeCannotBeMarshaled Type
ty) (Validity' TypeCannotBeMarshaledReason
 -> Validity' IllegalForeignTypeReason)
-> Validity' TypeCannotBeMarshaledReason
-> Validity' IllegalForeignTypeReason
forall a b. (a -> b) -> a -> b
$ case (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty of
      Just (TyCon
tc, [Type]
tys)
        | TyCon -> Bool
isNewTyCon TyCon
tc -> TypeCannotBeMarshaledReason
-> Validity' TypeCannotBeMarshaledReason
forall a. a -> Validity' a
NotValid (TyCon -> [Type] -> TypeCannotBeMarshaledReason
forall {t :: * -> *} {a}.
Foldable t =>
TyCon -> t a -> TypeCannotBeMarshaledReason
mk_nt_reason TyCon
tc [Type]
tys)
        | Bool
otherwise     -> TyCon -> Validity' TypeCannotBeMarshaledReason
check_tc TyCon
tc
      Maybe (TyCon, [Type])
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 a. 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 (Type -> Bool
isLiftedTypeKind (TyCon -> Type
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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((() :: Constraint) => 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 a. Eq a => a -> [a] -> 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((() :: Constraint) => 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 :: 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) TypeSize -> TypeSize -> TypeSize
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 TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ Type -> TypeSize
go Type
arg TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ Type -> TypeSize
go Type
res TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ TypeSize
1
    go (AppTy Type
fun Type
arg)           = Type -> TypeSize
go Type
fun TypeSize -> TypeSize -> TypeSize
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) TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ Type -> TypeSize
go Type
ty TypeSize -> TypeSize -> TypeSize
forall a. Num a => a -> a -> a
+ TypeSize
1
        | Bool
otherwise              = Type -> TypeSize
go Type
ty TypeSize -> TypeSize -> TypeSize
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 = [TypeSize] -> TypeSize
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Type -> TypeSize) -> [Type] -> [TypeSize]
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 [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], Type) -> [TyBinder]
forall a b. (a, b) -> a
fst (([TyBinder], Type) -> [TyBinder])
-> ([TyBinder], Type) -> [TyBinder]
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 [Bool] -> Arity -> Bool
forall a. Outputable a => [a] -> Arity -> a
`getNth` [Type] -> Arity
forall a. [a] -> Arity
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