Simplifier: Consider `seq` as a `BoringCtxt` (#22317)

See `Note [Seq is boring]` for the rationale.

Fixes #22317.

4 files changed, 298 insertions, 9 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T22317.hs b/testsuite/tests/simplCore/should_compile/T22317.hs
new file mode 100644
index 0000000000..b3ec3d96f5
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22317.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE BangPatterns #-}
+
+module T22317 where
+
+data T = T (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
+
+
+m :: Maybe a -> Maybe a -> Maybe a
+m (Just v1) Nothing = Just v1
+m _         mb      = mb
+{-# INLINE m #-}
+
+f :: T -> T -> T
+f (T a1 b1 c1 d1) (T a2 b2 c2 d2)
+  = let j1 !a = let j2 !b = let j3 !c = let j4 !d = T a b c d
+                                        in j4 (m d1 d2)
+                            in j3 (m c1 c2)
+                in j2 (m b1 b2)
+    in j1 (m a1 a2)
+{-# OPAQUE f #-}
diff --git a/testsuite/tests/simplCore/should_compile/T22317.stderr b/testsuite/tests/simplCore/should_compile/T22317.stderr
new file mode 100644
index 0000000000..2358132fdc
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22317.stderr
@@ -0,0 +1,256 @@
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
+Considering inlining: m
+  arg infos [TrivArg, TrivArg]
+  interesting continuation BoringCtxt
+  some_benefit False
+  is exp: True
+  is work-free: True
+  guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
+  ANSWER = NO
diff --git a/testsuite/tests/simplCore/should_compile/T22375.stderr b/testsuite/tests/simplCore/should_compile/T22375.stderr
index 826d3bc8eb..2fed873c64 100644
--- a/testsuite/tests/simplCore/should_compile/T22375.stderr
+++ b/testsuite/tests/simplCore/should_compile/T22375.stderr
@@ -1,7 +1,7 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 71, types: 31, coercions: 0, joins: 0/0}
+  = {terms: 76, types: 37, coercions: 0, joins: 0/0}
 
 -- RHS size: {terms: 14, types: 7, coercions: 0, joins: 0/0}
 T22375.$fEqX_$c== :: X -> X -> Bool
@@ -46,7 +46,24 @@ T22375.$fEqX [InlPrag=CONLIKE] :: Eq X
 T22375.$fEqX
   = GHC.Classes.C:Eq @X T22375.$fEqX_$c== T22375.$fEqX_$c/=
 
--- RHS size: {terms: 32, types: 5, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 24, types: 3, coercions: 0, joins: 0/0}
+T22375.$wf [InlPrag=[2]] :: X -> GHC.Prim.Int# -> GHC.Prim.Int#
+[GblId[StrictWorker([!])],
+ Arity=2,
+ Str=<1L><L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [64 0] 55 0}]
+T22375.$wf
+  = \ (x :: X) (ww :: GHC.Prim.Int#) ->
+      case x of {
+        A -> GHC.Prim.+# 1# ww;
+        B -> GHC.Prim.+# 2# ww;
+        C -> GHC.Prim.+# 3# ww;
+        D -> GHC.Prim.+# 4# ww;
+        E -> GHC.Prim.+# 5# ww
+      }
+
+-- RHS size: {terms: 12, types: 5, coercions: 0, joins: 0/0}
 f [InlPrag=[2]] :: X -> Int -> Int
 [GblId,
  Arity=2,
@@ -57,13 +74,7 @@ f [InlPrag=[2]] :: X -> Int -> Int
          Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)}]
 f = \ (x :: X) (v :: Int) ->
       case v of { GHC.Types.I# ww ->
-      case x of {
-        A -> GHC.Types.I# (GHC.Prim.+# 1# ww);
-        B -> GHC.Types.I# (GHC.Prim.+# 2# ww);
-        C -> GHC.Types.I# (GHC.Prim.+# 3# ww);
-        D -> GHC.Types.I# (GHC.Prim.+# 4# ww);
-        E -> GHC.Types.I# (GHC.Prim.+# 5# ww)
-      }
+      case T22375.$wf x ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 }
       }
 
 
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 88bbbc0b2c..583acbc47d 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -449,3 +449,5 @@ test('T22375', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeab
 # One module, T21851_2.hs, has OPTIONS_GHC -ddump-simpl
 # Expecting to see $s$wwombat
 test('T21851_2', [grep_errmsg(r'wwombat') ], multimod_compile, ['T21851_2', '-O -dno-typeable-binds -dsuppress-uniques'])
+# Should not inline m, so there shouldn't be a single YES
+test('T22317', [grep_errmsg(r'ANSWER = YES') ], compile, ['-O -dinline-check m -ddebug-output'])