Don't mark lambda binders as OtherCon

We used to put OtherCon unfoldings on lambda binders of workers
and sometimes also join points/specializations with with the
assumption that since the wrapper would force these arguments
once we execute the RHS they would indeed be in WHNF.

This was wrong for reasons detailed in #21472. So now we purge
evaluated unfoldings from *all* lambda binders.

This fixes #21472, but at the cost of sometimes not using as efficient a
calling convention. It can also change inlining behaviour as some
occurances will no longer look like value arguments when they did
before.

As consequence we also change how we compute CBV information for
arguments slightly. We now *always* determine the CBV convention
for arguments during tidy. Earlier in the pipeline we merely mark
functions as candidates for having their arguments treated as CBV.

As before the process is described in the relevant notes:
Note [CBV Function Ids]
Note [Attaching CBV Marks to ids]
Note [Never put `OtherCon` unfoldigns on lambda binders]

-------------------------
Metric Decrease:
    T12425
    T13035
    T18223
    T18223
    T18923
    MultiLayerModulesTH_OneShot
Metric Increase:
    WWRec
-------------------------

2 files changed, 122 insertions, 50 deletions

diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
index 6135d02f9c..9fa38623a6 100644
--- a/compiler/GHC/Types/Id.hs
+++ b/compiler/GHC/Types/Id.hs
@@ -74,7 +74,7 @@ module GHC.Types.Id (
         isDataConWrapId, isDataConWrapId_maybe,
         isDataConId_maybe,
         idDataCon,
-        isConLikeId, isDeadEndId, idIsFrom,
+        isConLikeId, isWorkerLikeId, isDeadEndId, idIsFrom,
         hasNoBinding,
 
         -- ** Join variables
@@ -99,7 +99,7 @@ module GHC.Types.Id (
         idOccInfo,
 
         -- ** Writing 'IdInfo' fields
-        setIdUnfolding, setCaseBndrEvald,
+        setIdUnfolding, zapIdUnfolding, setCaseBndrEvald,
         setIdArity,
         setIdCallArity,
 
@@ -114,6 +114,7 @@ module GHC.Types.Id (
         setIdCbvMarks,
         idCbvMarks_maybe,
         idCbvMarkArity,
+        asWorkerLikeId, asNonWorkerLikeId,
 
         idDemandInfo,
         idDmdSig,
@@ -126,7 +127,7 @@ module GHC.Types.Id (
 import GHC.Prelude
 
 import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding,
-                 isCompulsoryUnfolding, Unfolding( NoUnfolding ), isEvaldUnfolding )
+                 isCompulsoryUnfolding, Unfolding( NoUnfolding ), isEvaldUnfolding, hasSomeUnfolding, noUnfolding )
 
 import GHC.Types.Id.Info
 import GHC.Types.Basic
@@ -537,6 +538,15 @@ isDataConId_maybe id = case Var.idDetails id of
                          DataConWrapId con -> Just con
                          _                 -> Nothing
 
+-- | An Id for which we might require all callers to pass strict arguments properly tagged + evaluated.
+--
+-- See Note [CBV Function Ids]
+isWorkerLikeId :: Id -> Bool
+isWorkerLikeId id = case Var.idDetails id of
+  WorkerLikeId _  -> True
+  JoinId _ Just{}   -> True
+  _                 -> False
+
 isJoinId :: Var -> Bool
 -- It is convenient in GHC.Core.Opt.SetLevels.lvlMFE to apply isJoinId
 -- to the free vars of an expression, so it's convenient
@@ -588,7 +598,7 @@ hasNoBinding id = case Var.idDetails id of
   -- in 'checkCanEtaExpand'.
   --
   -- In particular, calling 'idUnfolding' rather than 'realIdUnfolding' here can
-  -- force the 'uf_tmpl' field, because 'zapUnfolding' forces the 'uf_is_value' field,
+  -- force the 'uf_tmpl' field, because 'trimUnfolding' forces the 'uf_is_value' field,
   -- and this field is usually computed in terms of the 'uf_tmpl' field,
   -- so we will force that as well.
   --
@@ -640,16 +650,24 @@ asJoinId id arity = warnPprTrace (not (isLocalId id))
     is_vanilla_or_join id = case Var.idDetails id of
                               VanillaId -> True
                               -- Can workers become join ids? Yes!
-                              StrictWorkerId {} -> pprTraceDebug "asJoinId (strict worker)" (ppr id) True
+                              WorkerLikeId {} -> pprTraceDebug "asJoinId (call by value function)" (ppr id) True
                               JoinId {} -> True
                               _         -> False
 
 zapJoinId :: Id -> Id
 -- May be a regular id already
-zapJoinId jid | isJoinId jid = zapIdTailCallInfo (jid `setIdDetails` VanillaId)
+zapJoinId jid | isJoinId jid = zapIdTailCallInfo (newIdDetails `seq` jid `setIdDetails` newIdDetails)
                                  -- Core Lint may complain if still marked
                                  -- as AlwaysTailCalled
               | otherwise    = jid
+              where
+                newIdDetails = case idDetails jid of
+                  -- We treat join points as CBV functions. Even after they are floated out.
+                  -- See Note [Use CBV semantics only for join points and workers]
+                  JoinId _ (Just marks) -> WorkerLikeId marks
+                  JoinId _ Nothing      -> WorkerLikeId []
+                  _                     -> panic "zapJoinId: newIdDetails can only be used if Id was a join Id."
+
 
 asJoinId_maybe :: Id -> Maybe JoinArity -> Id
 asJoinId_maybe id (Just arity) = asJoinId id arity
@@ -749,15 +767,15 @@ setIdTagSig id sig = modifyIdInfo (`setTagSig` sig) id
 -- | If all marks are NotMarkedStrict we just set nothing.
 setIdCbvMarks :: Id -> [CbvMark] -> Id
 setIdCbvMarks id marks
-  | not (any isMarkedCbv marks) = maybeModifyIdDetails (removeMarks $ idDetails id) id
+  | not (any isMarkedCbv marks) = id
   | otherwise =
       -- pprTrace "setMarks:" (ppr id <> text ":" <> ppr marks) $
       case idDetails id of
         -- good ol (likely worker) function
-        VanillaId ->      id `setIdDetails` (StrictWorkerId trimmedMarks)
+        VanillaId ->      id `setIdDetails` (WorkerLikeId trimmedMarks)
         JoinId arity _ -> id `setIdDetails` (JoinId arity (Just trimmedMarks))
-        -- Updating an existing strict worker.
-        StrictWorkerId _ -> id `setIdDetails` (StrictWorkerId trimmedMarks)
+        -- Updating an existing call by value function.
+        WorkerLikeId _ -> id `setIdDetails` (WorkerLikeId trimmedMarks)
         -- Do nothing for these
         RecSelId{} -> id
         DFunId{} -> id
@@ -769,15 +787,15 @@ setIdCbvMarks id marks
       -- (Currently) no point in passing args beyond the arity unlifted.
       -- We would have to eta expand all call sites to (length marks).
       -- Perhaps that's sensible but for now be conservative.
-      trimmedMarks = take (idArity id) marks
-      removeMarks details = case details of
-        JoinId arity (Just _) -> Just $ JoinId arity Nothing
-        StrictWorkerId _ -> Just VanillaId
-        _ -> Nothing
+      -- Similarly we don't need any lazy marks at the end of the list.
+      -- This way the length of the list is always exactly number of arguments
+      -- that must be visible to CodeGen. See See Note [CBV Function Ids]
+      -- for more details.
+      trimmedMarks = dropWhileEndLE (not . isMarkedCbv) $ take (idArity id) marks
 
 idCbvMarks_maybe :: Id -> Maybe [CbvMark]
 idCbvMarks_maybe id = case idDetails id of
-  StrictWorkerId marks -> Just marks
+  WorkerLikeId marks -> Just marks
   JoinId _arity marks  -> marks
   _                    -> Nothing
 
@@ -786,6 +804,26 @@ idCbvMarks_maybe id = case idDetails id of
 idCbvMarkArity :: Id -> Arity
 idCbvMarkArity fn = maybe 0 length (idCbvMarks_maybe fn)
 
+-- | Remove any cbv marks on arguments from a given Id.
+asNonWorkerLikeId :: Id -> Id
+asNonWorkerLikeId id =
+  let details = case idDetails id of
+        WorkerLikeId{}      -> Just $ VanillaId
+        JoinId arity Just{}   -> Just $ JoinId arity Nothing
+        _                     -> Nothing
+  in maybeModifyIdDetails details id
+
+-- | Turn this id into a WorkerLikeId if possible.
+asWorkerLikeId :: Id -> Id
+asWorkerLikeId id =
+  let details = case idDetails id of
+        WorkerLikeId{}      -> Nothing
+        JoinId _arity Just{}  -> Nothing
+        JoinId arity Nothing  -> Just (JoinId arity (Just []))
+        VanillaId             -> Just $ WorkerLikeId []
+        _                     -> Nothing
+  in maybeModifyIdDetails details id
+
 setCaseBndrEvald :: StrictnessMark -> Id -> Id
 -- Used for variables bound by a case expressions, both the case-binder
 -- itself, and any pattern-bound variables that are argument of a
@@ -795,6 +833,12 @@ setCaseBndrEvald str id
   | isMarkedStrict str = id `setIdUnfolding` evaldUnfolding
   | otherwise          = id
 
+-- | Similar to trimUnfolding, but also removes evaldness info.
+zapIdUnfolding :: Id -> Id
+zapIdUnfolding v
+  | isId v, hasSomeUnfolding (idUnfolding v) = setIdUnfolding v noUnfolding
+  | otherwise = v
+
         ---------------------------------
         -- SPECIALISATION
 
diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs
index 77eb06f206..5834fa8b06 100644
--- a/compiler/GHC/Types/Id/Info.hs
+++ b/compiler/GHC/Types/Id/Info.hs
@@ -32,7 +32,7 @@ module GHC.Types.Id.Info (
         -- ** Zapping various forms of Info
         zapLamInfo, zapFragileInfo,
         zapDemandInfo, zapUsageInfo, zapUsageEnvInfo, zapUsedOnceInfo,
-        zapTailCallInfo, zapCallArityInfo, zapUnfolding,
+        zapTailCallInfo, zapCallArityInfo, trimUnfolding,
 
         -- ** The ArityInfo type
         ArityInfo,
@@ -174,31 +174,37 @@ data IdDetails
   | JoinId JoinArity (Maybe [CbvMark])
         -- ^ An 'Id' for a join point taking n arguments
         -- Note [Join points] in "GHC.Core"
-        -- Can also work as a StrictWorkerId if given `CbvMark`s.
-        -- See Note [Strict Worker Ids]
-  | StrictWorkerId [CbvMark]
-        -- ^ An 'Id' for a worker function, which expects some arguments to be
+        -- Can also work as a WorkerLikeId if given `CbvMark`s.
+        -- See Note [CBV Function Ids]
+        -- The [CbvMark] is always empty (and ignored) until after Tidy.
+  | WorkerLikeId [CbvMark]
+        -- ^ An 'Id' for a worker like function, which might expect some arguments to be
         -- passed both evaluated and tagged.
-        -- See Note [Strict Worker Ids]
+        -- Worker like functions are create by W/W and SpecConstr and we can expect that they
+        -- aren't used unapplied.
+        -- See Note [CBV Function Ids]
         -- See Note [Tag Inference]
+        -- The [CbvMark] is always empty (and ignored) until after Tidy for ids from the current
+        -- module.
 
-{- Note [Strict Worker Ids]
+{- Note [CBV Function Ids]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-A StrictWorkerId essentially constrains the calling convention for the given Id.
-It requires arguments marked as `MarkedCbv` to be passed evaluated+*properly tagged*.
+A WorkerLikeId essentially allows us to constrain the calling convention
+for the given Id. Each such Id carries with it a list of CbvMarks
+with each element representing a value argument. Arguments who have
+a matching `MarkedCbv` entry in the list need to be passed evaluated+*properly tagged*.
 
-While we were always able to express the fact that an argument is evaluated once we
-entered it's RHS via attaching a evaldUnfolding to it there used to be
-no way to express that an lifted argument is already properly tagged once we jump
-into the RHS.
-This means when branching on a value the RHS always needed to perform
-a tag check to ensure the argument wasn't an indirection (the evaldUnfolding
-already ruling out thunks).
-
-StrictWorkerIds give us this additional expressiveness which we use to improve
+CallByValueFunIds give us additional expressiveness which we use to improve
 runtime. This is all part of the TagInference work. See also Note [Tag Inference].
 
-The invariants around the arguments of Strict Worker Ids are then:
+They allows us to express the fact that an argument is not only evaluated to WHNF once we
+entered it's RHS but also that an lifted argument is already *properly tagged* once we jump
+into the RHS.
+This means when e.g. branching on such an argument the RHS doesn't needed to perform
+an eval check to ensure the argument isn't an indirection. All seqs on such an argument in
+the functions body become no-ops as well.
+
+The invariants around the arguments of call by value function like Ids are then:
 
 * In any call `(f e1 .. en)`, if `f`'s i'th argument is marked `MarkedCbv`,
   then the caller must ensure that the i'th argument
@@ -206,19 +212,25 @@ The invariants around the arguments of Strict Worker Ids are then:
   * is a properly tagged pointer to that value
 
 * The following functions (and only these functions) have `CbvMarks`:
-  * Any `StrictWorkerId`
+  * Any `WorkerLikeId`
   * Some `JoinId` bindings.
 
 This works analogous to the Strict Field Invariant. See also Note [Strict Field Invariant].
 
 To make this work what we do is:
-* If we think a function might benefit from passing certain arguments unlifted
-  for performance reasons we attach an evaldUnfolding to these arguments.
-* Either during W/W, but at latest during Tidy VanillaIds with arguments that
-  have evaldUnfoldings are turned into StrictWorkerIds.
-* During CorePrep calls to StrictWorkerIds are eta expanded.
+* During W/W and SpecConstr any worker/specialized binding we introduce
+  is marked as a worker binding by `asWorkerLikeId`.
+* W/W and SpecConstr further set OtherCon[] unfoldings on arguments which
+  represent contents of a strict fields.
+* During Tidy we look at all bindings.
+  For any callByValueLike Id and join point we mark arguments as cbv if they
+  Are strict. We don't do so for regular bindings.
+  See Note [Use CBV semantics only for join points and workers] for why.
+  We might have made some ids rhs *more* strict in order to make their arguments
+  be passed CBV. See Note [Call-by-value for worker args] for why.
+* During CorePrep calls to CallByValueFunIds are eta expanded.
 * During Stg CodeGen:
-  * When we call a binding that is a StrictWorkerId:
+  * When we see a call to a callByValueLike Id:
     * We check if all arguments marked to be passed unlifted are already tagged.
     * If they aren't we will wrap the call in case expressions which will evaluate+tag
       these arguments before jumping to the function.
@@ -226,10 +238,9 @@ To make this work what we do is:
   * When generating code for the RHS of a StrictWorker binding
     we omit tag checks when using arguments marked as tagged.
 
-We primarily use this for workers where we mark strictly demanded arguments
-and arguments representing strict fields as call-by-value during W/W. But we
-also check other functions during tidy and potentially turn some of them into
-strict workers and mark some of their arguments as call-by-value by looking at
+We only use this for workers and specialized versions of SpecConstr
+But we also check other functions during tidy and potentially turn some of them into
+call by value functions and mark some of their arguments as call-by-value by looking at
 argument unfoldings.
 
 NB: I choose to put the information into a new Id constructor since these are loaded
@@ -238,6 +249,23 @@ calling convention demands are available at all call sites. Putting it into
 IdInfo would require us at the very least to always decode the IdInfo
 just to decide if we need to throw it away or not after.
 
+Note [Use CBV semantics only for join points and workers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A function with cbv-semantics requires arguments to be visible
+and if no arguments are visible requires us to eta-expand it's
+call site. That is for a binding with three cbv arguments like
+`w[WorkerLikeId[!,!,!]]` we would need to eta expand undersaturated
+occurences like `map w xs` into `map (\x1 x2 x3 -> w x1 x2 x3) xs.
+
+In experiments it turned out that the code size increase of doing so
+can outweigh the performance benefits of doing so.
+So we only do this for join points, workers and
+specialized functions (from SpecConstr).
+Join points are naturally always called saturated so
+this problem can't occur for them.
+For workers and specialized functions there are also always at least
+some applied arguments as we won't inline the wrapper/apply their rule
+if there are unapplied occurances like `map f xs`.
 -}
 
 -- | Recursive Selector Parent
@@ -274,7 +302,7 @@ pprIdDetails VanillaId = empty
 pprIdDetails other     = brackets (pp other)
  where
    pp VanillaId               = panic "pprIdDetails"
-   pp (StrictWorkerId dmds)   = text "StrictWorker" <> parens (ppr dmds)
+   pp (WorkerLikeId dmds)   = text "StrictWorker" <> parens (ppr dmds)
    pp (DataConWorkId _)       = text "DataCon"
    pp (DataConWrapId _)       = text "DataConWrapper"
    pp (ClassOpId {})          = text "ClassOp"
@@ -439,7 +467,7 @@ setOccInfo        info oc = oc `seq` info { occInfo = oc }
 -- will inline.
 unfoldingInfo :: IdInfo -> Unfolding
 unfoldingInfo info
-  | isStrongLoopBreaker (occInfo info) = zapUnfolding $ realUnfoldingInfo info
+  | isStrongLoopBreaker (occInfo info) = trimUnfolding $ realUnfoldingInfo info
   | otherwise                          =                realUnfoldingInfo info
 
 setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
@@ -784,9 +812,9 @@ zapFragileUnfolding unf
  | isEvaldUnfolding unf = evaldUnfolding
  | otherwise            = noUnfolding
 
-zapUnfolding :: Unfolding -> Unfolding
+trimUnfolding :: Unfolding -> Unfolding
 -- Squash all unfolding info, preserving only evaluated-ness
-zapUnfolding unf | isEvaldUnfolding unf = evaldUnfolding
+trimUnfolding unf | isEvaldUnfolding unf = evaldUnfolding
                  | otherwise            = noUnfolding
 
 zapTailCallInfo :: IdInfo -> Maybe IdInfo