diff options
author | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2023-01-12 22:21:40 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-01-31 13:08:38 -0500 |
commit | a83c810d26aab5944aa8d4821e00bd3938557f2e (patch) | |
tree | d7c93cfa2cbf3443c146b8c0100639d29bf96ca3 /compiler/GHC/HsToCore | |
parent | 765fab98b0795bbe8ad50796c55b9408a2af54cf (diff) | |
download | haskell-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.hs | 5 |
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 |