WorkWrap: Unboxing unboxed tuples is not always useful (#22388)

See Note [Unboxing through unboxed tuples].

Fixes #22388.

3 files changed, 108 insertions, 0 deletions

diff --git a/testsuite/tests/stranal/should_compile/T22388.hs b/testsuite/tests/stranal/should_compile/T22388.hs
new file mode 100644
index 0000000000..87ae9e6fa0
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T22388.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+-- See Note [Unboxing through unboxed tuples]
+module T22388 where
+
+-- Don't split, because neither the result not arg cancels away a box.
+boring :: (# Int, Int, Int #) -> (# Int, Int, Int #)
+boring (# x, y, z #) = (# y, z, x #)
+{-# NOINLINE boring #-}
+
+-- Do split, because we get to drop z and pass x and y unboxed
+interesting :: (# Int, Int, Int #) -> (# Int #)
+interesting (# x, y, z #) = let !t = x + y in (# t #)
+{-# NOINLINE interesting #-}
diff --git a/testsuite/tests/stranal/should_compile/T22388.stderr b/testsuite/tests/stranal/should_compile/T22388.stderr
new file mode 100644
index 0000000000..25342cb4f6
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T22388.stderr
@@ -0,0 +1,92 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 48, types: 81, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 8, types: 23, coercions: 0, joins: 0/0}
+boring [InlPrag=NOINLINE]
+  :: (# Int, Int, Int #) -> (# Int, Int, Int #)
+[GblId, Arity=1, Str=<1!P(L,L,L)>, Cpr=1, Unf=OtherCon []]
+boring
+  = \ (ds :: (# Int, Int, Int #)) ->
+      case ds of { (# x, y, z #) -> (# y, z, x #) }
+
+-- RHS size: {terms: 5, types: 2, coercions: 0, joins: 0/0}
+T22388.$winteresting [InlPrag=NOINLINE]
+  :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int#
+[GblId, Arity=2, Str=<L><L>, Unf=OtherCon []]
+T22388.$winteresting
+  = \ (ww :: GHC.Prim.Int#) (ww1 :: GHC.Prim.Int#) ->
+      GHC.Prim.+# ww ww1
+
+-- RHS size: {terms: 18, types: 24, coercions: 0, joins: 0/0}
+interesting [InlPrag=NOINLINE[final]]
+  :: (# Int, Int, Int #) -> (# Int #)
+[GblId,
+ Arity=1,
+ Str=<1!P(1!P(L),1!P(L),A)>,
+ Cpr=1(1),
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
+         Tmpl= \ (ds [Occ=Once1!] :: (# Int, Int, Int #)) ->
+                 case ds of
+                 { (# ww [Occ=Once1!], ww1 [Occ=Once1!], _ [Occ=Dead] #) ->
+                 case ww of { GHC.Types.I# ww3 [Occ=Once1] ->
+                 case ww1 of { GHC.Types.I# ww4 [Occ=Once1] ->
+                 case T22388.$winteresting ww3 ww4 of ww5 [Occ=Once1] { __DEFAULT ->
+                 (# GHC.Types.I# ww5 #)
+                 }
+                 }
+                 }
+                 }}]
+interesting
+  = \ (ds :: (# Int, Int, Int #)) ->
+      case ds of { (# ww, ww1, ww2 #) ->
+      case ww of { GHC.Types.I# ww3 ->
+      case ww1 of { GHC.Types.I# ww4 ->
+      case T22388.$winteresting ww3 ww4 of ww5 { __DEFAULT ->
+      (# GHC.Types.I# ww5 #)
+      }
+      }
+      }
+      }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T22388.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+T22388.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T22388.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T22388.$trModule3 = GHC.Types.TrNameS T22388.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T22388.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T22388.$trModule2 = "T22388"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T22388.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T22388.$trModule1 = GHC.Types.TrNameS T22388.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T22388.$trModule :: GHC.Types.Module
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T22388.$trModule
+  = GHC.Types.Module T22388.$trModule3 T22388.$trModule1
+
+
+
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index 6dd65a9fcb..c5f142567f 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -86,3 +86,5 @@ test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '
 test('T21265', normal, compile, [''])
 test('EtaExpansion', normal, compile, [''])
 test('T22039', normal, compile, [''])
+# T22388: Should see $winteresting but not $wboring
+test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl'])