Worker/wrapper: Preserve float barriers (#21150)

Issue #21150 shows that worker/wrapper allocated a worker function for a
function with multiple calls that said "called at most once" when the first
argument was absent. That's bad!

This patch makes it so that WW preserves at least one non-one-shot value lambda
(see `Note [Preserving float barriers]`) by passing around `void#` in place of
absent arguments.

Fixes #21150.

Since the fix is pretty similar to `Note [Protecting the last value argument]`,
I put the logic in `mkWorkerArgs`. There I realised (#21204) that
`-ffun-to-thunk` is basically useless with `-ffull-laziness`, so I deprecated
the flag, simplified and split into `needsVoidWorkerArg`/`addVoidWorkerArg`.
SpecConstr is another client of that API.

Fixes #21204.

Metric Decrease:
    T14683

4 files changed, 281 insertions, 2 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T19794.hs b/testsuite/tests/simplCore/should_compile/T19794.hs
index c8f6897468..2518586db6 100644
--- a/testsuite/tests/simplCore/should_compile/T19794.hs
+++ b/testsuite/tests/simplCore/should_compile/T19794.hs
@@ -1,5 +1,9 @@
 {-# LANGUAGE MagicHash #-}
-{-# OPTIONS_GHC -ffun-to-thunk #-}   -- This is essential for the test
+-- -ffun-to-thunk is essential for the test, but the flag had been deprecated in
+-- 9.4 and is off by default. It doesn't hurt to keep the regression test, though,
+-- in case we accidentally drop the logic for
+-- Note [Protecting the last value argument].
+-- {-# OPTIONS_GHC -ffun-to-thunk #-}
 
 module Foo where
 import GHC.Exts
diff --git a/testsuite/tests/stranal/should_compile/T21150.hs b/testsuite/tests/stranal/should_compile/T21150.hs
new file mode 100644
index 0000000000..520b7d9d77
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T21150.hs
@@ -0,0 +1,37 @@
+-- | The idea here is that t* should never be inlined into g*.
+-- That may happen if the absent arguments of g* are dropped without care,
+-- making $wg* appear as if all its lambdas are oneShot afterwards.
+--
+-- So in these cases, we replace absent args with `Void#` instead in order
+-- to preserve lambda groups.
+module T21150 where
+
+import GHC.Exts
+
+f :: Int -> Int -> Int -> Maybe Int
+f x y z = (+) <$> g x y z <*> g x z y
+  where
+    t :: Int
+    t = sum [0..x]
+    g :: Int -> Int -> Int -> Maybe Int
+    g _ = oneShot $ \_ -> oneShot $ \z -> Just (y + z + t)
+    {-# NOINLINE g #-}
+
+f2 :: Int -> Int -> Int -> Maybe Int
+f2 x y z = (+) <$> g' y <*> g' z
+  where
+    t2 :: Int
+    t2 = sum [0..x]
+    g' = g2 x
+    g2 :: Int -> Int -> Maybe Int
+    g2 = oneShot $ \y _ -> Just (y + z + t2)
+    {-# NOINLINE g2 #-}
+
+f3 :: Int -> Int -> Int -> Maybe Int
+f3 x y z = (+) <$> g3 x y z <*> g3 x z y
+  where
+    t3 :: Int
+    t3 = sum [0..x]
+    g3 :: Int -> Int -> Int -> Maybe Int
+    g3 = oneShot $ \y z _ -> Just (y + z + t3)
+    {-# NOINLINE g3 #-}
diff --git a/testsuite/tests/stranal/should_compile/T21150.stderr b/testsuite/tests/stranal/should_compile/T21150.stderr
new file mode 100644
index 0000000000..fc70e22563
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T21150.stderr
@@ -0,0 +1,237 @@
+
+==================== Exitification transformation ====================
+Result size of Exitification transformation
+  = {terms: 242, types: 140, coercions: 0, joins: 3/9}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule :: Addr#
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+$trModule = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule :: GHC.Types.TrName
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+$trModule = GHC.Types.TrNameS $trModule
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule :: Addr#
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+$trModule = "T21150"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule :: GHC.Types.TrName
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+$trModule = GHC.Types.TrNameS $trModule
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T21150.$trModule :: GHC.Types.Module
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T21150.$trModule = GHC.Types.Module $trModule $trModule
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl :: Int
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+lvl = GHC.Types.I# 0#
+
+-- RHS size: {terms: 70, types: 37, coercions: 0, joins: 1/3}
+f3 :: Int -> Int -> Int -> Maybe Int
+[LclIdX,
+ Arity=3,
+ Str=<L><L><L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 0 0] 279 10}]
+f3
+  = \ (x :: Int) (y :: Int) (z :: Int) ->
+      let {
+        t3 :: Int
+        [LclId,
+         Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
+                 WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 77 0}]
+        t3
+          = case x of { I# y ->
+            case ># 0# y of {
+              __DEFAULT ->
+                joinrec {
+                  $wgo3 [InlPrag=[2], Occ=LoopBreaker] :: Int# -> Int# -> Int
+                  [LclId[JoinId(2)(Nothing)],
+                   Arity=2,
+                   Str=<L><L>,
+                   Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
+                           WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 40 10}]
+                  $wgo3 (x :: Int#) (ww :: Int#)
+                    = case ==# x y of {
+                        __DEFAULT -> jump $wgo3 (+# x 1#) (+# ww x);
+                        1# -> GHC.Types.I# (+# ww x)
+                      }; } in
+                jump $wgo3 0# 0#;
+              1# -> lvl
+            }
+            } } in
+      let {
+        $wg3 [InlPrag=NOINLINE] :: Int -> Int -> (# Int #)
+        [LclId,
+         Arity=2,
+         Str=<L><L>,
+         Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
+                 WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 42 10}]
+        $wg3
+          = \ (v [OS=OneShot] :: Int) (z :: Int) ->
+              (# case v of { I# x ->
+                 case z of { I# y ->
+                 case t3 of { I# y -> GHC.Types.I# (+# (+# x y) y) }
+                 }
+                 } #) } in
+      case $wg3 x y of { (# ww #) ->
+      case $wg3 x z of { (# ww #) ->
+      GHC.Maybe.Just @Int (GHC.Num.$fNumInt_$c+ ww ww)
+      }
+      }
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl :: Int
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+lvl = GHC.Types.I# 0#
+
+-- RHS size: {terms: 69, types: 36, coercions: 0, joins: 1/3}
+$wf2 [InlPrag=[2]] :: Int -> Int -> Maybe Int
+[LclId,
+ Arity=2,
+ Str=<L><L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 279 10}]
+$wf2
+  = \ (x :: Int) (z :: Int) ->
+      let {
+        t2 :: Int
+        [LclId,
+         Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
+                 WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 77 0}]
+        t2
+          = case x of { I# y ->
+            case ># 0# y of {
+              __DEFAULT ->
+                joinrec {
+                  $wgo3 [InlPrag=[2], Occ=LoopBreaker] :: Int# -> Int# -> Int
+                  [LclId[JoinId(2)(Nothing)],
+                   Arity=2,
+                   Str=<L><L>,
+                   Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
+                           WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 40 10}]
+                  $wgo3 (x :: Int#) (ww :: Int#)
+                    = case ==# x y of {
+                        __DEFAULT -> jump $wgo3 (+# x 1#) (+# ww x);
+                        1# -> GHC.Types.I# (+# ww x)
+                      }; } in
+                jump $wgo3 0# 0#;
+              1# -> lvl
+            }
+            } } in
+      let {
+        $wg2 [InlPrag=NOINLINE] :: Int -> (# #) -> (# Int #)
+        [LclId,
+         Arity=2,
+         Str=<L><L>,
+         Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
+                 WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 0] 42 10}]
+        $wg2
+          = \ (v [OS=OneShot] :: Int) _ [Occ=Dead] ->
+              (# case v of { I# x ->
+                 case z of { I# y ->
+                 case t2 of { I# y -> GHC.Types.I# (+# (+# x y) y) }
+                 }
+                 } #) } in
+      case $wg2 x GHC.Prim.(##) of { (# ww #) ->
+      case $wg2 x GHC.Prim.(##) of { (# ww #) ->
+      GHC.Maybe.Just @Int (GHC.Num.$fNumInt_$c+ ww ww)
+      }
+      }
+
+-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
+f2 [InlPrag=[2]] :: Int -> Int -> Int -> Maybe Int
+[LclIdX,
+ Arity=3,
+ Str=<L><A><L>,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=True)
+         Tmpl= \ (x [Occ=Once1] :: Int)
+                 _ [Occ=Dead, Dmd=A]
+                 (z [Occ=Once1] :: Int) ->
+                 $wf2 x z}]
+f2 = \ (x :: Int) _ [Occ=Dead, Dmd=A] (z :: Int) -> $wf2 x z
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl :: Int
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+lvl = GHC.Types.I# 0#
+
+-- RHS size: {terms: 70, types: 37, coercions: 0, joins: 1/3}
+f :: Int -> Int -> Int -> Maybe Int
+[LclIdX,
+ Arity=3,
+ Str=<L><L><L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20 0] 279 10}]
+f = \ (x :: Int) (y :: Int) (z :: Int) ->
+      let {
+        t :: Int
+        [LclId,
+         Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
+                 WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 77 0}]
+        t = case x of { I# y ->
+            case ># 0# y of {
+              __DEFAULT ->
+                joinrec {
+                  $wgo3 [InlPrag=[2], Occ=LoopBreaker] :: Int# -> Int# -> Int
+                  [LclId[JoinId(2)(Nothing)],
+                   Arity=2,
+                   Str=<L><L>,
+                   Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
+                           WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 40 10}]
+                  $wgo3 (x :: Int#) (ww :: Int#)
+                    = case ==# x y of {
+                        __DEFAULT -> jump $wgo3 (+# x 1#) (+# ww x);
+                        1# -> GHC.Types.I# (+# ww x)
+                      }; } in
+                jump $wgo3 0# 0#;
+              1# -> lvl
+            }
+            } } in
+      let {
+        $wg [InlPrag=NOINLINE] :: Int -> (# #) -> (# Int #)
+        [LclId,
+         Arity=2,
+         Str=<L><L>,
+         Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
+                 WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 0] 42 10}]
+        $wg
+          = \ (v [OS=OneShot] :: Int) _ [Occ=Dead] ->
+              (# case y of { I# x ->
+                 case v of { I# y ->
+                 case t of { I# y -> GHC.Types.I# (+# (+# x y) y) }
+                 }
+                 } #) } in
+      case $wg z GHC.Prim.(##) of { (# ww #) ->
+      case $wg y GHC.Prim.(##) of { (# ww #) ->
+      GHC.Maybe.Just @Int (GHC.Num.$fNumInt_$c+ ww ww)
+      }
+      }
+
+
+
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index ac35fc42ce..042ee9dd44 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -80,4 +80,5 @@ test('T20510', [ grep_errmsg(r'jump \$wgo') ], compile, ['-dsuppress-uniques -dd
 test('T20746', normal, compile, ['-dsuppress-uniques -ddump-simpl'])
 test('T20746b', normal, compile, ['-dsuppress-uniques -ddump-simpl -dno-typeable-binds'])
 test('T20817', [ grep_errmsg(r'Str') ], compile, ['-dsuppress-uniques -ddump-stranal'])
-
+# T21150: Check that t{,1,2} haven't been inlined.
+test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques -ddump-exitify'])