Revert "Don't keep exit join points so much"

This reverts commit caced75765472a1a94453f2e5a439dba0d04a265.

It seems the patch "Don't keep exit join points so much" is causing
wide-spread regressions in the bytestring library benchmarks. If I
revert it then the 9.6 numbers are better on average than 9.4.

See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525

-------------------------
Metric Decrease:
    MultiComponentModules
    MultiComponentModulesRecomp
    MultiLayerModules
    MultiLayerModulesRecomp
    MultiLayerModulesTH_Make
    T12150
    T13386
    T13719
    T21839c
    T3294
    parsing001
-------------------------

(cherry picked from commit 7eac2468a726f217dd97c5e2884f6b552e8ef11d)

5 files changed, 27 insertions, 163 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T21148.hs b/testsuite/tests/simplCore/should_compile/T21148.hs
deleted file mode 100644
index 72d3e14167..0000000000
--- a/testsuite/tests/simplCore/should_compile/T21148.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module T211148 where
-
--- The point of this test is that f should get a (nested)
--- CPR property, with a worker of type
--- $wf :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
-
-{-# NOINLINE f #-}
--- The NOINLINE makes GHC do a worker/wrapper split
--- even though f is small
-f :: Int -> IO Int
-f x = return $! sum [0..x]
-
diff --git a/testsuite/tests/simplCore/should_compile/T21148.stderr b/testsuite/tests/simplCore/should_compile/T21148.stderr
deleted file mode 100644
index 9197584912..0000000000
--- a/testsuite/tests/simplCore/should_compile/T21148.stderr
+++ /dev/null
@@ -1,126 +0,0 @@
-
-==================== Tidy Core ====================
-Result size of Tidy Core
-  = {terms: 73, types: 80, coercions: 6, joins: 2/2}
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T211148.$trModule4 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
-T211148.$trModule4 = "main"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T211148.$trModule3 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-T211148.$trModule3 = GHC.Types.TrNameS T211148.$trModule4
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T211148.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-T211148.$trModule2 = "T211148"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T211148.$trModule1 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-T211148.$trModule1 = GHC.Types.TrNameS T211148.$trModule2
-
--- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T211148.$trModule :: GHC.Types.Module
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-T211148.$trModule
-  = GHC.Types.Module T211148.$trModule3 T211148.$trModule1
-
--- RHS size: {terms: 41, types: 35, coercions: 0, joins: 2/2}
-T211148.$wf [InlPrag=NOINLINE]
-  :: GHC.Prim.Int#
-     -> GHC.Prim.State# GHC.Prim.RealWorld
-     -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #)
-[GblId, Arity=2, Str=<L><L>, Unf=OtherCon []]
-T211148.$wf
-  = \ (ww_s179 :: GHC.Prim.Int#)
-      (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
-      case GHC.Prim.># 0# ww_s179 of {
-        __DEFAULT ->
-          join {
-            exit_X0 [Dmd=SC(S,C(1,!P(L,L)))]
-              :: GHC.Prim.Int#
-                 -> GHC.Prim.Int#
-                 -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #)
-            [LclId[JoinId(2)(Nothing)], Arity=2, Str=<L><L>]
-            exit_X0 (x_s16Z [OS=OneShot] :: GHC.Prim.Int#)
-                    (ww1_s172 [OS=OneShot] :: GHC.Prim.Int#)
-              = (# eta_s17b, GHC.Prim.+# ww1_s172 x_s16Z #) } in
-          joinrec {
-            $wgo3_s175 [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,!P(L,L)))]
-              :: GHC.Prim.Int#
-                 -> GHC.Prim.Int#
-                 -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #)
-            [LclId[JoinId(2)(Nothing)], Arity=2, Str=<L><L>, Unf=OtherCon []]
-            $wgo3_s175 (x_s16Z :: GHC.Prim.Int#) (ww1_s172 :: GHC.Prim.Int#)
-              = case GHC.Prim.==# x_s16Z ww_s179 of {
-                  __DEFAULT ->
-                    jump $wgo3_s175
-                      (GHC.Prim.+# x_s16Z 1#) (GHC.Prim.+# ww1_s172 x_s16Z);
-                  1# -> jump exit_X0 x_s16Z ww1_s172
-                }; } in
-          jump $wgo3_s175 0# 0#;
-        1# -> (# eta_s17b, 0# #)
-      }
-
--- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0}
-T211148.f1 [InlPrag=NOINLINE[final]]
-  :: Int
-     -> GHC.Prim.State# GHC.Prim.RealWorld
-     -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
-[GblId,
- Arity=2,
- Str=<1!P(L)><L>,
- Cpr=1(, 1),
- Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
-         Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (x_s177 [Occ=Once1!] :: Int)
-                 (eta_s17b [Occ=Once1, OS=OneShot]
-                    :: GHC.Prim.State# GHC.Prim.RealWorld) ->
-                 case x_s177 of { GHC.Types.I# ww_s179 [Occ=Once1] ->
-                 case T211148.$wf ww_s179 eta_s17b of
-                 { (# ww1_s17e [Occ=Once1], ww2_s17j [Occ=Once1] #) ->
-                 (# ww1_s17e, GHC.Types.I# ww2_s17j #)
-                 }
-                 }}]
-T211148.f1
-  = \ (x_s177 :: Int)
-      (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
-      case x_s177 of { GHC.Types.I# ww_s179 ->
-      case T211148.$wf ww_s179 eta_s17b of { (# ww1_s17e, ww2_s17j #) ->
-      (# ww1_s17e, GHC.Types.I# ww2_s17j #)
-      }
-      }
-
--- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0}
-f [InlPrag=NOINLINE[final]] :: Int -> IO Int
-[GblId,
- Arity=2,
- Str=<1!P(L)><L>,
- Cpr=1(, 1),
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
-         Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
-f = T211148.f1
-    `cast` (<Int>_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] <Int>_R)
-            :: (Int
-                -> GHC.Prim.State# GHC.Prim.RealWorld
-                -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #))
-               ~R# (Int -> IO Int))
-
-
-
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 709a166c0e..80a1f87477 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -429,7 +429,6 @@ test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules'])
 test('T22028', normal, compile, ['-O -ddump-rule-firings'])
 test('T22114', normal, compile, ['-O'])
 test('T21286',  normal, multimod_compile, ['T21286', '-O -ddump-rule-firings'])
-test('T21148', [grep_errmsg(r'Cpr=') ], compile, ['-O -ddump-simpl'])
 
 # One module, T21851.hs, has OPTIONS_GHC -ddump-simpl
 test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O -dno-typeable-binds -dsuppress-uniques'])
diff --git a/testsuite/tests/stranal/should_compile/T21128.hs b/testsuite/tests/stranal/should_compile/T21128.hs
index 02991433f2..899adac49c 100644
--- a/testsuite/tests/stranal/should_compile/T21128.hs
+++ b/testsuite/tests/stranal/should_compile/T21128.hs
@@ -2,10 +2,6 @@ module T21128 where
 
 import T21128a
 
-{- This test originally had some unnecessary reboxing of y
-in the hot path of $wtheresCrud.  That reboxing should
-not happen. -}
-
 theresCrud :: Int -> Int -> Int
 theresCrud x y = go x
   where
@@ -13,4 +9,3 @@ theresCrud x y = go x
     go 1 = index x y 1
     go n = go (n-1)
 {-# NOINLINE theresCrud #-}
-
diff --git a/testsuite/tests/stranal/should_compile/T21128.stderr b/testsuite/tests/stranal/should_compile/T21128.stderr
index 955717ef35..a64c1f1d5a 100644
--- a/testsuite/tests/stranal/should_compile/T21128.stderr
+++ b/testsuite/tests/stranal/should_compile/T21128.stderr
@@ -1,7 +1,7 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 125, types: 68, coercions: 4, joins: 0/0}
+  = {terms: 137, types: 92, coercions: 4, joins: 0/0}
 
 lvl = "error"#
 
@@ -29,11 +29,17 @@ lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8
 
 lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack
 
+$windexError
+  = \ @a @b ww eta eta1 eta2 ->
+      error
+        (lvl10 `cast` <Co:4> :: CallStack ~R# (?callStack::CallStack))
+        (++ (ww eta) (++ (ww eta1) (ww eta2)))
+
 indexError
   = \ @a @b $dShow eta eta1 eta2 ->
-      error
-        (lvl10 `cast` <Co:4> :: ...)
-        (++ (show $dShow eta) (++ (show $dShow eta1) (show $dShow eta2)))
+      case $dShow of { C:Show ww ww1 ww2 ->
+      $windexError ww1 eta eta1 eta2
+      }
 
 $trModule3 = TrNameS $trModule4
 
@@ -42,7 +48,8 @@ $trModule1 = TrNameS $trModule2
 $trModule = Module $trModule3 $trModule1
 
 $wlvl
-  = \ ww ww1 ww2 -> indexError $fShowInt (I# ww2) (I# ww1) (I# ww)
+  = \ ww ww1 ww2 ->
+      $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww)
 
 index
   = \ l u i ->
@@ -66,7 +73,7 @@ index
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 108, types: 46, coercions: 0, joins: 3/3}
+  = {terms: 108, types: 47, coercions: 0, joins: 3/4}
 
 $trModule4 = "main"#
 
@@ -82,34 +89,35 @@ i = I# 1#
 
 l = I# 0#
 
-lvl = \ x ww -> indexError $fShowInt x (I# ww) i
+lvl = \ y -> $windexError $fShowInt_$cshow l y l
 
-lvl1 = \ ww -> indexError $fShowInt l (I# ww) l
+lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i
 
 $wtheresCrud
   = \ ww ww1 ->
+      let { y = I# ww1 } in
       join {
-        exit
-          = case <# 0# ww1 of {
-              __DEFAULT -> case lvl1 ww1 of wild { };
-              1# -> 0#
-            } } in
-      join {
-        exit1
+        lvl2
           = case <=# ww 1# of {
-              __DEFAULT -> case lvl (I# ww) ww1 of wild { };
+              __DEFAULT -> case lvl1 ww y of wild { };
               1# ->
                 case <# 1# ww1 of {
-                  __DEFAULT -> case lvl (I# ww) ww1 of wild { };
+                  __DEFAULT -> case lvl1 ww y of wild { };
                   1# -> -# 1# ww
                 }
             } } in
+      join {
+        lvl3
+          = case <# 0# ww1 of {
+              __DEFAULT -> case lvl y of wild { };
+              1# -> 0#
+            } } in
       joinrec {
         $wgo ww2
           = case ww2 of wild {
               __DEFAULT -> jump $wgo (-# wild 1#);
-              0# -> jump exit;
-              1# -> jump exit1
+              0# -> jump lvl3;
+              1# -> jump lvl2
             }; } in
       jump $wgo ww