diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs index aec2b5ae8a2c27dbcde06026f3fb542c8c917607..add0a878e0672c7516b4317fca6af728dcf8f49a 100644 --- a/compiler/GHC/Core/Opt/Specialise.hs +++ b/compiler/GHC/Core/Opt/Specialise.hs @@ -1495,7 +1495,9 @@ specBind top_lvl env (NonRec fn rhs) do_body -- Destroying demand info is not terrible; specialisation is -- always followed soon by demand analysis. - body_env2 = body_env1 `extendInScope` fn3 + body_env2 = body_env1 `bringFloatedDictsIntoScope` ud_binds rhs_uds + `extendInScope` fn3 + -- bringFloatedDictsIntoScope: see #23567 ; (body', body_uds) <- do_body body_env2 diff --git a/testsuite/tests/simplCore/should_compile/T23567.hs b/testsuite/tests/simplCore/should_compile/T23567.hs new file mode 100644 index 0000000000000000000000000000000000000000..eb9110253a3967dd292be642fac71f32b63c3418 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23567.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -funfolding-use-threshold=111640 -fmax-simplifier-iterations=2 #-} + +module T23567 where + +import T23567A + +instance (MonadIO m) => CacheRWM2 (ReaderT (StateT m)) where + p = runCacheBuildM + {-# NOINLINE p #-} diff --git a/testsuite/tests/simplCore/should_compile/T23567A.hs b/testsuite/tests/simplCore/should_compile/T23567A.hs new file mode 100644 index 0000000000000000000000000000000000000000..084bdba64ea65d16138043a4a9aacc230102490f --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23567A.hs @@ -0,0 +1,27 @@ +module T23567A where + +class Appl f where + pur :: f + ast :: f -> f + +class Appl f => Mona f where + unused :: f + +class Mona f => MonadIO f where + unused2 :: f + +newtype StateT m = StateT { runStateT :: m } + deriving (Mona, MonadIO) + +instance (Appl m, Appl m) => Appl (StateT m) where + pur = pur + ast x = x + +newtype ReaderT m = ReaderT { runReaderT :: m } + deriving (Appl, Mona, MonadIO) + +class CacheRWM2 m where + p :: m + +runCacheBuildM :: (MonadIO m) => m +runCacheBuildM = ast pur diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 21e01bb65d148834959cd60e741cff77cbd21a77..6f01f62906d2df6e5b3d5e9b79c6d5d03d377dab 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -490,3 +490,4 @@ test('T23491b', [extra_files(['T23491.hs']), grep_errmsg(r'Float inwards')], mul test('T23491c', [extra_files(['T23491.hs']), grep_errmsg(r'Liberate case')], multimod_compile, ['T23491', '-fliberate-case -ddump-liberate-case']) test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], multimod_compile, ['T23491', '-fstatic-argument-transformation -ddump-static-argument-transformation']) test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) +test('T23567', [extra_files(['T23567A.hs'])], multimod_compile, ['T23567', '-O -v0'])