diff options
| author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2023-05-11 14:31:57 +0200 |
|---|---|---|
| committer | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2023-05-12 12:29:36 +0200 |
| commit | fafdc13b2cfef26d7d41b530aef114bebcf4d82d (patch) | |
| tree | 0c7c78e7bd1c328c97167af0ea6d0bd18b95795e /compiler/GHC/Core | |
| parent | eb60ec18eff7943fb9f22b2d2ad29709b56ce02d (diff) | |
| download | haskell-wip/T23362.tar.gz | |
Fix coercion optimisation for SelCo (#23362)wip/T23362
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/GHC/Core')
| -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) |