WorkWrap: Remove mkWWargs (#19874)

`mkWWargs`'s job was pushing casts inwards and doing eta expansion to match
the arity with the number of argument demands we w/w for.

Nowadays, we use the Simplifier to eta expand to arity. In fact, in recent years
we have even seen the eta expansion done by w/w as harmful, see Note [Don't eta
expand in w/w]. If a function hasn't enough manifest lambdas, don't w/w it!

What purpose does `mkWWargs` serve in this world? Not a great one, it turns out!
I could remove it by pulling some important bits,
notably Note [Freshen WW arguments] and Note [Join points and beta-redexes].
Result: We reuse the freshened binder names of the wrapper in the
worker where possible (see testuite changes), much nicer!

In order to avoid scoping errors due to lambda-bound unfoldings in worker
arguments, we zap those unfoldings now. In doing so, we fix #19766.

Fixes #19874.

16 files changed, 239 insertions, 248 deletions

diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index 18b4d848e1..219990d135 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -16,7 +16,6 @@ import GHC.Core
 import GHC.Core.Unfold
 import GHC.Core.Unfold.Make
 import GHC.Core.Utils  ( exprType, exprIsHNF )
-import GHC.Core.FVs    ( exprFreeVars )
 import GHC.Core.Type
 import GHC.Core.Opt.WorkWrap.Utils
 import GHC.Core.FamInstEnv
@@ -210,7 +209,7 @@ unfolding to the *worker*.  So we will get something like this:
   fw d x y' = let y = I# y' in ...f...
 
 How do we "transfer the unfolding"? Easy: by using the old one, wrapped
-in work_fn! See GHC.Core.Unfold.mkWorkerUnfolding.
+in work_fn! See GHC.Core.Unfold.Make.mkWorkerUnfolding.
 
 Note [No worker/wrapper for record selectors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -629,7 +628,13 @@ means GHC.Core.Opt.Arity didn't eta expand that binding. When this happens, it d
 for a reason (see Note [exprArity invariant] in GHC.Core.Opt.Arity) and we probably have
 a PAP, cast or trivial expression as RHS.
 
-Performing the worker/wrapper split will implicitly eta-expand the binding to
+Below is a historical account of what happened when w/w still did eta expansion.
+Nowadays, it doesn't do that, but will simply w/w for the wrong arity, unleashing
+a demand signature meant for e.g. 2 args to be unleashed for e.g. 1 arg
+(manifest arity). That's at least as terrible as doing eta expansion, so don't
+do it.
+---
+When worker/wrapper did eta expansion, it implictly eta expanded the binding to
 idArity, overriding GHC.Core.Opt.Arity's decision. Other than playing fast and loose with
 divergence, it's also broken for newtypes:
 
@@ -684,7 +689,7 @@ splitFun :: WwOpts -> Id -> IdInfo -> CoreExpr -> UniqSM [(Id, CoreExpr)]
 splitFun ww_opts fn_id fn_info rhs
   = warnPprTrace (not (wrap_dmds `lengthIs` (arityInfo fn_info)))
                  (ppr fn_id <+> (ppr wrap_dmds $$ ppr cpr)) $
-    do { mb_stuff <- mkWwBodies ww_opts rhs_fvs fn_id wrap_dmds use_cpr_info
+    do { mb_stuff <- mkWwBodies ww_opts fn_id arg_vars (exprType body) wrap_dmds use_cpr_info
        ; case mb_stuff of
             Nothing -> -- No useful wrapper; leave the binding alone
                        return [(fn_id, rhs)]
@@ -699,11 +704,13 @@ splitFun ww_opts fn_id fn_info rhs
 
               | otherwise
               -> do { work_uniq <- getUniqueM
-                    ; return (mkWWBindPair ww_opts fn_id fn_info rhs
+                    ; return (mkWWBindPair ww_opts fn_id fn_info arg_vars body
                                            work_uniq div cpr stuff) } }
   where
     uf_opts = so_uf_opts (wo_simple_opts ww_opts)
-    rhs_fvs = exprFreeVars rhs
+    (arg_vars, body) = collectBinders rhs
+            -- collectBinders was not enough for GHC.Event.IntTable.insertWith
+            -- last time I checked, where manifest lambdas were wrapped in casts
 
     (wrap_dmds, div) = splitDmdSig (dmdSigInfo fn_info)
 
@@ -722,10 +729,10 @@ splitFun ww_opts fn_id fn_info rhs
 
 
 mkWWBindPair :: WwOpts -> Id -> IdInfo
-             -> CoreExpr -> Unique -> Divergence -> Cpr
+             -> [Var] -> CoreExpr -> Unique -> Divergence -> Cpr
              -> ([Demand], JoinArity, Id -> CoreExpr, Expr CoreBndr -> CoreExpr)
              -> [(Id, CoreExpr)]
-mkWWBindPair ww_opts fn_id fn_info rhs work_uniq div cpr
+mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div cpr
              (work_demands, join_arity, wrap_fn, work_fn)
   = [(work_id, work_rhs), (wrap_id, wrap_rhs)]
      -- Worker first, because wrapper mentions it
@@ -736,7 +743,7 @@ mkWWBindPair ww_opts fn_id fn_info rhs work_uniq div cpr
 
     simpl_opts = wo_simple_opts ww_opts
 
-    work_rhs = work_fn rhs
+    work_rhs = work_fn (mkLams fn_args fn_body)
     work_act = case fn_inline_spec of  -- See Note [Worker activation]
                    NoInline -> inl_act fn_inl_prag
                    _        -> inl_act wrap_prag
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index 61de975bf0..8994af8283 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -22,12 +22,10 @@ import GHC.Driver.Session
 import GHC.Driver.Config (initSimpleOpts)
 
 import GHC.Core
-import GHC.Core.Utils   ( exprType, mkCast, mkDefaultCase, mkSingleAltCase
-                        , bindNonRec, dataConRepFSInstPat
-                        , normSplitTyConApp_maybe, exprIsHNF )
+import GHC.Core.Utils
 import GHC.Core.DataCon
-import GHC.Core.Make     ( mkAbsentErrorApp, mkCoreUbxTup, mkCoreApp, mkCoreLet
-                         , mkWildValBinder, mkLitRubbish )
+import GHC.Core.Make
+import GHC.Core.Subst
 import GHC.Core.Type
 import GHC.Core.Multiplicity
 import GHC.Core.Predicate ( isClassPred )
@@ -38,15 +36,13 @@ import GHC.Core.TyCon.RecWalk
 import GHC.Core.SimpleOpt( SimpleOpts )
 
 import GHC.Types.Id
-import GHC.Types.Id.Info ( JoinArity )
+import GHC.Types.Id.Info
 import GHC.Types.Demand
 import GHC.Types.Cpr
 import GHC.Types.Id.Make ( voidArgId, voidPrimId )
-import GHC.Types.Var.Env ( mkInScopeSet )
-import GHC.Types.Var.Set ( VarSet )
-import GHC.Types.Basic       ( Boxity(..) )
+import GHC.Types.Var.Env
+import GHC.Types.Basic
 import GHC.Types.Unique.Supply
-import GHC.Types.Unique
 import GHC.Types.Name ( getOccFS )
 
 import GHC.Data.FastString
@@ -165,46 +161,87 @@ type WwResult
 nop_fn :: CoreExpr -> CoreExpr
 nop_fn body = body
 
+
 mkWwBodies :: WwOpts
-           -> VarSet         -- Free vars of RHS
-                             -- See Note [Freshen WW arguments]
-           -> Id             -- The original function
-           -> [Demand]       -- Strictness of original function
-           -> Cpr            -- Info about function result
+           -> Id             -- ^ The original function
+           -> [Var]          -- ^ Manifest args of original function
+           -> Type           -- ^ Result type of the original function,
+                             --   after being stripped of args
+           -> [Demand]       -- ^ Strictness of original function
+           -> Cpr            -- ^ Info about function result
            -> UniqSM (Maybe WwResult)
+-- ^ Given a function definition
+--
+-- > data T = MkT Int Bool Char
+-- > f :: (a, b) -> Int -> T
+-- > f = \x y -> E
+--
+-- @mkWwBodies _ 'f' ['x::(a,b)','y::Int'] '(a,b)' ['1P(L,L)', '1P(L)'] '1'@
+-- returns
+--
+--   * The wrapper body context for the call to the worker function, lacking
+--     only the 'Id' for the worker function:
+--
+--     > W[_] :: Id -> CoreExpr
+--     > W[work_fn] = \x y ->          -- args of the wrapper    (cloned_arg_vars)
+--     >   case x of (a, b) ->         -- unbox wrapper args     (wrap_fn_str)
+--     >   case y of I# n ->           --
+--     >   case <work_fn> a b n of     -- call to the worker fun (call_work)
+--     >   (# i, b, c #) -> MkT i b c  -- rebox result           (wrap_fn_cpr)
+--
+--   * The worker body context that wraps around its hole reboxing defns for x
+--     and y, as well as returning CPR transit variables of the unboxed MkT
+--     result in an unboxed tuple:
+--
+--     > w[_] :: CoreExpr -> CoreExpr
+--     > w[fn_rhs] = \a b n ->              -- args of the worker       (work_lam_args)
+--     >   let { y = I# n; x = (a, b) } in  -- reboxing wrapper args    (work_fn_str)
+--     >   case <fn_rhs> x y of             -- call to the original RHS (call_rhs)
+--     >   MkT i b c -> (# i, b, c #)       -- return CPR transit vars  (work_fn_cpr)
+--
+--     NB: The wrap_rhs hole is to be filled with the original wrapper RHS
+--     @\x y -> E@. This is so that we can also use @w@ to transform stable
+--     unfoldings, the lambda args of which may be different than x and y.
+--
+--   * Id details for the worker function like demands on arguments and its join
+--     arity.
+--
+-- All without looking at E (except for beta reduction, see Note [Join points
+-- and beta-redexes]), which allows us to apply the same split to function body
+-- and its unfolding(s) alike.
+--
+mkWwBodies opts fun_id arg_vars res_ty demands res_cpr
+  = do  { massertPpr (filter isId arg_vars `equalLength` demands)
+                     (text "wrong wrapper arity" $$ ppr fun_id $$ ppr arg_vars $$ ppr res_ty $$ ppr demands)
+
+        -- Clone and prepare arg_vars of the original fun RHS
+        -- See Note [Freshen WW arguments]
+        -- and Note [Zap IdInfo on worker args]
+        ; uniq_supply <- getUniqueSupplyM
+        ; let args_free_tcvs = tyCoVarsOfTypes (res_ty : map varType arg_vars)
+              empty_subst = mkEmptySubst (mkInScopeSet args_free_tcvs)
+              zapped_arg_vars = map zap_var arg_vars
+              (subst, cloned_arg_vars) = cloneBndrs empty_subst uniq_supply zapped_arg_vars
+              res_ty' = GHC.Core.Subst.substTy subst res_ty
 
--- wrap_fn_args E       = \x y -> E
--- work_fn_args E       = E x y
-
--- wrap_fn_str E        = case x of { (a,b) ->
---                        case a of { (a1,a2) ->
---                        E a1 a2 b y }}
--- work_fn_str E        = \a1 a2 b y ->
---                        let a = (a1,a2) in
---                        let x = (a,b) in
---                        E
-
-mkWwBodies opts rhs_fvs fun_id demands cpr_info
-  = do  { let empty_subst = mkEmptyTCvSubst (mkInScopeSet rhs_fvs)
-                -- See Note [Freshen WW arguments]
-
-        ; (wrap_args, wrap_fn_args, work_fn_args, res_ty)
-             <- mkWWargs empty_subst fun_ty demands
         ; (useful1, work_args, wrap_fn_str, work_fn_str)
-             <- mkWWstr opts inlineable_flag wrap_args
+             <- mkWWstr opts inlineable_flag cloned_arg_vars
 
         -- Do CPR w/w.  See Note [Always do CPR w/w]
         ; (useful2, wrap_fn_cpr, work_fn_cpr, cpr_res_ty)
-              <- mkWWcpr_entry opts res_ty cpr_info
+              <- mkWWcpr_entry opts res_ty' res_cpr
 
         ; let (work_lam_args, work_call_args) = mkWorkerArgs fun_id (wo_fun_to_thunk opts)
                                                              work_args cpr_res_ty
+              call_work work_fn  = mkVarApps (Var work_fn) work_call_args
+              call_rhs fn_rhs = mkVarAppsBeta fn_rhs cloned_arg_vars
+                                  -- See Note [Join points and beta-redexes]
+              wrapper_body = mkLams cloned_arg_vars . wrap_fn_cpr . wrap_fn_str . call_work
+              worker_body = mkLams work_lam_args . work_fn_str . work_fn_cpr . call_rhs
               worker_args_dmds = [idDemandInfo v | v <- work_call_args, isId v]
-              wrapper_body = wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var
-              worker_body = mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args
 
         ; if isWorkerSmallEnough (wo_max_worker_args opts) (length demands) work_args
-             && not (too_many_args_for_join_point wrap_args)
+             && not (too_many_args_for_join_point arg_vars)
              && ((useful1 && not only_one_void_argument) || useful2)
           then return (Just (worker_args_dmds, length work_call_args,
                        wrapper_body, worker_body))
@@ -218,7 +255,11 @@ mkWwBodies opts rhs_fvs fun_id demands cpr_info
         -- f's RHS is now trivial (size 1) we still want the __inline__ to prevent
         -- fw from being inlined into f's RHS
   where
-    fun_ty        = idType fun_id
+    zap_var v | isTyVar v = v
+              | otherwise = modifyIdInfo zap_info v
+    zap_info info -- See Note [Zap IdInfo on worker args]
+      = info `setOccInfo`       noOccInfo
+
     mb_join_arity = isJoinId_maybe fun_id
     inlineable_flag -- See Note [Do not unpack class dictionaries]
       | isStableUnfolding (realIdUnfolding fun_id) = MaybeArgOfInlineableFun
@@ -227,8 +268,8 @@ mkWwBodies opts rhs_fvs fun_id demands cpr_info
     -- Note [Do not split void functions]
     only_one_void_argument
       | [d] <- demands
-      , Just (_, arg_ty1, _) <- splitFunTy_maybe fun_ty
-      , isAbsDmd d && isVoidTy arg_ty1
+      , [v] <- filter isId arg_vars
+      , isAbsDmd d && isVoidTy (idType v)
       = True
       | otherwise
       = False
@@ -244,6 +285,13 @@ mkWwBodies opts rhs_fvs fun_id demands cpr_info
       | otherwise
       = False
 
+-- | Version of 'GHC.Core.mkVarApps' that does beta reduction on-the-fly.
+-- PRECONDITION: The arg vars don't shadow each other or any of the free vars of
+-- the function expression.
+mkVarAppsBeta :: CoreExpr -> [Var] -> CoreExpr
+mkVarAppsBeta (Lam b body) (v:vs) = bindNonRec b (varToCoreExpr v) $! mkVarAppsBeta body vs
+mkVarAppsBeta f            vars   = mkVarApps f vars
+
 -- See Note [Limit w/w arity]
 isWorkerSmallEnough :: Int -> Int -> [Var] -> Bool
 isWorkerSmallEnough max_worker_args old_n_args vars
@@ -293,6 +341,20 @@ out of fuel it would stop w/wing.
 
 Still not very clever because it had a left-right bias.
 
+Note [Zap IdInfo on worker args]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We have to zap the following IdInfo when re-using arg variables of the original
+function for the worker:
+
+  * OccInfo: Dead wrapper args now occur in Apps of the worker's call to the
+    original fun body. Those occurrences will quickly cancel away with the lambdas
+    of the fun body in the next run of the Simplifier, but CoreLint will complain
+    in the meantime, so zap it.
+
+We zap in mkWwBodies because we need the zapped variables both when binding them
+in mkWWstr (mk_absent_let, specifically) and in mkWorkerArgs, where we produce
+the call to the fun body.
+
 ************************************************************************
 *                                                                      *
 \subsection{Making wrapper args}
@@ -419,146 +481,40 @@ have to be concerned about.
 FIXME Currently the functionality to produce "eta-contracted" wrappers is
 unimplemented; we simply give up.
 
-************************************************************************
-*                                                                      *
-\subsection{Coercion stuff}
-*                                                                      *
-************************************************************************
-
-We really want to "look through" coerces.
-Reason: I've seen this situation:
-
-        let f = coerce T (\s -> E)
-        in \x -> case x of
-                    p -> coerce T' f
-                    q -> \s -> E2
-                    r -> coerce T' f
-
-If only we w/w'd f, we'd get
-        let f = coerce T (\s -> fw s)
-            fw = \s -> E
-        in ...
-
-Now we'll inline f to get
-
-        let fw = \s -> E
-        in \x -> case x of
-                    p -> fw
-                    q -> \s -> E2
-                    r -> fw
-
-Now we'll see that fw has arity 1, and will arity expand
-the \x to get what we want.
--}
-
--- mkWWargs just does eta expansion
--- is driven off the function type and arity.
--- It chomps bites off foralls, arrows, newtypes
--- and keeps repeating that until it's satisfied the supplied arity
-
-mkWWargs :: TCvSubst            -- Freshening substitution to apply to the type
-                                --   See Note [Freshen WW arguments]
-         -> Type                -- The type of the function
-         -> [Demand]     -- Demands and one-shot info for value arguments
-         -> UniqSM  ([Var],            -- Wrapper args
-                     CoreExpr -> CoreExpr,      -- Wrapper fn
-                     CoreExpr -> CoreExpr,      -- Worker fn
-                     Type)                      -- Type of wrapper body
-
-mkWWargs subst fun_ty demands
-  | null demands
-  = return ([], nop_fn, nop_fn, substTyUnchecked subst fun_ty)
-    -- I got an ASSERT failure here with `substTy`, and I was
-    -- disinclined to pursue it since this code is about to be
-    -- deleted by Sebastian
-
-  | (dmd:demands') <- demands
-  , Just (mult, arg_ty, fun_ty') <- splitFunTy_maybe fun_ty
-  = do  { uniq <- getUniqueM
-        ; let arg_ty' = substScaledTy subst (Scaled mult arg_ty)
-              id = mk_wrap_arg uniq arg_ty' dmd
-        ; (wrap_args, wrap_fn_args, work_fn_args, res_ty)
-              <- mkWWargs subst fun_ty' demands'
-        ; return (id : wrap_args,
-                  Lam id . wrap_fn_args,
-                  apply_or_bind_then work_fn_args (varToCoreExpr id),
-                  res_ty) }
-
-  | Just (tv, fun_ty') <- splitForAllTyCoVar_maybe fun_ty
-  = do  { uniq <- getUniqueM
-        ; let (subst', tv') = cloneTyVarBndr subst tv uniq
-                -- See Note [Freshen WW arguments]
-        ; (wrap_args, wrap_fn_args, work_fn_args, res_ty)
-             <- mkWWargs subst' fun_ty' demands
-        ; return (tv' : wrap_args,
-                  Lam tv' . wrap_fn_args,
-                  apply_or_bind_then work_fn_args (mkTyArg (mkTyVarTy tv')),
-                  res_ty) }
-
-  | Just (co, rep_ty) <- topNormaliseNewType_maybe fun_ty
-        -- The newtype case is for when the function has
-        -- a newtype after the arrow (rare)
-        --
-        -- It's also important when we have a function returning (say) a pair
-        -- wrapped in a  newtype, at least if CPR analysis can look
-        -- through such newtypes, which it probably can since they are
-        -- simply coerces.
-
-  = do { (wrap_args, wrap_fn_args, work_fn_args, res_ty)
-            <-  mkWWargs subst rep_ty demands
-       ; let co' = substCo subst co
-       ; return (wrap_args,
-                  \e -> Cast (wrap_fn_args e) (mkSymCo co'),
-                  \e -> work_fn_args (Cast e co'),
-                  res_ty) }
-
-  | otherwise
-  = warnPprTrace True (ppr fun_ty) $                  -- Should not happen: if there is a demand
-    return ([], nop_fn, nop_fn, substTy subst fun_ty) -- then there should be a function arrow
-  where
-    -- See Note [Join points and beta-redexes]
-    apply_or_bind_then k arg (Lam bndr body)
-      = mkCoreLet (NonRec bndr arg) (k body)    -- Important that arg is fresh!
-    apply_or_bind_then k arg fun
-      = k $ mkCoreApp (text "mkWWargs") fun arg
-
-applyToVars :: [Var] -> CoreExpr -> CoreExpr
-applyToVars vars fn = mkVarApps fn vars
-
-mk_wrap_arg :: Unique -> Scaled Type -> Demand -> Id
-mk_wrap_arg uniq (Scaled w ty) dmd
-  = mkSysLocalOrCoVar (fsLit "w") uniq w ty
-       `setIdDemandInfo` dmd
-
-{- Note [Freshen WW arguments]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Wen we do a worker/wrapper split, we must not in-scope names as the arguments
-of the worker, else we'll get name capture.  E.g.
-
-   -- y1 is in scope from further out
-   f x = ..y1..
-
-If we accidentally choose y1 as a worker argument disaster results:
-
-   fww y1 y2 = let x = (y1,y2) in ...y1...
-
-To avoid this:
-
-  * We use a fresh unique for both type-variable and term-variable binders
-    Originally we lacked this freshness for type variables, and that led
-    to the very obscure #12562.  (A type variable in the worker shadowed
-    an outer term-variable binding.)
-
-  * Because of this cloning we have to substitute in the type/kind of the
-    new binders.  That's why we carry the TCvSubst through mkWWargs.
-
-    So we need a decent in-scope set, just in case that type/kind
-    itself has foralls.  We get this from the free vars of the RHS of the
-    function since those are the only variables that might be captured.
-    It's a lazy thunk, which will only be poked if the type/kind has a forall.
-
-    Another tricky case was when f :: forall a. a -> forall a. a->a
-    (i.e. with shadowing), and then the worker used the same 'a' twice.
+Note [Freshen WW arguments]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When we do a worker/wrapper split, we must freshen the arg vars of the original
+fun RHS because they might shadow each other. E.g.
+
+  f :: forall a. Maybe a -> forall a. Maybe a -> Int -> Int
+  f @a x @a y z = case x <|> y of
+    Nothing -> z
+    Just _  -> z + 1
+
+  ==> {WW split unboxing the Int}
+
+  $wf :: forall a. Maybe a -> forall a. Maybe a -> Int# -> Int
+  $wf @a x @a y wz = (\@a x @a y z -> case x <|> y of ...) ??? x @a y (I# wz)
+
+(Notice that the code we actually emit will sort-of ANF-ise the lambda args,
+leading to even more shadowing issues. The above demonstrates that even if we
+try harder we'll still get shadowing issues.)
+
+What should we put in place for ??? ? Certainly not @a, because that would
+reference the wrong, inner a. A similar situation occurred in #12562, we even
+saw a type variable in the worker shadowing an outer term-variable binding.
+
+We avoid the issue by freshening the argument variables from the original fun
+RHS through 'cloneBndrs', which will also take care of subsitution in binder
+types. Fortunately, it's sufficient to pick the FVs of the arg vars as in-scope
+set, so that we don't need to do a FV traversal over the whole body of the
+original function.
+
+At the moment, #12562 has no regression test. As such, this Note is not covered
+by any test logic or when bootstrapping the compiler. Yet we clearly want to
+freshen the binders, as the example above demonstrates.
+Adding a Core pass that maximises shadowing for testing purposes might help,
+see #17478.
 -}
 
 {-
@@ -1021,8 +977,8 @@ mkAbsentFiller opts arg
   -- The lifted case: Bind 'absentError' for a nice panic message if we are
   -- wrong (like we were in #11126). See (1) in Note [Absent fillers]
   | not (isUnliftedType arg_ty)
-  , not (isStrictDmd (idDemandInfo arg)) -- See (2) in Note [Absent fillers]
-  = Just panic_rhs
+  , not is_strict, not is_evald -- See (2) in Note [Absent fillers]
+  = Just (mkAbsentErrorApp arg_ty msg)
 
   -- The default case for mono rep: Bind `RUBBISH[rr] arg_ty`
   -- See Note [Absent fillers], the main part
@@ -1030,9 +986,9 @@ mkAbsentFiller opts arg
   = mkLitRubbish arg_ty
 
   where
-    arg_ty = idType arg
-
-    panic_rhs = mkAbsentErrorApp arg_ty msg
+    arg_ty    = idType arg
+    is_strict = isStrictDmd (idDemandInfo arg)
+    is_evald  = isEvaldUnfolding $ idUnfolding arg
 
     msg = renderWithContext
             (defaultSDocContext { sdocSuppressUniques = True })
@@ -1213,6 +1169,14 @@ Needless to say, there are some wrinkles:
      cardinality 'C_10' (say, the arg to a bottoming function) where we could've
      used an error-thunk, but that's a small price to pay for simplicity.
 
+     In #19766, we discovered that even if the binder has eval cardinality
+     'C_00', it may end up in a strict field, with no surrounding seq
+     whatsoever! That happens if the calling code has already evaluated
+     said lambda binder, which will then have an evaluated unfolding
+     ('isEvaldUnfolding'). That in turn tells the Simplifier it is free to drop
+     the seq. So we better don't fill in an error-thunk for eval'd arguments
+     either, just in case it ends up in a strict field!
+
   3. We can only emit a LitRubbish if the arg's type @arg_ty@ is mono-rep, e.g.
      of the form @TYPE rep@ where @rep@ is not (and doesn't contain) a variable.
      Why? Because if we don't know its representation (e.g. size in memory,
@@ -1307,7 +1271,7 @@ dubiousDataConInstArgTys dc tc_args = arg_tys
     univ_tvs = dataConUnivTyVars dc
     ex_tvs   = dataConExTyCoVars dc
     subst    = extendTCvInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs
-    arg_tys  = map (substTy subst . scaledThing) (dataConRepArgTys dc)
+    arg_tys  = map (GHC.Core.Type.substTy subst . scaledThing) (dataConRepArgTys dc)
 
 {-
 ************************************************************************
diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr
index 87fbdd6213..c4c2db7462 100644
--- a/testsuite/tests/simplCore/should_compile/T13143.stderr
+++ b/testsuite/tests/simplCore/should_compile/T13143.stderr
@@ -70,15 +70,15 @@ T13143.$wg [InlPrag=[2], Occ=LoopBreaker]
   :: Bool -> Bool -> GHC.Prim.Int# -> GHC.Prim.Int#
 [GblId, Arity=3, Str=<1L><1L><L>, Unf=OtherCon []]
 T13143.$wg
-  = \ (w :: Bool) (w1 :: Bool) (ww :: GHC.Prim.Int#) ->
-      case w of {
+  = \ (ds :: Bool) (ds1 :: Bool) (ww :: GHC.Prim.Int#) ->
+      case ds of {
         False ->
-          case w1 of {
+          case ds1 of {
             False -> T13143.$wg GHC.Types.False GHC.Types.True ww;
             True -> GHC.Prim.+# ww 1#
           };
         True ->
-          case w1 of {
+          case ds1 of {
             False -> T13143.$wg GHC.Types.True GHC.Types.True ww;
             True -> case lvl of wild2 { }
           }
@@ -94,17 +94,17 @@ g [InlPrag=[2]] :: Bool -> Bool -> Int -> Int
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (w [Occ=Once1] :: Bool)
-                 (w1 [Occ=Once1] :: Bool)
-                 (w2 [Occ=Once1!] :: Int) ->
-                 case w2 of { GHC.Types.I# ww [Occ=Once1] ->
-                 case T13143.$wg w w1 ww of ww1 [Occ=Once1] { __DEFAULT ->
+         Tmpl= \ (ds [Occ=Once1] :: Bool)
+                 (ds1 [Occ=Once1] :: Bool)
+                 (p [Occ=Once1!] :: Int) ->
+                 case p of { GHC.Types.I# ww [Occ=Once1] ->
+                 case T13143.$wg ds ds1 ww of ww1 [Occ=Once1] { __DEFAULT ->
                  GHC.Types.I# ww1
                  }
                  }}]
-g = \ (w :: Bool) (w1 :: Bool) (w2 :: Int) ->
-      case w2 of { GHC.Types.I# ww ->
-      case T13143.$wg w w1 ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 }
+g = \ (ds :: Bool) (ds1 :: Bool) (p :: Int) ->
+      case p of { GHC.Types.I# ww ->
+      case T13143.$wg ds ds1 ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 }
       }
 
 
diff --git a/testsuite/tests/simplCore/should_compile/T15631.stdout b/testsuite/tests/simplCore/should_compile/T15631.stdout
index e9e6a2bcab..ab181b58ed 100644
--- a/testsuite/tests/simplCore/should_compile/T15631.stdout
+++ b/testsuite/tests/simplCore/should_compile/T15631.stdout
@@ -1,7 +1,7 @@
       case GHC.List.$wlenAcc
-      case GHC.List.$wlenAcc @a w 0# of ww1 { __DEFAULT ->
-      case GHC.List.reverse1 @a w (GHC.Types.[] @a) of {
+      case GHC.List.$wlenAcc @a xs 0# of ww1 { __DEFAULT ->
+      case GHC.List.reverse1 @a xs (GHC.Types.[] @a) of {
         [] -> case Foo.f1 @a of { GHC.Types.I# v1 -> GHC.Prim.+# ww1 v1 };
           case GHC.List.$wlenAcc
-                 case Foo.$wf @a w of ww [Occ=Once1] { __DEFAULT ->
-      case Foo.$wf @a w of ww { __DEFAULT -> GHC.Types.I# ww }
+                 case Foo.$wf @a xs of ww [Occ=Once1] { __DEFAULT ->
+      case Foo.$wf @a xs of ww { __DEFAULT -> GHC.Types.I# ww }
diff --git a/testsuite/tests/simplCore/should_compile/T18013.stderr b/testsuite/tests/simplCore/should_compile/T18013.stderr
index 45f9900830..5c82b03c93 100644
--- a/testsuite/tests/simplCore/should_compile/T18013.stderr
+++ b/testsuite/tests/simplCore/should_compile/T18013.stderr
@@ -140,8 +140,8 @@ mapMaybeRule [InlPrag=[2]]
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (@a) (@b) (w [Occ=Once1!] :: Rule IO a b) ->
-                 case w of { Rule @s ww ww1 [Occ=OnceL1!] ->
+         Tmpl= \ (@a) (@b) (f [Occ=Once1!] :: Rule IO a b) ->
+                 case f of { Rule @s ww ww1 [Occ=OnceL1!] ->
                  T18013a.Rule
                    @IO
                    @(Maybe a)
@@ -176,8 +176,8 @@ mapMaybeRule [InlPrag=[2]]
                                       ~R# (s -> Maybe a -> IO (Result s (Maybe b))))
                  }}]
 mapMaybeRule
-  = \ (@a) (@b) (w :: Rule IO a b) ->
-      case w of { Rule @s ww ww1 ->
+  = \ (@a) (@b) (f :: Rule IO a b) ->
+      case f of { Rule @s ww ww1 ->
       let {
         lvl :: Result s (Maybe b)
         [LclId, Unf=OtherCon []]
diff --git a/testsuite/tests/simplCore/should_compile/T19246.stderr b/testsuite/tests/simplCore/should_compile/T19246.stderr
index 0c7894e56d..acfe1500b8 100644
--- a/testsuite/tests/simplCore/should_compile/T19246.stderr
+++ b/testsuite/tests/simplCore/should_compile/T19246.stderr
@@ -6,6 +6,6 @@
 ==================== Tidy Core rules ====================
 "SPEC f" [2] forall ($dOrd :: Ord Int). f @Int $dOrd = $sf
 "SPEC/T19246 $wf @Int" [2]
-    forall (w :: Ord Int). $wf @Int w = $s$wf
+    forall ($dOrd :: Ord Int). $wf @Int $dOrd = $s$wf
 
 
diff --git a/testsuite/tests/simplCore/should_compile/T3717.stderr b/testsuite/tests/simplCore/should_compile/T3717.stderr
index 6e8fe19294..bd6417b729 100644
--- a/testsuite/tests/simplCore/should_compile/T3717.stderr
+++ b/testsuite/tests/simplCore/should_compile/T3717.stderr
@@ -61,15 +61,15 @@ foo [InlPrag=[2]] :: Int -> Int
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (w [Occ=Once1!] :: Int) ->
-                 case w of { GHC.Types.I# ww [Occ=Once1] ->
+         Tmpl= \ (ds [Occ=Once1!] :: Int) ->
+                 case ds of { GHC.Types.I# ww [Occ=Once1] ->
                  case T3717.$wfoo ww of ww1 [Occ=Once1] { __DEFAULT ->
                  GHC.Types.I# ww1
                  }
                  }}]
 foo
-  = \ (w :: Int) ->
-      case w of { GHC.Types.I# ww ->
+  = \ (ds :: Int) ->
+      case ds of { GHC.Types.I# ww ->
       case T3717.$wfoo ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 }
       }
 
diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout
index 5ead45f9c3..abf4b8db14 100644
--- a/testsuite/tests/simplCore/should_compile/T3772.stdout
+++ b/testsuite/tests/simplCore/should_compile/T3772.stdout
@@ -69,10 +69,10 @@ foo [InlPrag=[final]] :: Int -> ()
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (w [Occ=Once1!] :: Int) ->
-                 case w of { GHC.Types.I# ww [Occ=Once1] -> T3772.$wfoo ww }}]
+         Tmpl= \ (n [Occ=Once1!] :: Int) ->
+                 case n of { GHC.Types.I# ww [Occ=Once1] -> T3772.$wfoo ww }}]
 foo
-  = \ (w :: Int) -> case w of { GHC.Types.I# ww -> T3772.$wfoo ww }
+  = \ (n :: Int) -> case n of { GHC.Types.I# ww -> T3772.$wfoo ww }
 
 
 
diff --git a/testsuite/tests/simplCore/should_compile/T4908.stderr b/testsuite/tests/simplCore/should_compile/T4908.stderr
index f8f9107485..afea396826 100644
--- a/testsuite/tests/simplCore/should_compile/T4908.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4908.stderr
@@ -63,10 +63,10 @@ T4908.$wf [InlPrag=[2]] :: Int# -> (Int, Int) -> Bool
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 20] 101 20}]
 T4908.$wf
-  = \ (ww :: Int#) (w :: (Int, Int)) ->
+  = \ (ww :: Int#) (x :: (Int, Int)) ->
       case ww of ds {
         __DEFAULT ->
-          case w of { (a, b) ->
+          case x of { (a, b) ->
           case b of { I# ds1 ->
           case ds1 of ds2 {
             __DEFAULT -> T4908.f_$s$wf a ds2 (-# ds 1#);
@@ -85,10 +85,10 @@ f [InlPrag=[2]] :: Int -> (Int, Int) -> Bool
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (w [Occ=Once1!] :: Int) (w1 [Occ=Once1] :: (Int, Int)) ->
-                 case w of { I# ww [Occ=Once1] -> T4908.$wf ww w1 }}]
-f = \ (w :: Int) (w1 :: (Int, Int)) ->
-      case w of { I# ww -> T4908.$wf ww w1 }
+         Tmpl= \ (ds [Occ=Once1!] :: Int) (x [Occ=Once1] :: (Int, Int)) ->
+                 case ds of { I# ww [Occ=Once1] -> T4908.$wf ww x }}]
+f = \ (ds :: Int) (x :: (Int, Int)) ->
+      case ds of { I# ww -> T4908.$wf ww x }
 
 
 ------ Local rules for imported ids --------
diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr
index 3321809415..9da0009f84 100644
--- a/testsuite/tests/simplCore/should_compile/T4930.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4930.stderr
@@ -61,15 +61,15 @@ foo [InlPrag=[2]] :: Int -> Int
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (w [Occ=Once1!] :: Int) ->
-                 case w of { GHC.Types.I# ww [Occ=Once1] ->
+         Tmpl= \ (n [Occ=Once1!] :: Int) ->
+                 case n of { GHC.Types.I# ww [Occ=Once1] ->
                  case T4930.$wfoo ww of ww1 [Occ=Once1] { __DEFAULT ->
                  GHC.Types.I# ww1
                  }
                  }}]
 foo
-  = \ (w :: Int) ->
-      case w of { GHC.Types.I# ww ->
+  = \ (n :: Int) ->
+      case n of { GHC.Types.I# ww ->
       case T4930.$wfoo ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 }
       }
 
diff --git a/testsuite/tests/simplCore/should_compile/T5298.stdout b/testsuite/tests/simplCore/should_compile/T5298.stdout
index 67b106c3be..661e893028 100644
--- a/testsuite/tests/simplCore/should_compile/T5298.stdout
+++ b/testsuite/tests/simplCore/should_compile/T5298.stdout
@@ -6,8 +6,8 @@ $wg
         0# -> 1#
       }
 --
-g = \ w ->
-      case w of { I# ww -> case $wg ww of ww1 { __DEFAULT -> I# ww1 } }
+g = \ ds ->
+      case ds of { I# ww -> case $wg ww of ww1 { __DEFAULT -> I# ww1 } }
 
 
 ------ Local rules for imported ids --------
diff --git a/testsuite/tests/simplCore/should_compile/T8331.stderr b/testsuite/tests/simplCore/should_compile/T8331.stderr
index e84edead21..7219016651 100644
--- a/testsuite/tests/simplCore/should_compile/T8331.stderr
+++ b/testsuite/tests/simplCore/should_compile/T8331.stderr
@@ -16,7 +16,7 @@
                       ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) b))
 "SPEC $c>> @(ST s) _"
     forall (@s) (@r) ($dMonad :: Monad (ST s)).
-      $fMonadReaderT_$c>> @(ST s) @r $dMonad
+      $fMonadReaderT1 @(ST s) @r $dMonad
       = $fMonadAbstractIOSTReaderT_$s$c>> @s @r
 "SPEC $cliftA2 @(ST s) _"
     forall (@s) (@r) ($dApplicative :: Applicative (ST s)).
diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index 319eba03cb..2ba178e6bf 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -80,12 +80,12 @@ Roman.$wgo [InlPrag=[2]] :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [61 30] 249 0}]
 Roman.$wgo
-  = \ (w :: Maybe Int) (w1 :: Maybe Int) ->
-      case w1 of {
+  = \ (u :: Maybe Int) (ds :: Maybe Int) ->
+      case ds of {
         Nothing -> case Roman.foo3 of wild1 { };
         Just x ->
           case x of { GHC.Types.I# ipv ->
-          case w of {
+          case u of {
             Nothing -> Roman.foo_$s$wgo (GHC.Prim.*# 7# ipv) 10#;
             Just n ->
               case n of { GHC.Types.I# x2 ->
@@ -116,14 +116,14 @@ Roman.foo_go [InlPrag=[2]] :: Maybe Int -> Maybe Int -> Int
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (w [Occ=Once1] :: Maybe Int)
-                 (w1 [Occ=Once1] :: Maybe Int) ->
-                 case Roman.$wgo w w1 of ww [Occ=Once1] { __DEFAULT ->
+         Tmpl= \ (u [Occ=Once1] :: Maybe Int)
+                 (ds [Occ=Once1] :: Maybe Int) ->
+                 case Roman.$wgo u ds of ww [Occ=Once1] { __DEFAULT ->
                  GHC.Types.I# ww
                  }}]
 Roman.foo_go
-  = \ (w :: Maybe Int) (w1 :: Maybe Int) ->
-      case Roman.$wgo w w1 of ww { __DEFAULT -> GHC.Types.I# ww }
+  = \ (u :: Maybe Int) (ds :: Maybe Int) ->
+      case Roman.$wgo u ds of ww { __DEFAULT -> GHC.Types.I# ww }
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 Roman.foo2 :: Int
diff --git a/testsuite/tests/stranal/should_compile/T16029.stdout b/testsuite/tests/stranal/should_compile/T16029.stdout
index 2d1f2106f3..76bf2617fb 100644
--- a/testsuite/tests/stranal/should_compile/T16029.stdout
+++ b/testsuite/tests/stranal/should_compile/T16029.stdout
@@ -4,8 +4,8 @@
   :: GHC.Prim.Int# -> GHC.Prim.Int#
   = \ (ww :: GHC.Prim.Int#) ->
 g2 [InlPrag=[2]] :: T -> Int -> Int
-         Tmpl= \ (w [Occ=Once1!] :: T) (w1 [Occ=Once1!] :: Int) ->
-  = \ (w :: T) (w1 :: Int) ->
+         Tmpl= \ (ds [Occ=Once1!] :: T) (ds1 [Occ=Once1!] :: Int) ->
+  = \ (ds :: T) (ds1 :: Int) ->
 g1 [InlPrag=[2]] :: S -> Int -> Int
-         Tmpl= \ (w [Occ=Once1!] :: S) (w1 [Occ=Once1!] :: Int) ->
-  = \ (w :: S) (w1 :: Int) ->
+         Tmpl= \ (ds [Occ=Once1!] :: S) (ds1 [Occ=Once1!] :: Int) ->
+  = \ (ds :: S) (ds1 :: Int) ->
diff --git a/testsuite/tests/stranal/should_compile/T19766.hs b/testsuite/tests/stranal/should_compile/T19766.hs
new file mode 100644
index 0000000000..1062c57cc1
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T19766.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -O #-}
+
+module T19766 where
+
+data T a b = T !a !b
+
+data HasT = A (T Int Int) | B (T Int Int)
+
+getT :: HasT -> T Int Int
+getT (A t) = t
+getT (B t) = t
+
+f :: HasT -> [Int]
+f ht = case getT ht of t@(T _ _) -> reverse $ reverse $ reverse $ reverse $ reverse $ reverse $ lookupGRE t 15 [1,2,3,4]
+{-# NOINLINE f #-}
+
+lookupGRE :: T Int a -> Int -> [Int] -> [Int]
+lookupGRE ~(T n _) !k xs = [ x | x <- xs, x+k == n ]
+{-# NOINLINE lookupGRE #-}
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index f5ebbf289a..9a210ea165 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -66,6 +66,7 @@ test('T18894b',  [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppre
 test('T18982',  [ grep_errmsg(r'\$w. .*Int#$') ], compile, ['-dppr-cols=1000 -ddump-simpl -dsuppress-idinfo -dsuppress-uniques'])
 
 test('T19180', normal, compile, [''])
+test('T19766', [ grep_errmsg(r'absentError') ], compile, ['-ddump-worker-wrapper'])
 test('T19849', normal, compile, [''])
 test('T19882a', normal, compile, [''])
 test('T19882b', normal, compile, [''])