FloatOut: Only eta-expand dead-end RHS if arity will increase (#18231)

Otherwise we risk turning trivial RHS into non-trivial RHS, introducing
unnecessary bindings in the next Simplifier run, resulting in more
churn.

Fixes #18231.

3 files changed, 52 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T18231.hs b/testsuite/tests/simplCore/should_compile/T18231.hs
new file mode 100644
index 0000000000..d9c6e0c93b
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T18231.hs
@@ -0,0 +1,7 @@
+module T18231 where
+
+import Control.Monad (forever)
+import Control.Monad.Trans.State.Strict
+
+m :: State Int ()
+m = forever $ modify' (+1)
diff --git a/testsuite/tests/simplCore/should_compile/T18231.stderr b/testsuite/tests/simplCore/should_compile/T18231.stderr
new file mode 100644
index 0000000000..445192538b
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T18231.stderr
@@ -0,0 +1,40 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core = {terms: 30, types: 22, coercions: 5, joins: 0/0}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T18231.$trModule4 :: GHC.Prim.Addr#
+T18231.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18231.$trModule3 :: GHC.Types.TrName
+T18231.$trModule3 = GHC.Types.TrNameS T18231.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T18231.$trModule2 :: GHC.Prim.Addr#
+T18231.$trModule2 = "T18231"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18231.$trModule1 :: GHC.Types.TrName
+T18231.$trModule1 = GHC.Types.TrNameS T18231.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T18231.$trModule :: GHC.Types.Module
+T18231.$trModule = GHC.Types.Module T18231.$trModule3 T18231.$trModule1
+
+Rec {
+-- RHS size: {terms: 6, types: 1, coercions: 0, joins: 0/0}
+lvl :: GHC.Prim.Int# -> Data.Functor.Identity.Identity ((), Int)
+lvl = \ (x :: GHC.Prim.Int#) -> T18231.m1 (GHC.Types.I# (GHC.Prim.+# x 1#))
+
+-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
+T18231.m1 :: Int -> Data.Functor.Identity.Identity ((), Int)
+T18231.m1 = \ (s1 :: Int) -> case s1 of { GHC.Types.I# x -> lvl x }
+end Rec }
+
+-- RHS size: {terms: 1, types: 0, coercions: 5, joins: 0/0}
+m :: State Int ()
+m = T18231.m1 `cast` (Sym (Control.Monad.Trans.State.Strict.N:StateT[0] <Int>_N <Data.Functor.Identity.Identity>_R <()>_N) :: (Int -> Data.Functor.Identity.Identity ((), Int)) ~R# StateT Int Data.Functor.Identity.Identity ())
+
+
+
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index c3db4f1b6b..499e057b18 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -319,3 +319,8 @@ test('T17810', normal, multimod_compile, ['T17810', '-fspecialise-aggressively -
 test('T18013', normal, multimod_compile, ['T18013', '-v0 -O'])
 test('T18098', normal, compile, ['-dcore-lint -O2'])
 test('T18120', normal, compile, ['-dcore-lint -O'])
+
+# Verify that there are only two top-level functions (the rec group of m's cast
+# WW worker m1). Ideally, it would be one, but we fail to inline dead-ending
+# recursive groups due to Note [Bottoming floats].
+test('T18231', [ only_ways(['optasm']), grep_errmsg(r'^[\w\.]+ ::.*->.*') ], compile, ['-ddump-simpl -dsuppress-idinfo -dppr-cols=99999 -dsuppress-uniques'])