summaryrefslogtreecommitdiff
path: root/compiler/GHC/HsToCore
diff options
context:
space:
mode:
authorSimon Peyton Jones <simon.peytonjones@gmail.com>2023-01-12 22:21:40 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-01-31 13:08:38 -0500
commita83c810d26aab5944aa8d4821e00bd3938557f2e (patch)
treed7c93cfa2cbf3443c146b8c0100639d29bf96ca3 /compiler/GHC/HsToCore
parent765fab98b0795bbe8ad50796c55b9408a2af54cf (diff)
downloadhaskell-a83c810d26aab5944aa8d4821e00bd3938557f2e.tar.gz
Improve exprOkForSpeculation for classops
This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord
Diffstat (limited to 'compiler/GHC/HsToCore')
-rw-r--r--compiler/GHC/HsToCore/Pmc/Solver.hs5
1 files changed, 2 insertions, 3 deletions
diff --git a/compiler/GHC/HsToCore/Pmc/Solver.hs b/compiler/GHC/HsToCore/Pmc/Solver.hs
index 07176b87cc..cfc98273e3 100644
--- a/compiler/GHC/HsToCore/Pmc/Solver.hs
+++ b/compiler/GHC/HsToCore/Pmc/Solver.hs
@@ -46,7 +46,6 @@ import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Data.Bag
-import GHC.Types.Basic (Levity(..))
import GHC.Types.CompleteMatch
import GHC.Types.Unique.Set
import GHC.Types.Unique.DSet
@@ -675,7 +674,7 @@ addPhiTmCt nabla (PhiNotBotCt x) = addNotBotCt nabla x
filterUnliftedFields :: PmAltCon -> [Id] -> [Id]
filterUnliftedFields con args =
[ arg | (arg, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con)
- , isBanged bang || typeLevity_maybe (idType arg) == Just Unlifted ]
+ , isBanged bang || definitelyUnliftedType (idType arg) ]
-- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@
-- surely diverges. Quite similar to 'addConCt', only that it only cares about
@@ -687,7 +686,7 @@ addBotCt nabla@MkNabla{ nabla_tm_st = ts@TmSt{ ts_facts=env } } x = do
IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction!
IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do
MaybeBot -- We add x ~ ⊥
- | Just Unlifted <- typeLevity_maybe (idType x)
+ | definitelyUnliftedType (idType x)
-- Case (3) in Note [Strict fields and variables of unlifted type]
-> mzero -- unlifted vars can never be ⊥
| otherwise