Always do the worker/wrapper split for NOINLINEs

Trac #10069 revealed that small NOINLINE functions didn't get split
into worker and wrapper. This was due to `certainlyWillInline`
saying that any unfoldings with a guidance of `UnfWhen` inline
unconditionally. That isn't the case for NOINLINE functions, so we
catch this case earlier now.

Nofib results:

--------------------------------------------------------------------------------
        Program         Allocs    Instrs
--------------------------------------------------------------------------------
 fannkuch-redux          -0.3%      0.0%
             gg          +0.0%     +0.1%
       maillist          -0.2%     -0.2%
        minimax           0.0%     -0.8%
--------------------------------------------------------------------------------
            Min          -0.3%     -0.8%
            Max          +0.0%     +0.1%
 Geometric Mean          -0.0%     -0.0%

Fixes #10069.

-------------------------
Metric Increase:
    T9233
-------------------------

12 files changed, 63 insertions, 30 deletions

diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index 3ac35c9848..e55e12487b 100644
--- a/compiler/coreSyn/CoreUnfold.hs
+++ b/compiler/coreSyn/CoreUnfold.hs
@@ -1118,13 +1118,14 @@ smallEnoughToInline _ _
 ----------------
 
 certainlyWillInline :: DynFlags -> IdInfo -> Maybe Unfolding
--- Sees if the unfolding is pretty certain to inline
--- If so, return a *stable* unfolding for it, that will always inline
+-- ^ Sees if the unfolding is pretty certain to inline.
+-- If so, return a *stable* unfolding for it, that will always inline.
 certainlyWillInline dflags fn_info
   = case unfoldingInfo fn_info of
       CoreUnfolding { uf_tmpl = e, uf_guidance = g }
-        | loop_breaker -> Nothing       -- Won't inline, so try w/w
-        | otherwise    -> do_cunf e g   -- Depends on size, so look at that
+        | loop_breaker -> Nothing      -- Won't inline, so try w/w
+        | noinline     -> Nothing      -- See Note [Worker-wrapper for NOINLINE functions]
+        | otherwise    -> do_cunf e g  -- Depends on size, so look at that
 
       DFunUnfolding {} -> Just fn_unf  -- Don't w/w DFuns; it never makes sense
                                        -- to do so, and even if it is currently a
@@ -1134,6 +1135,7 @@ certainlyWillInline dflags fn_info
 
   where
     loop_breaker = isStrongLoopBreaker (occInfo fn_info)
+    noinline     = inlinePragmaSpec (inlinePragInfo fn_info) == NoInline
     fn_unf       = unfoldingInfo fn_info
 
     do_cunf :: CoreExpr -> UnfoldingGuidance -> Maybe Unfolding
@@ -1148,9 +1150,6 @@ certainlyWillInline dflags fn_info
         --    See Note [certainlyWillInline: INLINABLE]
     do_cunf expr (UnfIfGoodArgs { ug_size = size, ug_args = args })
       | not (null args)  -- See Note [certainlyWillInline: be careful of thunks]
-      , case inlinePragmaSpec (inlinePragInfo fn_info) of
-          NoInline -> False -- NOINLINE; do not say certainlyWillInline!
-          _        -> True  -- INLINE, INLINABLE, or nothing
       , not (isBottomingSig (strictnessInfo fn_info))
               -- Do not unconditionally inline a bottoming functions even if
               -- it seems smallish. We've carefully lifted it out to top level,
diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs
index 34cfd64ecd..8f34b3b2ec 100644
--- a/compiler/stranal/WorkWrap.hs
+++ b/compiler/stranal/WorkWrap.hs
@@ -242,6 +242,37 @@ NOINLINE pragma to the worker.
 
 (See Trac #13143 for a real-world example.)
 
+It is crucial that we do this for *all* NOINLINE functions. Trac #10069
+demonstrates what happens when we promise to w/w a (NOINLINE) leaf function, but
+fail to deliver:
+
+  data C = C Int# Int#
+
+  {-# NOINLINE c1 #-}
+  c1 :: C -> Int#
+  c1 (C _ n) = n
+
+  {-# NOINLINE fc #-}
+  fc :: C -> Int#
+  fc c = 2 *# c1 c
+
+Failing to w/w `c1`, but still w/wing `fc` leads to the following code:
+
+  c1 :: C -> Int#
+  c1 (C _ n) = n
+
+  $wfc :: Int# -> Int#
+  $wfc n = let c = C 0# n in 2 #* c1 c
+
+  fc :: C -> Int#
+  fc (C _ n) = $wfc n
+
+Yikes! The reboxed `C` in `$wfc` can't cancel out, so we are in a bad place.
+This generalises to any function that derives its strictness signature from
+its callees, so we have to make sure that when a function announces particular
+strictness properties, we have to w/w them accordingly, even if it means
+splitting a NOINLINE function.
+
 Note [Worker activation]
 ~~~~~~~~~~~~~~~~~~~~~~~~
 Follows on from Note [Worker-wrapper for INLINABLE functions]
diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T
index f6891c3859..c250ea952b 100644
--- a/testsuite/tests/profiling/should_run/all.T
+++ b/testsuite/tests/profiling/should_run/all.T
@@ -58,7 +58,7 @@ test('T5654b-O0', [only_ways(['prof'])], compile_and_run, [''])
 
 test('T5654b-O1', [only_ways(['profasm'])], compile_and_run, [''])
 
-test('scc005', [], compile_and_run, [''])
+test('scc005', [], compile_and_run, ['-fno-worker-wrapper'])
 
 test('T5314', [extra_ways(extra_prof_ways)], compile_and_run, [''])
 
diff --git a/testsuite/tests/simplCore/should_compile/T13543.hs b/testsuite/tests/simplCore/should_compile/T13543.hs
index 88a0b142b0..2697677edd 100644
--- a/testsuite/tests/simplCore/should_compile/T13543.hs
+++ b/testsuite/tests/simplCore/should_compile/T13543.hs
@@ -8,7 +8,7 @@ g (p,q) = p+q
 
 f :: Int -> Int -> Int -> Int
 f x p q
-  = g (let j y = (p,q)
+  = g (let j y = (y+p,q)
            {-# NOINLINE j #-}
           in
           case x of
diff --git a/testsuite/tests/simplCore/should_compile/T4201.stdout b/testsuite/tests/simplCore/should_compile/T4201.stdout
index 384c62aa4c..560cd7b762 100644
--- a/testsuite/tests/simplCore/should_compile/T4201.stdout
+++ b/testsuite/tests/simplCore/should_compile/T4201.stdout
@@ -1,3 +1,3 @@
-  {- Arity: 1, HasNoCafRefs, Strictness: <S,1*U()>m,
+  {- Arity: 1, HasNoCafRefs, Strictness: <S,1*H>,
      Unfolding: InlineRule (0, True, True)
                 bof `cast` (Sym (N:Foo[0]) ->_R <T>_R) -}
diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr
index 41f67dc1d1..9c6dd2a01f 100644
--- a/testsuite/tests/simplCore/should_compile/T7360.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7360.stderr
@@ -20,15 +20,7 @@ T7360.$WFoo3
 
 -- RHS size: {terms: 5, types: 2, coercions: 0, joins: 0/0}
 fun1 [InlPrag=NOINLINE] :: Foo -> ()
-[GblId,
- Arity=1,
- Caf=NoCafRefs,
- Str=<S,1*U>,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
-         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)
-         Tmpl= \ (x [Occ=Once] :: Foo) ->
-                 case x of { __DEFAULT -> GHC.Tuple.() }}]
+[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>, Unf=OtherCon []]
 fun1 = \ (x :: Foo) -> case x of { __DEFAULT -> GHC.Tuple.() }
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 646929f778..8896ad5ee3 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -21,7 +21,7 @@ test('simplrun009', normal, compile_and_run, [''])
 test('simplrun010', [extra_run_opts('24 16 8 +RTS -M10m -RTS'),
                      exit_code(251)]
                   , compile_and_run, [''])
-test('simplrun011', normal, compile_and_run, [''])
+test('simplrun011', normal, compile_and_run, ['-fno-worker-wrapper'])
 
 # Really we'd like to run T2486 too, to check that its
 # runtime has not gone up, but here I just compile it so that
diff --git a/testsuite/tests/simplStg/should_compile/all.T b/testsuite/tests/simplStg/should_compile/all.T
index 2cb89749c4..bb2e25ed4b 100644
--- a/testsuite/tests/simplStg/should_compile/all.T
+++ b/testsuite/tests/simplStg/should_compile/all.T
@@ -9,12 +9,4 @@ def f( name, opts ):
 
 setTestOpts(f)
 
-def checkStgString(needle):
-    def norm(str):
-        if needle in str:
-            return "%s contained in -ddump-simpl\n" % needle
-        else:
-            return "%s not contained in -ddump-simpl\n" % needle
-    return normalise_errmsg_fun(norm)
-
-test('T13588', [ checkStgString('case') ] , compile, ['-dverbose-stg2stg'])
+test('T13588', [ grep_errmsg('case') ] , compile, ['-dverbose-stg2stg -fno-worker-wrapper'])
diff --git a/testsuite/tests/stranal/should_compile/T10069.hs b/testsuite/tests/stranal/should_compile/T10069.hs
new file mode 100644
index 0000000000..f93eaf5678
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T10069.hs
@@ -0,0 +1,11 @@
+module T10069 where
+
+data C = C !Int !Int
+
+{-# NOINLINE c1 #-}
+c1 :: C -> Int
+c1 (C _ c) = c
+
+{-# NOINLINE fc #-}
+fc :: C -> Int
+fc c = c1 c +  c1 c
diff --git a/testsuite/tests/stranal/should_compile/T10069.stderr b/testsuite/tests/stranal/should_compile/T10069.stderr
new file mode 100644
index 0000000000..97c255a536
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T10069.stderr
@@ -0,0 +1 @@
+T10069.$wc1 [InlPrag=NOINLINE] :: GHC.Prim.Int# -> GHC.Prim.Int#
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index c94065b2e4..3cff3c7888 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -48,3 +48,4 @@ test('T13077a', normal, compile, [''])
 test('T15627',  [ grep_errmsg(r'(wmutVar|warray).*Int#') ], compile, ['-dppr-cols=200 -ddump-simpl'])
 
 test('T16029', normal, makefile_test, [])
+test('T10069',  [ grep_errmsg(r'(wc1).*Int#$') ], compile, ['-dppr-cols=200 -ddump-simpl'])
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index d7ae9ffe01..3427a1ebae 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -611,7 +611,13 @@ gen_wrappers (Info _ entries)
    =    "{-# LANGUAGE MagicHash, NoImplicitPrelude, UnboxedTuples #-}\n"
         -- Dependencies on Prelude must be explicit in libraries/base, but we
         -- don't need the Prelude here so we add NoImplicitPrelude.
-     ++ "{-# OPTIONS_GHC -Wno-deprecations #-}\n"
+     ++ "{-# OPTIONS_GHC -Wno-deprecations -O0 #-}\n"
+        -- No point in optimising this at all.
+        -- Performing WW on this module is harmful even, two reasons:
+        --   1. Inferred strictness signatures are all bottom, which is a lie
+        --   2. Doing the worker/wrapper split based on that information will
+        --      introduce references to Control.Exception.Base.absentError,
+        --      which isn't available at this point.
      ++ "module GHC.PrimopWrappers where\n"
      ++ "import qualified GHC.Prim\n"
      ++ "import GHC.Tuple ()\n"