summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2023-05-11 14:31:57 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-05-12 19:28:00 -0400
commitd683b2e5b91a39a2bf16796f5800f605a0281004 (patch)
treee9d561ed4b7901c62fcb949d9181e169f6af9952 /compiler
parent5ad776abbb7c72d65d2ae27de5b2ec48b6e72cde (diff)
downloadhaskell-d683b2e5b91a39a2bf16796f5800f605a0281004.tar.gz
Fix coercion optimisation for SelCo (#23362)
setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Core/Coercion.hs15
1 files changed, 12 insertions, 3 deletions
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
index 6459136973..9ffcabd3a3 100644
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -1355,7 +1355,7 @@ mkProofIrrelCo r kco g1 g2 = mkUnivCo (ProofIrrelProv kco) r
-- | Converts a coercion to be nominal, if possible.
-- See Note [Role twiddling functions]
setNominalRole_maybe :: Role -- of input coercion
- -> Coercion -> Maybe Coercion
+ -> Coercion -> Maybe CoercionN
setNominalRole_maybe r co
| r == Nominal = Just co
| otherwise = setNominalRole_maybe_helper co
@@ -1380,10 +1380,19 @@ setNominalRole_maybe r co
= AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2
setNominalRole_maybe_helper (ForAllCo tv kind_co co)
= ForAllCo tv kind_co <$> setNominalRole_maybe_helper co
- setNominalRole_maybe_helper (SelCo n co)
+ setNominalRole_maybe_helper (SelCo cs co) =
-- NB, this case recurses via setNominalRole_maybe, not
-- setNominalRole_maybe_helper!
- = SelCo n <$> setNominalRole_maybe (coercionRole co) co
+ case cs of
+ SelTyCon n _r ->
+ -- Remember to update the role in SelTyCon to nominal;
+ -- not doing this caused #23362.
+ -- See the typing rule in Note [SelCo] in GHC.Core.TyCo.Rep.
+ SelCo (SelTyCon n Nominal) <$> setNominalRole_maybe (coercionRole co) co
+ SelFun fs ->
+ SelCo (SelFun fs) <$> setNominalRole_maybe (coercionRole co) co
+ SelForAll ->
+ pprPanic "setNominalRole_maybe: the coercion should already be nominal" (ppr co)
setNominalRole_maybe_helper (InstCo co arg)
= InstCo <$> setNominalRole_maybe_helper co <*> pure arg
setNominalRole_maybe_helper (UnivCo prov _ co1 co2)