From fe0e8c9c13916d4e32b65543c083d227db256d23 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Tue, 16 May 2023 13:38:46 +0100 Subject: Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. --- compiler/GHC/Core/Predicate.hs | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) (limited to 'compiler/GHC/Core/Predicate.hs') diff --git a/compiler/GHC/Core/Predicate.hs b/compiler/GHC/Core/Predicate.hs index 2fc07e1be1..d6d5dd6520 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, isEqPredClass, isCTupleClass, isEqualityClass, getClassPredTys, getClassPredTys_maybe, classMethodTy, classMethodInstTy, @@ -219,11 +219,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 @@ -245,6 +240,20 @@ isEqPrimPred ty = isCoVarType ty isCTupleClass :: Class -> Bool isCTupleClass cls = isTupleTyCon (classTyCon cls) +isEqPredClass :: Class -> Bool +-- True of (~) and (~~) +isEqPredClass cls = cls `hasKey` eqTyConKey + || cls `hasKey` heqTyConKey + +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 + + {- ********************************************************************* * * Implicit parameters -- cgit v1.2.1