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 | |
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.
-rw-r--r-- | compiler/GHC/Core/Coercion.hs | 15 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T23362.hs | 21 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 1 |
3 files changed, 34 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) diff --git a/testsuite/tests/simplCore/should_compile/T23362.hs b/testsuite/tests/simplCore/should_compile/T23362.hs new file mode 100644 index 0000000000..5c096d9f89 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23362.hs @@ -0,0 +1,21 @@ +module T23362 where + +import Unsafe.Coerce +import Data.Kind + +type Phantom :: Type -> Type +data Phantom a = MkPhantom + +newtype Id a = MkId a +newtype First a = MkFirst (Id a) +data Second a = MkSecond (First a) +data Third a = MkThird !(Second a) + +a :: Second (Phantom Int) +a = MkSecond (MkFirst (MkId MkPhantom)) + +uc :: Second (Phantom Int) -> Second (Phantom Bool) +uc = unsafeCoerce + +b :: Third (Phantom Bool) +b = MkThird (uc a) diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index ae48423fa0..a472aa05d9 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -478,3 +478,4 @@ test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -d test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script']) +test('T23362', normal, compile, ['-O']) |