{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
module GHC.Core.TyCo.Compare (
eqType, eqTypeIgnoringMultiplicity, eqTypeX, eqTypes,
eqVarBndrs,
pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck,
tcEqTyConApps,
mayLookIdentical,
nonDetCmpType,
eqForAllVis, cmpForAllVis
) where
import GHC.Prelude
import GHC.Core.Type( typeKind, coreView, tcSplitAppTyNoView_maybe, splitAppTyNoView_maybe
, isLevityTy, isRuntimeRepTy, isMultiplicityTy )
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.FVs
import GHC.Core.TyCon
import GHC.Core.Multiplicity( MultiplicityFlag(..) )
import GHC.Types.Var
import GHC.Types.Unique
import GHC.Types.Var.Env
import GHC.Types.Var.Set
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Base (reallyUnsafePtrEquality#)
import qualified Data.Semigroup as S
tcEqKind :: HasDebugCallStack => Kind -> Kind -> Bool
tcEqKind :: HasDebugCallStack => Type -> Type -> Bool
tcEqKind = HasDebugCallStack => Type -> Type -> Bool
Type -> Type -> Bool
tcEqType
tcEqType :: HasDebugCallStack => Type -> Type -> Bool
tcEqType :: HasDebugCallStack => Type -> Type -> Bool
tcEqType = HasCallStack => Type -> Type -> Bool
Type -> Type -> Bool
eqType
tcEqTypeNoKindCheck :: Type -> Type -> Bool
tcEqTypeNoKindCheck :: Type -> Type -> Bool
tcEqTypeNoKindCheck = Type -> Type -> Bool
eqTypeNoKindCheck
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)
eqTypes :: [Type] -> [Type] -> Bool
eqTypes :: [Type] -> [Type] -> Bool
eqTypes [] [] = Bool
True
eqTypes (Type
t1:[Type]
ts1) (Type
t2:[Type]
ts2) = HasCallStack => Type -> Type -> Bool
Type -> Type -> Bool
eqType Type
t1 Type
t2 Bool -> Bool -> Bool
&& [Type] -> [Type] -> Bool
eqTypes [Type]
ts1 [Type]
ts2
eqTypes [Type]
_ [Type]
_ = Bool
False
eqVarBndrs :: HasCallStack => RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2
eqVarBndrs :: HasCallStack => RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2
eqVarBndrs RnEnv2
env [] []
= RnEnv2 -> Maybe RnEnv2
forall a. a -> Maybe a
Just RnEnv2
env
eqVarBndrs RnEnv2
env (Var
tv1:[Var]
tvs1) (Var
tv2:[Var]
tvs2)
| HasCallStack => RnEnv2 -> Type -> Type -> Bool
RnEnv2 -> Type -> Type -> Bool
eqTypeX RnEnv2
env (Var -> Type
varType Var
tv1) (Var -> Type
varType Var
tv2)
= HasCallStack => RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2
RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2
eqVarBndrs (RnEnv2 -> Var -> Var -> RnEnv2
rnBndr2 RnEnv2
env Var
tv1 Var
tv2) [Var]
tvs1 [Var]
tvs2
eqVarBndrs RnEnv2
_ [Var]
_ [Var]
_= Maybe RnEnv2
forall a. Maybe a
Nothing
initRnEnv :: Type -> Type -> RnEnv2
initRnEnv :: Type -> Type -> RnEnv2
initRnEnv Type
ta Type
tb = 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
tyCoVarsOfType Type
ta VarSet -> VarSet -> VarSet
`unionVarSet` Type -> VarSet
tyCoVarsOfType Type
tb
eqTypeNoKindCheck :: Type -> Type -> Bool
eqTypeNoKindCheck :: Type -> Type -> Bool
eqTypeNoKindCheck Type
ty1 Type
ty2 = Type -> Type -> Bool
eq_type_expand_respect Type
ty1 Type
ty2
eqType :: HasCallStack => Type -> Type -> Bool
eqType :: HasCallStack => Type -> Type -> Bool
eqType Type
ta Type
tb = (Type -> Type -> Bool) -> Type -> Type -> Bool
fullEq Type -> Type -> Bool
eq_type_expand_respect Type
ta Type
tb
eqTypeX :: HasCallStack => RnEnv2 -> Type -> Type -> Bool
eqTypeX :: HasCallStack => RnEnv2 -> Type -> Type -> Bool
eqTypeX RnEnv2
env Type
ta Type
tb = (Type -> Type -> Bool) -> Type -> Type -> Bool
fullEq (RnEnv2 -> Type -> Type -> Bool
eq_type_expand_respect_x RnEnv2
env) Type
ta Type
tb
eqTypeIgnoringMultiplicity :: Type -> Type -> Bool
eqTypeIgnoringMultiplicity :: Type -> Type -> Bool
eqTypeIgnoringMultiplicity Type
ta Type
tb = (Type -> Type -> Bool) -> Type -> Type -> Bool
fullEq Type -> Type -> Bool
eq_type_expand_ignore Type
ta Type
tb
pickyEqType :: Type -> Type -> Bool
pickyEqType :: Type -> Type -> Bool
pickyEqType Type
ta Type
tb = Type -> Type -> Bool
eq_type_keep_respect Type
ta Type
tb
data SynFlag = ExpandSynonyms | KeepSynonyms
eq_type_expand_respect, eq_type_expand_ignore, eq_type_keep_respect
:: Type -> Type -> Bool
eq_type_expand_respect_x, eq_type_expand_ignore_x, eq_type_keep_respect_x
:: RnEnv2 -> Type -> Type -> Bool
eq_type_expand_respect :: Type -> Type -> Bool
eq_type_expand_respect = SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
inline_generic_eq_type_x SynFlag
ExpandSynonyms MultiplicityFlag
RespectMultiplicities Maybe RnEnv2
forall a. Maybe a
Nothing
eq_type_expand_respect_x :: RnEnv2 -> Type -> Type -> Bool
eq_type_expand_respect_x RnEnv2
env = SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
inline_generic_eq_type_x SynFlag
ExpandSynonyms MultiplicityFlag
RespectMultiplicities (RnEnv2 -> Maybe RnEnv2
forall a. a -> Maybe a
Just RnEnv2
env)
eq_type_expand_ignore :: Type -> Type -> Bool
eq_type_expand_ignore = SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
inline_generic_eq_type_x SynFlag
ExpandSynonyms MultiplicityFlag
IgnoreMultiplicities Maybe RnEnv2
forall a. Maybe a
Nothing
eq_type_expand_ignore_x :: RnEnv2 -> Type -> Type -> Bool
eq_type_expand_ignore_x RnEnv2
env = SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
inline_generic_eq_type_x SynFlag
ExpandSynonyms MultiplicityFlag
IgnoreMultiplicities (RnEnv2 -> Maybe RnEnv2
forall a. a -> Maybe a
Just RnEnv2
env)
eq_type_keep_respect :: Type -> Type -> Bool
eq_type_keep_respect = SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
inline_generic_eq_type_x SynFlag
KeepSynonyms MultiplicityFlag
RespectMultiplicities Maybe RnEnv2
forall a. Maybe a
Nothing
eq_type_keep_respect_x :: RnEnv2 -> Type -> Type -> Bool
eq_type_keep_respect_x RnEnv2
env = SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
inline_generic_eq_type_x SynFlag
KeepSynonyms MultiplicityFlag
RespectMultiplicities (RnEnv2 -> Maybe RnEnv2
forall a. a -> Maybe a
Just RnEnv2
env)
{-# RULES
"eqType1" generic_eq_type_x ExpandSynonyms RespectMultiplicities Nothing
= eq_type_expand_respect
"eqType2" forall env. generic_eq_type_x ExpandSynonyms RespectMultiplicities (Just env)
= eq_type_expand_respect_x env
"eqType3" generic_eq_type_x ExpandSynonyms IgnoreMultiplicities Nothing
= eq_type_expand_ignore
"eqType4" forall env. generic_eq_type_x ExpandSynonyms IgnoreMultiplicities (Just env)
= eq_type_expand_ignore_x env
"eqType5" generic_eq_type_x KeepSynonyms RespectMultiplicities Nothing
= eq_type_keep_respect
"eqType6" forall env. generic_eq_type_x KeepSynonyms RespectMultiplicities (Just env)
= eq_type_keep_respect_x env
#-}
generic_eq_type_x, inline_generic_eq_type_x
:: SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
{-# NOINLINE generic_eq_type_x #-}
generic_eq_type_x :: SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
generic_eq_type_x = SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
inline_generic_eq_type_x
{-# INLINE inline_generic_eq_type_x #-}
inline_generic_eq_type_x :: SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
inline_generic_eq_type_x SynFlag
syn_flag MultiplicityFlag
mult_flag Maybe RnEnv2
mb_env
= \ Type
t1 Type
t2 -> Type
t1 Type -> Bool -> Bool
forall a b. a -> b -> b
`seq` Type
t2 Type -> Bool -> Bool
forall a b. a -> b -> b
`seq`
let go :: Type -> Type -> Bool
go = SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
generic_eq_type_x SynFlag
syn_flag MultiplicityFlag
mult_flag Maybe RnEnv2
mb_env
gos :: [Type] -> [Type] -> Bool
gos [] [] = Bool
True
gos (Type
t1:[Type]
ts1) (Type
t2:[Type]
ts2) = Type -> Type -> Bool
go Type
t1 Type
t2 Bool -> Bool -> Bool
&& [Type] -> [Type] -> Bool
gos [Type]
ts1 [Type]
ts2
gos [Type]
_ [Type]
_ = Bool
False
in case (Type
t1,Type
t2) of
(Type, Type)
_ | Int#
1# <- Type -> Type -> Int#
forall a b. a -> b -> Int#
reallyUnsafePtrEquality# Type
t1 Type
t2 -> Bool
True
(TyConApp TyCon
tc1 [Type]
tys1, TyConApp TyCon
tc2 [Type]
tys2)
| TyCon
tc1 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tc2, Bool -> Bool
not (TyCon -> Bool
isForgetfulSynTyCon TyCon
tc1)
-> [Type] -> [Type] -> Bool
gos [Type]
tys1 [Type]
tys2
(Type, Type)
_ | SynFlag
ExpandSynonyms <- SynFlag
syn_flag, Just Type
t1' <- Type -> Maybe Type
coreView Type
t1 -> Type -> Type -> Bool
go Type
t1' Type
t2
| SynFlag
ExpandSynonyms <- SynFlag
syn_flag, Just Type
t2' <- Type -> Maybe Type
coreView Type
t2 -> Type -> Type -> Bool
go Type
t1 Type
t2'
(TyConApp TyCon
tc1 [Type]
ts1, TyConApp TyCon
tc2 [Type]
ts2)
| TyCon
tc1 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tc2 -> [Type] -> [Type] -> Bool
gos [Type]
ts1 [Type]
ts2
| Bool
otherwise -> Bool
False
(TyVarTy Var
tv1, TyVarTy Var
tv2)
-> case Maybe RnEnv2
mb_env of
Maybe RnEnv2
Nothing -> Var
tv1 Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
tv2
Just RnEnv2
env -> 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
(LitTy TyLit
lit1, LitTy TyLit
lit2) -> TyLit
lit1 TyLit -> TyLit -> Bool
forall a. Eq a => a -> a -> Bool
== TyLit
lit2
(CastTy Type
t1' KindCoercion
_, Type
_) -> Type -> Type -> Bool
go Type
t1' Type
t2
(Type
_, CastTy Type
t2' KindCoercion
_) -> Type -> Type -> Bool
go Type
t1 Type
t2'
(CoercionTy {}, CoercionTy {}) -> Bool
True
(FunTy FunTyFlag
_ Type
w1 Type
arg1 Type
res1, FunTy FunTyFlag
_ Type
w2 Type
arg2 Type
res2)
-> (Type -> Type -> Bool) -> Type -> Type -> Bool
fullEq Type -> Type -> Bool
go Type
arg1 Type
arg2
Bool -> Bool -> Bool
&& (Type -> Type -> Bool) -> Type -> Type -> Bool
fullEq Type -> Type -> Bool
go Type
res1 Type
res2
Bool -> Bool -> Bool
&& (case MultiplicityFlag
mult_flag of
MultiplicityFlag
RespectMultiplicities -> Type -> Type -> Bool
go Type
w1 Type
w2
MultiplicityFlag
IgnoreMultiplicities -> Bool
True)
(AppTy Type
s1 Type
t1', Type
_)
| Just (Type
s2, Type
t2') <- Type -> Maybe (Type, Type)
tcSplitAppTyNoView_maybe Type
t2
-> Type -> Type -> Bool
go Type
s1 Type
s2 Bool -> Bool -> Bool
&& Type -> Type -> Bool
go Type
t1' Type
t2'
(Type
_, AppTy Type
s2 Type
t2')
| Just (Type
s1, Type
t1') <- Type -> Maybe (Type, Type)
tcSplitAppTyNoView_maybe Type
t1
-> Type -> Type -> Bool
go Type
s1 Type
s2 Bool -> Bool -> Bool
&& Type -> Type -> Bool
go Type
t1' Type
t2'
(ForAllTy (Bndr Var
tv1 ForAllTyFlag
vis1) Type
body1, ForAllTy (Bndr Var
tv2 ForAllTyFlag
vis2) Type
body2)
-> case Maybe RnEnv2
mb_env of
Maybe RnEnv2
Nothing -> SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
generic_eq_type_x SynFlag
syn_flag MultiplicityFlag
mult_flag
(RnEnv2 -> Maybe RnEnv2
forall a. a -> Maybe a
Just (Type -> Type -> RnEnv2
initRnEnv Type
t1 Type
t2)) Type
t1 Type
t2
Just RnEnv2
env
| ForAllTyFlag
vis1 ForAllTyFlag -> ForAllTyFlag -> Bool
`eqForAllVis` ForAllTyFlag
vis2
-> Type -> Type -> Bool
go (Var -> Type
varType Var
tv1) (Var -> Type
varType Var
tv2)
Bool -> Bool -> Bool
&& SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
generic_eq_type_x SynFlag
syn_flag MultiplicityFlag
mult_flag
(RnEnv2 -> Maybe RnEnv2
forall a. a -> Maybe a
Just (RnEnv2 -> Var -> Var -> RnEnv2
rnBndr2 RnEnv2
env Var
tv1 Var
tv2)) Type
body1 Type
body2
| Bool
otherwise
-> Bool
False
(Type, Type)
_ -> Bool
False
fullEq :: (Type -> Type -> Bool) -> Type -> Type -> Bool
{-# INLINE fullEq #-}
fullEq :: (Type -> Type -> Bool) -> Type -> Type -> Bool
fullEq Type -> Type -> Bool
eq Type
ty1 Type
ty2
= case Type -> Type -> Bool
eq Type
ty1 Type
ty2 of
Bool
False -> Bool
False
Bool
True | Type -> Bool
hasCasts Type
ty1 Bool -> Bool -> Bool
|| Type -> Bool
hasCasts Type
ty2
-> Type -> Type -> Bool
eq (HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
ty1) (HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
ty2)
| Bool
otherwise
-> Bool
True
hasCasts :: Type -> Bool
hasCasts :: Type -> Bool
hasCasts (CastTy {}) = Bool
True
hasCasts (CoercionTy {}) = Bool
True
hasCasts (AppTy Type
t1 Type
t2) = Type -> Bool
hasCasts Type
t1 Bool -> Bool -> Bool
|| Type -> Bool
hasCasts Type
t2
hasCasts (ForAllTy VarBndr Var ForAllTyFlag
_ Type
ty) = Type -> Bool
hasCasts Type
ty
hasCasts Type
_ = Bool
False
eqForAllVis :: ForAllTyFlag -> ForAllTyFlag -> Bool
eqForAllVis :: ForAllTyFlag -> ForAllTyFlag -> Bool
eqForAllVis ForAllTyFlag
Required ForAllTyFlag
Required = Bool
True
eqForAllVis (Invisible Specificity
_) (Invisible Specificity
_) = Bool
True
eqForAllVis ForAllTyFlag
_ ForAllTyFlag
_ = Bool
False
cmpForAllVis :: ForAllTyFlag -> ForAllTyFlag -> Ordering
cmpForAllVis :: ForAllTyFlag -> ForAllTyFlag -> Ordering
cmpForAllVis ForAllTyFlag
Required ForAllTyFlag
Required = Ordering
EQ
cmpForAllVis ForAllTyFlag
Required (Invisible {}) = Ordering
LT
cmpForAllVis (Invisible Specificity
_) ForAllTyFlag
Required = Ordering
GT
cmpForAllVis (Invisible Specificity
_) (Invisible Specificity
_) = Ordering
EQ
nonDetCmpType :: Type -> Type -> Ordering
{-# INLINE nonDetCmpType #-}
nonDetCmpType :: Type -> Type -> Ordering
nonDetCmpType !Type
t1 !Type
t2
| Int#
1# <- Type -> Type -> Int#
forall a b. a -> b -> Int#
reallyUnsafePtrEquality# Type
t1 Type
t2
= Ordering
EQ
nonDetCmpType (TyConApp TyCon
tc1 []) (TyConApp TyCon
tc2 []) | TyCon
tc1 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tc2
= Ordering
EQ
nonDetCmpType Type
t1 Type
t2
= RnEnv2 -> Type -> Type -> Ordering
nonDetCmpTypeX RnEnv2
rn_env Type
t1 Type
t2
where
rn_env :: RnEnv2
rn_env = InScopeSet -> RnEnv2
mkRnEnv2 (VarSet -> InScopeSet
mkInScopeSet ([Type] -> VarSet
tyCoVarsOfTypes [Type
t1, Type
t2]))
data TypeOrdering = TLT
| TEQ
| TEQX
| TGT
deriving (TypeOrdering -> TypeOrdering -> Bool
(TypeOrdering -> TypeOrdering -> Bool)
-> (TypeOrdering -> TypeOrdering -> Bool) -> Eq TypeOrdering
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeOrdering -> TypeOrdering -> Bool
== :: TypeOrdering -> TypeOrdering -> Bool
$c/= :: TypeOrdering -> TypeOrdering -> Bool
/= :: TypeOrdering -> TypeOrdering -> Bool
Eq, Eq TypeOrdering
Eq TypeOrdering =>
(TypeOrdering -> TypeOrdering -> Ordering)
-> (TypeOrdering -> TypeOrdering -> Bool)
-> (TypeOrdering -> TypeOrdering -> Bool)
-> (TypeOrdering -> TypeOrdering -> Bool)
-> (TypeOrdering -> TypeOrdering -> Bool)
-> (TypeOrdering -> TypeOrdering -> TypeOrdering)
-> (TypeOrdering -> TypeOrdering -> TypeOrdering)
-> Ord TypeOrdering
TypeOrdering -> TypeOrdering -> Bool
TypeOrdering -> TypeOrdering -> Ordering
TypeOrdering -> TypeOrdering -> TypeOrdering
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 :: TypeOrdering -> TypeOrdering -> Ordering
compare :: TypeOrdering -> TypeOrdering -> Ordering
$c< :: TypeOrdering -> TypeOrdering -> Bool
< :: TypeOrdering -> TypeOrdering -> Bool
$c<= :: TypeOrdering -> TypeOrdering -> Bool
<= :: TypeOrdering -> TypeOrdering -> Bool
$c> :: TypeOrdering -> TypeOrdering -> Bool
> :: TypeOrdering -> TypeOrdering -> Bool
$c>= :: TypeOrdering -> TypeOrdering -> Bool
>= :: TypeOrdering -> TypeOrdering -> Bool
$cmax :: TypeOrdering -> TypeOrdering -> TypeOrdering
max :: TypeOrdering -> TypeOrdering -> TypeOrdering
$cmin :: TypeOrdering -> TypeOrdering -> TypeOrdering
min :: TypeOrdering -> TypeOrdering -> TypeOrdering
Ord, Int -> TypeOrdering
TypeOrdering -> Int
TypeOrdering -> [TypeOrdering]
TypeOrdering -> TypeOrdering
TypeOrdering -> TypeOrdering -> [TypeOrdering]
TypeOrdering -> TypeOrdering -> TypeOrdering -> [TypeOrdering]
(TypeOrdering -> TypeOrdering)
-> (TypeOrdering -> TypeOrdering)
-> (Int -> TypeOrdering)
-> (TypeOrdering -> Int)
-> (TypeOrdering -> [TypeOrdering])
-> (TypeOrdering -> TypeOrdering -> [TypeOrdering])
-> (TypeOrdering -> TypeOrdering -> [TypeOrdering])
-> (TypeOrdering -> TypeOrdering -> TypeOrdering -> [TypeOrdering])
-> Enum TypeOrdering
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TypeOrdering -> TypeOrdering
succ :: TypeOrdering -> TypeOrdering
$cpred :: TypeOrdering -> TypeOrdering
pred :: TypeOrdering -> TypeOrdering
$ctoEnum :: Int -> TypeOrdering
toEnum :: Int -> TypeOrdering
$cfromEnum :: TypeOrdering -> Int
fromEnum :: TypeOrdering -> Int
$cenumFrom :: TypeOrdering -> [TypeOrdering]
enumFrom :: TypeOrdering -> [TypeOrdering]
$cenumFromThen :: TypeOrdering -> TypeOrdering -> [TypeOrdering]
enumFromThen :: TypeOrdering -> TypeOrdering -> [TypeOrdering]
$cenumFromTo :: TypeOrdering -> TypeOrdering -> [TypeOrdering]
enumFromTo :: TypeOrdering -> TypeOrdering -> [TypeOrdering]
$cenumFromThenTo :: TypeOrdering -> TypeOrdering -> TypeOrdering -> [TypeOrdering]
enumFromThenTo :: TypeOrdering -> TypeOrdering -> TypeOrdering -> [TypeOrdering]
Enum, TypeOrdering
TypeOrdering -> TypeOrdering -> Bounded TypeOrdering
forall a. a -> a -> Bounded a
$cminBound :: TypeOrdering
minBound :: TypeOrdering
$cmaxBound :: TypeOrdering
maxBound :: TypeOrdering
Bounded)
nonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering
nonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering
nonDetCmpTypeX RnEnv2
env Type
orig_t1 Type
orig_t2 =
case RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
orig_t1 Type
orig_t2 of
TypeOrdering
TEQX -> TypeOrdering -> Ordering
toOrdering (TypeOrdering -> Ordering) -> TypeOrdering -> Ordering
forall a b. (a -> b) -> a -> b
$ RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
k1 Type
k2
TypeOrdering
ty_ordering -> TypeOrdering -> Ordering
toOrdering TypeOrdering
ty_ordering
where
k1 :: Type
k1 = HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
orig_t1
k2 :: Type
k2 = HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
orig_t2
toOrdering :: TypeOrdering -> Ordering
toOrdering :: TypeOrdering -> Ordering
toOrdering TypeOrdering
TLT = Ordering
LT
toOrdering TypeOrdering
TEQ = Ordering
EQ
toOrdering TypeOrdering
TEQX = Ordering
EQ
toOrdering TypeOrdering
TGT = Ordering
GT
liftOrdering :: Ordering -> TypeOrdering
liftOrdering :: Ordering -> TypeOrdering
liftOrdering Ordering
LT = TypeOrdering
TLT
liftOrdering Ordering
EQ = TypeOrdering
TEQ
liftOrdering Ordering
GT = TypeOrdering
TGT
thenCmpTy :: TypeOrdering -> TypeOrdering -> TypeOrdering
thenCmpTy :: TypeOrdering -> TypeOrdering -> TypeOrdering
thenCmpTy TypeOrdering
TEQ TypeOrdering
rel = TypeOrdering
rel
thenCmpTy TypeOrdering
TEQX TypeOrdering
rel = TypeOrdering -> TypeOrdering
hasCast TypeOrdering
rel
thenCmpTy TypeOrdering
rel TypeOrdering
_ = TypeOrdering
rel
hasCast :: TypeOrdering -> TypeOrdering
hasCast :: TypeOrdering -> TypeOrdering
hasCast TypeOrdering
TEQ = TypeOrdering
TEQX
hasCast TypeOrdering
rel = TypeOrdering
rel
go :: RnEnv2 -> Type -> Type -> TypeOrdering
go :: RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
_ (TyConApp TyCon
tc1 []) (TyConApp TyCon
tc2 [])
| TyCon
tc1 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tc2
= TypeOrdering
TEQ
go RnEnv2
env Type
t1 Type
t2
| Just Type
t1' <- Type -> Maybe Type
coreView Type
t1 = RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
t1' Type
t2
| Just Type
t2' <- Type -> Maybe Type
coreView Type
t2 = RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
t1 Type
t2'
go RnEnv2
env (TyVarTy Var
tv1) (TyVarTy Var
tv2)
= Ordering -> TypeOrdering
liftOrdering (Ordering -> TypeOrdering) -> Ordering -> TypeOrdering
forall a b. (a -> b) -> a -> b
$ RnEnv2 -> Var -> Var
rnOccL RnEnv2
env Var
tv1 Var -> Var -> Ordering
`nonDetCmpVar` RnEnv2 -> Var -> Var
rnOccR RnEnv2
env Var
tv2
go RnEnv2
env (ForAllTy (Bndr Var
tv1 ForAllTyFlag
vis1) Type
t1) (ForAllTy (Bndr Var
tv2 ForAllTyFlag
vis2) Type
t2)
= Ordering -> TypeOrdering
liftOrdering (ForAllTyFlag
vis1 ForAllTyFlag -> ForAllTyFlag -> Ordering
`cmpForAllVis` ForAllTyFlag
vis2)
TypeOrdering -> TypeOrdering -> TypeOrdering
`thenCmpTy` RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env (Var -> Type
varType Var
tv1) (Var -> Type
varType Var
tv2)
TypeOrdering -> TypeOrdering -> TypeOrdering
`thenCmpTy` RnEnv2 -> Type -> Type -> TypeOrdering
go (RnEnv2 -> Var -> Var -> RnEnv2
rnBndr2 RnEnv2
env Var
tv1 Var
tv2) Type
t1 Type
t2
go RnEnv2
env (AppTy Type
s1 Type
t1) Type
ty2
| Just (Type
s2, Type
t2) <- HasDebugCallStack => Type -> Maybe (Type, Type)
Type -> Maybe (Type, Type)
splitAppTyNoView_maybe Type
ty2
= RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
s1 Type
s2 TypeOrdering -> TypeOrdering -> TypeOrdering
`thenCmpTy` RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
t1 Type
t2
go RnEnv2
env Type
ty1 (AppTy Type
s2 Type
t2)
| Just (Type
s1, Type
t1) <- HasDebugCallStack => Type -> Maybe (Type, Type)
Type -> Maybe (Type, Type)
splitAppTyNoView_maybe Type
ty1
= RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
s1 Type
s2 TypeOrdering -> TypeOrdering -> TypeOrdering
`thenCmpTy` RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
t1 Type
t2
go RnEnv2
env (FunTy FunTyFlag
_ Type
w1 Type
s1 Type
t1) (FunTy FunTyFlag
_ Type
w2 Type
s2 Type
t2)
= Ordering -> TypeOrdering
liftOrdering (RnEnv2 -> Type -> Type -> Ordering
nonDetCmpTypeX RnEnv2
env Type
s1 Type
s2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<> RnEnv2 -> Type -> Type -> Ordering
nonDetCmpTypeX RnEnv2
env Type
t1 Type
t2)
TypeOrdering -> TypeOrdering -> TypeOrdering
`thenCmpTy` RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
w1 Type
w2
go RnEnv2
env (TyConApp TyCon
tc1 [Type]
tys1) (TyConApp TyCon
tc2 [Type]
tys2)
= Ordering -> TypeOrdering
liftOrdering (TyCon
tc1 TyCon -> TyCon -> Ordering
`nonDetCmpTc` TyCon
tc2) TypeOrdering -> TypeOrdering -> TypeOrdering
`thenCmpTy` RnEnv2 -> [Type] -> [Type] -> TypeOrdering
gos RnEnv2
env [Type]
tys1 [Type]
tys2
go RnEnv2
_ (LitTy TyLit
l1) (LitTy TyLit
l2) = Ordering -> TypeOrdering
liftOrdering (TyLit -> TyLit -> Ordering
nonDetCmpTyLit TyLit
l1 TyLit
l2)
go RnEnv2
env (CastTy Type
t1 KindCoercion
_) Type
t2 = TypeOrdering -> TypeOrdering
hasCast (TypeOrdering -> TypeOrdering) -> TypeOrdering -> TypeOrdering
forall a b. (a -> b) -> a -> b
$ RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
t1 Type
t2
go RnEnv2
env Type
t1 (CastTy Type
t2 KindCoercion
_) = TypeOrdering -> TypeOrdering
hasCast (TypeOrdering -> TypeOrdering) -> TypeOrdering -> TypeOrdering
forall a b. (a -> b) -> a -> b
$ RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
t1 Type
t2
go RnEnv2
_ (CoercionTy {}) (CoercionTy {}) = TypeOrdering
TEQ
go RnEnv2
_ Type
ty1 Type
ty2
= Ordering -> TypeOrdering
liftOrdering (Ordering -> TypeOrdering) -> Ordering -> TypeOrdering
forall a b. (a -> b) -> a -> b
$ (Type -> Int
get_rank Type
ty1) Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Type -> Int
get_rank Type
ty2)
where get_rank :: Type -> Int
get_rank :: Type -> Int
get_rank (CastTy {})
= String -> SDoc -> Int
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"nonDetCmpTypeX.get_rank" ([Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type
ty1,Type
ty2])
get_rank (TyVarTy {}) = Int
0
get_rank (CoercionTy {}) = Int
1
get_rank (AppTy {}) = Int
3
get_rank (LitTy {}) = Int
4
get_rank (TyConApp {}) = Int
5
get_rank (FunTy {}) = Int
6
get_rank (ForAllTy {}) = Int
7
gos :: RnEnv2 -> [Type] -> [Type] -> TypeOrdering
gos :: RnEnv2 -> [Type] -> [Type] -> TypeOrdering
gos RnEnv2
_ [] [] = TypeOrdering
TEQ
gos RnEnv2
_ [] [Type]
_ = TypeOrdering
TLT
gos RnEnv2
_ [Type]
_ [] = TypeOrdering
TGT
gos RnEnv2
env (Type
ty1:[Type]
tys1) (Type
ty2:[Type]
tys2) = RnEnv2 -> Type -> Type -> TypeOrdering
go RnEnv2
env Type
ty1 Type
ty2 TypeOrdering -> TypeOrdering -> TypeOrdering
`thenCmpTy` RnEnv2 -> [Type] -> [Type] -> TypeOrdering
gos RnEnv2
env [Type]
tys1 [Type]
tys2
nonDetCmpTc :: TyCon -> TyCon -> Ordering
nonDetCmpTc :: TyCon -> TyCon -> Ordering
nonDetCmpTc TyCon
tc1 TyCon
tc2
= Unique
u1 Unique -> Unique -> Ordering
`nonDetCmpUnique` Unique
u2
where
u1 :: Unique
u1 = TyCon -> Unique
tyConUnique TyCon
tc1
u2 :: Unique
u2 = TyCon -> Unique
tyConUnique TyCon
tc2
mayLookIdentical :: Type -> Type -> Bool
mayLookIdentical :: Type -> Type -> Bool
mayLookIdentical Type
orig_ty1 Type
orig_ty2
= RnEnv2 -> Type -> Type -> Bool
go RnEnv2
orig_env Type
orig_ty1 Type
orig_ty2
where
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]
go :: RnEnv2 -> Type -> Type -> Bool
go :: RnEnv2 -> Type -> Type -> Bool
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
not (TyCon -> Bool
isForgetfulSynTyCon TyCon
tc1)
= RnEnv2 -> [TyConBinder] -> [Type] -> [Type] -> Bool
gos RnEnv2
env (TyCon -> [TyConBinder]
tyConBinders TyCon
tc1) [Type]
ts1 [Type]
ts2
go RnEnv2
env Type
t1 Type
t2 | Just Type
t1' <- Type -> Maybe Type
coreView Type
t1 = RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
t1' Type
t2
go RnEnv2
env Type
t1 Type
t2 | Just Type
t2' <- Type -> Maybe Type
coreView 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 (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
env (ForAllTy (Bndr Var
tv1 ForAllTyFlag
vis1) Type
ty1)
(ForAllTy (Bndr Var
tv2 ForAllTyFlag
vis2) Type
ty2)
= ForAllTyFlag
vis1 ForAllTyFlag -> ForAllTyFlag -> Bool
`eqForAllVis` ForAllTyFlag
vis2
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
_ (ForAllTy VarBndr Var ForAllTyFlag
b Type
_) Type
_ | VarBndr Var ForAllTyFlag -> Bool
isDefaultableBndr VarBndr Var ForAllTyFlag
b = Bool
True
go RnEnv2
_ Type
_ (ForAllTy VarBndr Var ForAllTyFlag
b Type
_) | VarBndr Var ForAllTyFlag -> Bool
isDefaultableBndr VarBndr Var ForAllTyFlag
b = Bool
True
go RnEnv2
env (FunTy FunTyFlag
_ Type
w1 Type
arg1 Type
res1) (FunTy FunTyFlag
_ Type
w2 Type
arg2 Type
res2)
= 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
go RnEnv2
env (AppTy Type
s1 Type
t1) Type
ty2
| Just (Type
s2, Type
t2) <- Type -> Maybe (Type, Type)
tcSplitAppTyNoView_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)
tcSplitAppTyNoView_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 -> [TyConBinder] -> [Type] -> [Type] -> Bool
gos RnEnv2
env (TyCon -> [TyConBinder]
tyConBinders TyCon
tc1) [Type]
ts1 [Type]
ts2
go RnEnv2
_ Type
_ Type
_ = Bool
False
gos :: RnEnv2 -> [TyConBinder] -> [Type] -> [Type] -> Bool
gos :: RnEnv2 -> [TyConBinder] -> [Type] -> [Type] -> Bool
gos RnEnv2
_ [TyConBinder]
_ [] [] = Bool
True
gos RnEnv2
env [TyConBinder]
bs (Type
t1:[Type]
ts1) (Type
t2:[Type]
ts2)
| (Bool
invisible, [TyConBinder]
bs') <- case [TyConBinder]
bs of
[] -> (Bool
False, [])
(TyConBinder
b:[TyConBinder]
bs) -> (TyConBinder -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder TyConBinder
b, [TyConBinder]
bs)
= (Bool
invisible Bool -> Bool -> Bool
|| RnEnv2 -> Type -> Type -> Bool
go RnEnv2
env Type
t1 Type
t2) Bool -> Bool -> Bool
&& RnEnv2 -> [TyConBinder] -> [Type] -> [Type] -> Bool
gos RnEnv2
env [TyConBinder]
bs' [Type]
ts1 [Type]
ts2
gos RnEnv2
_ [TyConBinder]
_ [Type]
_ [Type]
_ = Bool
False
isDefaultableBndr :: ForAllTyBinder -> Bool
isDefaultableBndr :: VarBndr Var ForAllTyFlag -> Bool
isDefaultableBndr (Bndr Var
tv ForAllTyFlag
vis)
= ForAllTyFlag -> Bool
isInvisibleForAllTyFlag ForAllTyFlag
vis Bool -> Bool -> Bool
&& Type -> Bool
is_defaultable (Var -> Type
tyVarKind Var
tv)
where
is_defaultable :: Type -> Bool
is_defaultable Type
ki = Type -> Bool
isLevityTy Type
ki Bool -> Bool -> Bool
|| Type -> Bool
isRuntimeRepTy Type
ki Bool -> Bool -> Bool
|| Type -> Bool
isMultiplicityTy Type
ki