diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2023-05-11 14:31:57 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-05-12 19:28:00 -0400 |
commit | d683b2e5b91a39a2bf16796f5800f605a0281004 (patch) | |
tree | e9d561ed4b7901c62fcb949d9181e169f6af9952 /compiler | |
parent | 5ad776abbb7c72d65d2ae27de5b2ec48b6e72cde (diff) | |
download | haskell-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.hs | 15 |
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) |