diff options
-rw-r--r-- | compiler/GHC/Core/Predicate.hs | 18 | ||||
-rw-r--r-- | compiler/GHC/Tc/Solver/Dict.hs | 9 | ||||
-rw-r--r-- | compiler/GHC/Tc/Solver/InertSet.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/Types/Constraint.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/TcType.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/Tc/Validity.hs | 2 |
6 files changed, 17 insertions, 23 deletions
diff --git a/compiler/GHC/Core/Predicate.hs b/compiler/GHC/Core/Predicate.hs index 4abe331c4e..86acfbee23 100644 --- a/compiler/GHC/Core/Predicate.hs +++ b/compiler/GHC/Core/Predicate.hs @@ -20,7 +20,7 @@ module GHC.Core.Predicate ( -- Class predicates mkClassPred, isDictTy, typeDeterminesValue, - isClassPred, isEqPredClass, isCTupleClass, + isClassPred, isEqualityClass, isCTupleClass, getClassPredTys, getClassPredTys_maybe, classMethodTy, classMethodInstTy, @@ -217,11 +217,6 @@ isEvVarType :: Type -> Bool -- See Note [Evidence for quantified constraints] isEvVarType ty = isCoVarType ty || isPredTy ty -isEqPredClass :: Class -> Bool --- True of (~) and (~~) -isEqPredClass cls = cls `hasKey` eqTyConKey - || cls `hasKey` heqTyConKey - isClassPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tc -> isClassTyCon tc @@ -232,7 +227,7 @@ isEqPred ty -- True of (a ~ b) and (a ~~ b) -- ToDo: should we check saturation? | Just tc <- tyConAppTyCon_maybe ty , Just cls <- tyConClass_maybe tc - = isEqPredClass cls + = isEqualityClass cls | otherwise = False @@ -240,9 +235,18 @@ isEqPrimPred :: PredType -> Bool isEqPrimPred ty = isCoVarType ty -- True of (a ~# b) (a ~R# b) +isEqualityClass :: Class -> Bool +-- True of (~), (~~), and Coercible +-- These all have a single primitive-equality superclass, either (~N# or ~R#) +isEqualityClass cls + = cls `hasKey` heqTyConKey + || cls `hasKey` eqTyConKey + || cls `hasKey` coercibleTyConKey + isCTupleClass :: Class -> Bool isCTupleClass cls = isTupleTyCon (classTyCon cls) + {- ********************************************************************* * * Implicit parameters diff --git a/compiler/GHC/Tc/Solver/Dict.hs b/compiler/GHC/Tc/Solver/Dict.hs index 5ff413ba41..c48cab8616 100644 --- a/compiler/GHC/Tc/Solver/Dict.hs +++ b/compiler/GHC/Tc/Solver/Dict.hs @@ -848,15 +848,6 @@ naturallyCoherentClass cls = isCTupleClass cls || isEqualityClass cls -} -isEqualityClass :: Class -> Bool --- True of (~), (~~), and Coercible --- These all have a single primitive-equality superclass, either (~N# or ~R#) -isEqualityClass cls - = cls `hasKey` heqTyConKey - || cls `hasKey` eqTyConKey - || cls `hasKey` coercibleTyConKey - - {- Note [Instance and Given overlap] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Example, from the OutsideIn(X) paper: diff --git a/compiler/GHC/Tc/Solver/InertSet.hs b/compiler/GHC/Tc/Solver/InertSet.hs index 41bcff23ea..1b85fdab0c 100644 --- a/compiler/GHC/Tc/Solver/InertSet.hs +++ b/compiler/GHC/Tc/Solver/InertSet.hs @@ -241,7 +241,7 @@ extendWorkListCt ct wl -> extendWorkListEq rewriters ct wl ClassPred cls _ -- See Note [Prioritise class equalities] - | isEqPredClass cls + | isEqualityClass cls -> extendWorkListEq rewriters ct wl _ -> extendWorkListNonEq ct wl diff --git a/compiler/GHC/Tc/Types/Constraint.hs b/compiler/GHC/Tc/Types/Constraint.hs index 9ef6608225..444c645c20 100644 --- a/compiler/GHC/Tc/Types/Constraint.hs +++ b/compiler/GHC/Tc/Types/Constraint.hs @@ -543,7 +543,7 @@ cteSolubleOccurs = CTEP (bit 3) -- Occurs-check under a type function, or in -- or in a representational equality; see -- See Note [Occurs check and representational equality] -- cteSolubleOccurs must be one bit to the left of cteInsolubleOccurs - -- See also Note [Insoluble occurs check] in GHC.Tc.Errors + -- See also Note [Insoluble mis-match] in GHC.Tc.Errors cteCoercionHole = CTEP (bit 4) -- Coercion hole encountered cteConcrete = CTEP (bit 5) -- Type variable that can't be made concrete diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index 242a712fcb..27d0610c04 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -161,8 +161,8 @@ module GHC.Tc.Utils.TcType ( mkTyConTy, mkTyVarTy, mkTyVarTys, mkTyCoVarTy, mkTyCoVarTys, - isClassPred, isEqPrimPred, isIPLikePred, isEqPred, isEqPredClass, - mkClassPred, + isClassPred, isEqPrimPred, isIPLikePred, isEqPred, + isEqualityClass, mkClassPred, tcSplitQuantPredTy, tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy, isRuntimeRepVar, isFixedRuntimeRepKind, isVisiblePiTyBinder, isInvisiblePiTyBinder, @@ -2538,11 +2538,10 @@ isTerminatingClass cls = isIPClass cls -- Implicit parameter constraints always terminate because -- there are no instances for them --- they are only solved -- by "local instances" in expressions - || isEqPredClass cls + || isEqualityClass cls || cls `hasKey` typeableClassKey -- Typeable constraints are bigger than they appear due -- to kind polymorphism, but we can never get instance divergence this way - || cls `hasKey` coercibleTyConKey || cls `hasKey` unsatisfiableClassNameKey allDistinctTyVars :: TyVarSet -> [KindOrType] -> Bool diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs index 55d7696496..9b94f274c2 100644 --- a/compiler/GHC/Tc/Validity.hs +++ b/compiler/GHC/Tc/Validity.hs @@ -1231,7 +1231,7 @@ e.g. module A where check_class_pred :: TidyEnv -> DynFlags -> UserTypeCtxt -> PredType -> Class -> [TcType] -> TcM () check_class_pred env dflags ctxt pred cls tys - | isEqPredClass cls -- (~) and (~~) are classified as classes, + | isEqualityClass cls -- (~) and (~~) and Coercible are classified as classes, -- but here we want to treat them as equalities = -- Equational constraints are valid in all contexts, and -- we do not need to check e.g. for FlexibleContexts here, so just do nothing |