Simplifier: Do Cast W/W for INLINE strong loop-breakers

Strong loop-breakers never inline, INLINE pragma or not.
Hence they should be treated as if there was no INLINE pragma on them.

Also not doing Cast W/W for INLINE strong loop-breakers will trip up Strictness
W/W, because it treats them as if there was no INLINE pragma. Subsequently,
that will lead to a panic once Strictness W/W will no longer do eta-expansion,
as we discovered while implementing !5814.

I also renamed to `unfoldingInfo` to `realUnfoldingInfo` and redefined
`unfoldingInfo` to zap the unfolding it returns in case of a strong loop-breaker.
Now the naming and semantics is symmetrical to `idUnfolding`/`realIdUnfolding`.

Now there was no more reason for `hasInlineUnfolding` to operate on `Id`,
because the zapping of strong loop-breaker unfoldings moved from `idUnfolding`
to `unfoldingInfo`, so I refactored it to take `IdInfo` and call it both from
the Simplifier and WorkWrap, making it utterly clear that both checks are
equivalent.

compiler/GHC/Core/Opt/Pipeline.hs

@@ -1007,7 +1007,7 @@ hasShortableIdInfo :: Id -> Bool
 hasShortableIdInfo id
   =  isEmptyRuleInfo (ruleInfo info)
   && isDefaultInlinePragma (inlinePragInfo info)
-  && not (isStableUnfolding (unfoldingInfo info))
+  && not (isStableUnfolding (realUnfoldingInfo info))
   where
      info = idInfo id
 
@@ -1048,7 +1048,7 @@ transferIdInfo exported_id local_id
     local_info = idInfo local_id
     transfer exp_info = exp_info `setDmdSigInfo`     dmdSigInfo local_info
                                  `setCprSigInfo`     cprSigInfo local_info
-                                 `setUnfoldingInfo`  unfoldingInfo local_info
+                                 `setUnfoldingInfo`  realUnfoldingInfo local_info
                                  `setInlinePragInfo` inlinePragInfo local_info
                                  `setRuleInfo`       addRuleInfo (ruleInfo exp_info) new_info
     new_info = setRuleInfoHead (idName exported_id)

compiler/GHC/Core/Opt/Simplify.hs

@@ -544,14 +544,17 @@ Wrinkles
    Notice that the stable unfolding moves to the worker!  Now demand analysis
    will work fine on $wf, whereas it has trouble with the original f.
    c.f. Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap.
+   This point also applies to strong loopbreakers with INLINE pragmas, see
+   wrinkle (4).
 
-4. We should /not/ do cast w/w for INLINE functions (hence isInlineUnfolding in
-   tryCastWorkerWrapper) becuase they'll be inlined, cast and all anyway. And
-   if we do cast w/w for an INLINE function with arity zero, we get something
-   really silly: we inline that "worker" right back into the wrapper! Worse than
-   a no-op, because we haev then lost the stable unfolding.
+4. We should /not/ do cast w/w for non-loop-breaker INLINE functions (hence
+   hasInlineUnfolding in tryCastWorkerWrapper, which responds False to
+   loop-breakers) because they'll definitely be inlined anyway, cast and
+   all. And if we do cast w/w for an INLINE function with arity zero, we get
+   something really silly: we inline that "worker" right back into the wrapper!
+   Worse than a no-op, because we have then lost the stable unfolding.
 
-Both these wrinkles are exactly like worker/wrapper for strictness analysis:
+All these wrinkles are exactly like worker/wrapper for strictness analysis:
   f is the wrapper and must inline like crazy
   $wf is the worker and must carry f's original pragma
 See Note [Worker/wrapper for INLINABLE functions]
@@ -600,10 +603,10 @@ tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co)
   | not (isJoinId bndr) -- Not for join points
   , not (isDFunId bndr) -- nor DFuns; cast w/w is no help, and we can't transform
                         --            a DFunUnfolding in mk_worker_unfolding
-  , not (exprIsTrivial rhs)      -- Not x = y |> co; Wrinkle 1
-  , not (isInlineUnfolding unf)  -- Not INLINE things: Wrinkle 4
-  , not (isUnliftedType rhs_ty)  -- Not if rhs has an unlifted type;
-                                 --     see Note [Cast w/w: unlifted]
+  , not (exprIsTrivial rhs)        -- Not x = y |> co; Wrinkle 1
+  , not (hasInlineUnfolding info)  -- Not INLINE things: Wrinkle 4
+  , not (isUnliftedType rhs_ty)    -- Not if rhs has an unlifted type;
+                                   --     see Note [Cast w/w: unlifted]
   = do  { (rhs_floats, work_rhs) <- prepareRhs mode top_lvl occ_fs rhs
         ; uniq <- getUniqueM
         ; let work_name = mkSystemVarName uniq occ_fs
@@ -637,7 +640,6 @@ tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co)
     occ_fs = getOccFS bndr
     rhs_ty = coercionLKind co
     info   = idInfo bndr
-    unf    = unfoldingInfo info
 
     worker_info = vanillaIdInfo `setDmdSigInfo`     dmdSigInfo info
                                 `setCprSigInfo`     cprSigInfo info
@@ -654,8 +656,8 @@ tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co)
     -- Non-stable case: use work_rhs
     -- Wrinkle 3 of Note [Cast worker/wrapper]
     mk_worker_unfolding work_id work_rhs
-      = case unf of
-           CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src }
+      = case realUnfoldingInfo info of -- NB: the real one, even for loop-breakers
+           unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
              | isStableSource src -> return (unf { uf_tmpl = mkCast unf_rhs (mkSymCo co) })
            _ -> mkLetUnfolding (sm_uf_opts mode) top_lvl InlineRhs work_id work_rhs
 
@@ -895,7 +897,7 @@ completeBind env top_lvl mb_cont old_bndr new_bndr new_rhs
  | otherwise
  = assert (isId new_bndr) $
    do { let old_info = idInfo old_bndr
-            old_unf  = unfoldingInfo old_info
+            old_unf  = realUnfoldingInfo old_info
             occ_info = occInfo old_info
             mode     = getMode env
 

compiler/GHC/Core/Opt/WorkWrap.hs

@@ -517,7 +517,7 @@ tryWW ww_opts is_rec fn_id rhs
   = return [(new_fn_id, filler)]
 
   -- See Note [Don't w/w INLINE things]
-  | hasInlineUnfolding fn_id
+  | hasInlineUnfolding fn_info
   = return [(new_fn_id, rhs)]
 
   -- See Note [No worker/wrapper for record selectors]
@@ -800,7 +800,7 @@ mkWWBindPair ww_opts fn_id fn_info rhs work_uniq div cpr
 
     fn_inl_prag     = inlinePragInfo fn_info
     fn_inline_spec  = inl_inline fn_inl_prag
-    fn_unfolding    = unfoldingInfo fn_info
+    fn_unfolding    = realUnfoldingInfo fn_info
 
     -- Even if we don't w/w join points for CPR, we might still do so for
     -- strictness. In which case a join point worker keeps its original CPR

compiler/GHC/Core/Ppr.hs

@@ -426,7 +426,7 @@ pprTypedLamBinder bind_site debug_on var
                                    2 (vcat [ dcolon <+> pprType (idType var)
                                            , pp_unf]))
   where
-    unf_info = unfoldingInfo (idInfo var)
+    unf_info = realUnfoldingInfo (idInfo var)
     pp_unf | hasSomeUnfolding unf_info = text "Unf=" <> ppr unf_info
            | otherwise                 = empty
 
@@ -510,7 +510,7 @@ instance Outputable IdInfo where
       str_info = dmdSigInfo info
       has_str_info = not (isTopSig str_info)
 
-      unf_info = unfoldingInfo info
+      unf_info = realUnfoldingInfo info
       has_unf = hasSomeUnfolding unf_info
 
       rules = ruleInfoRules (ruleInfo info)
@@ -557,7 +557,7 @@ ppIdInfo id info
     cpr_info = cprSigInfo info
     has_cpr_info = cpr_info /= topCprSig
 
-    unf_info = unfoldingInfo info
+    unf_info = realUnfoldingInfo info
     has_unf = hasSomeUnfolding unf_info
 
     rules = ruleInfoRules (ruleInfo info)

compiler/GHC/Core/Seq.hs

@@ -32,7 +32,7 @@ megaSeqIdInfo info
 
 -- Omitting this improves runtimes a little, presumably because
 -- some unfoldings are not calculated at all
---    seqUnfolding (unfoldingInfo info)         `seq`
+--    seqUnfolding (realUnfoldingInfo info)         `seq`
 
     seqDemand (demandInfo info)                 `seq`
     seqDmdSig (dmdSigInfo info)          `seq`

compiler/GHC/Core/SimpleOpt.hs

@@ -33,7 +33,7 @@ import GHC.Core.Make ( FloatBind(..) )
 import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm )
 import GHC.Types.Literal
 import GHC.Types.Id
-import GHC.Types.Id.Info  ( unfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) )
+import GHC.Types.Id.Info  ( realUnfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) )
 import GHC.Types.Var      ( isNonCoVarId )
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
@@ -667,7 +667,7 @@ add_info env old_bndr top_level new_rhs new_bndr
    old_rules = ruleInfo old_info
    new_rules = substSpec subst new_bndr old_rules
 
-   old_unfolding = unfoldingInfo old_info
+   old_unfolding = realUnfoldingInfo old_info
    new_unfolding | isStableUnfolding old_unfolding
                  = substUnfolding subst old_unfolding
                  | otherwise

compiler/GHC/Core/Subst.hs

@@ -626,7 +626,7 @@ substIdInfo subst new_id info
                                `setUnfoldingInfo` substUnfolding subst old_unf)
   where
     old_rules     = ruleInfo info
-    old_unf       = unfoldingInfo info
+    old_unf       = realUnfoldingInfo info
     nothing_to_do = isEmptyRuleInfo old_rules && not (hasCoreUnfolding old_unf)
 
 ------------------

compiler/GHC/Core/Tidy.hs

@@ -161,7 +161,7 @@ tidyIdBndr env@(tidy_env, var_env) id
                                   -- see Note [Preserve OneShotInfo]
                                  `setOneShotInfo` oneShotInfo old_info
         old_info = idInfo id
-        old_unf  = unfoldingInfo old_info
+        old_unf  = realUnfoldingInfo old_info
         new_unf  = zapUnfolding old_unf  -- See Note [Preserve evaluatedness]
     in
     ((tidy_env', var_env'), id')
@@ -211,7 +211,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id
                     `setInlinePragInfo` inlinePragInfo old_info
                     `setUnfoldingInfo`  new_unf
 
-        old_unf = unfoldingInfo old_info
+        old_unf = realUnfoldingInfo old_info
         new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf
                 | otherwise                 = zapUnfolding old_unf
                                               -- See Note [Preserve evaluatedness]

compiler/GHC/Core/Unfold.hs

@@ -967,7 +967,6 @@ certainlyWillInline :: UnfoldingOpts -> IdInfo -> Maybe Unfolding
 certainlyWillInline opts fn_info
   = case fn_unf of
       CoreUnfolding { uf_tmpl = expr, uf_guidance = guidance, uf_src = src }
-        | loop_breaker -> Nothing       -- Won't inline, so try w/w
         | noinline     -> Nothing       -- See Note [Worker/wrapper for NOINLINE functions]
         | otherwise
         -> case guidance of
@@ -989,9 +988,8 @@ certainlyWillInline opts fn_info
       _other_unf       -> Nothing
 
   where
-    loop_breaker = isStrongLoopBreaker (occInfo fn_info)
     noinline     = inlinePragmaSpec (inlinePragInfo fn_info) == NoInline
-    fn_unf       = unfoldingInfo fn_info
+    fn_unf       = unfoldingInfo fn_info -- NB: loop-breakers never inline
 
         -- The UnfIfGoodArgs case seems important.  If we w/w small functions
         -- binary sizes go up by 10%!  (This is with SplitObjs.)

compiler/GHC/Core/Utils.hs

@@ -2282,7 +2282,7 @@ diffIdInfo env bndr1 bndr2
     && callArityInfo info1 == callArityInfo info2
     && levityInfo info1 == levityInfo info2
   = locBind "in unfolding of" bndr1 bndr2 $
-    diffUnfold env (unfoldingInfo info1) (unfoldingInfo info2)
+    diffUnfold env (realUnfoldingInfo info1) (realUnfoldingInfo info2)
   | otherwise
   = locBind "in Id info of" bndr1 bndr2
     [fsep [pprBndr LetBind bndr1, text "/=", pprBndr LetBind bndr2]]

compiler/GHC/CoreToIface.hs

@@ -483,7 +483,7 @@ toIfaceIdInfo id_info
     cpr_hsinfo | cpr_info /= topCprSig = Just (HsCprSig cpr_info)
                | otherwise             = Nothing
     ------------  Unfolding  --------------
-    unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
+    unfold_hsinfo = toIfUnfolding loop_breaker (realUnfoldingInfo id_info)
     loop_breaker  = isStrongLoopBreaker (occInfo id_info)
 
     ------------  Inline prag  --------------

compiler/GHC/Iface/Tidy.hs

@@ -792,7 +792,7 @@ addExternal omit_prags expose_all id
   where
     new_needed_ids = bndrFvsInOrder show_unfold id
     idinfo         = idInfo id
-    unfolding      = unfoldingInfo idinfo
+    unfolding      = realUnfoldingInfo idinfo
     show_unfold    = show_unfolding unfolding
     never_active   = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
     loop_breaker   = isStrongLoopBreaker (occInfo idinfo)
@@ -916,7 +916,7 @@ dffvLetBndr :: Bool -> Id -> DFFV ()
 -- For top-level bindings (call from addExternal, via bndrFvsInOrder)
 --       we say "True" if we are exposing that unfolding
 dffvLetBndr vanilla_unfold id
-  = do { go_unf (unfoldingInfo idinfo)
+  = do { go_unf (realUnfoldingInfo idinfo)
        ; mapM_ go_rule (ruleInfoRules (ruleInfo idinfo)) }
   where
     idinfo = idInfo id
@@ -1306,7 +1306,7 @@ tidyTopIdInfo uf_opts rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold
                                   Just (arity, _) -> not (appIsDeadEnd id_sig arity)
 
     --------- Unfolding ------------
-    unf_info = unfoldingInfo idinfo
+    unf_info = realUnfoldingInfo idinfo
     unfold_info
       | isCompulsoryUnfolding unf_info || show_unfold
       = tidyUnfolding rhs_tidy_env unf_info unf_from_rhs

compiler/GHC/Types/Id.hs

@@ -94,7 +94,7 @@ module GHC.Types.Id (
         -- ** Reading 'IdInfo' fields
         idArity,
         idCallArity, idFunRepArity,
-        idUnfolding, realIdUnfolding, hasInlineUnfolding,
+        idUnfolding, realIdUnfolding,
         idSpecialisation, idCoreRules, idHasRules,
         idCafInfo, idLFInfo_maybe,
         idOneShotInfo, idStateHackOneShotInfo,
@@ -124,8 +124,7 @@ module GHC.Types.Id (
 import GHC.Prelude
 
 import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding,
-                 isCompulsoryUnfolding, isInlineUnfolding,
-                 Unfolding( NoUnfolding ) )
+                 isCompulsoryUnfolding, Unfolding( NoUnfolding ) )
 
 import GHC.Types.Id.Info
 import GHC.Types.Basic
@@ -711,25 +710,19 @@ isStrictId id
                   isStrUsedDmd (idDemandInfo id)
                   -- Take the best of both strictnesses - old and new
 
-        ---------------------------------
-        -- UNFOLDING
-idUnfolding :: Id -> Unfolding
--- Do not expose the unfolding of a loop breaker!
-idUnfolding id
-  | isStrongLoopBreaker (occInfo info) = NoUnfolding
-  | otherwise                          = unfoldingInfo info
-  where
-    info = idInfo id
+---------------------------------
+-- UNFOLDING
 
-hasInlineUnfolding :: Id -> Bool
--- ^ True of a non-loop-breaker Id that has a /stable/ unfolding that is
---   (a) always inlined; that is, with an `UnfWhen` guidance, or
---   (b) a DFunUnfolding which never needs to be inlined
-hasInlineUnfolding id = isInlineUnfolding (idUnfolding id)
+-- | Returns the 'Id's unfolding, but does not expose the unfolding of a strong
+-- loop breaker. See 'unfoldingInfo'.
+--
+-- If you really want the unfolding of a strong loopbreaker, call 'realIdUnfolding'.
+idUnfolding :: Id -> Unfolding
+idUnfolding id = unfoldingInfo (idInfo id)
 
 realIdUnfolding :: Id -> Unfolding
--- Expose the unfolding if there is one, including for loop breakers
-realIdUnfolding id = unfoldingInfo (idInfo id)
+-- ^ Expose the unfolding if there is one, including for loop breakers
+realIdUnfolding id = realUnfoldingInfo (idInfo id)
 
 setIdUnfolding :: Id -> Unfolding -> Id
 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id

compiler/GHC/Types/Id/Info.hs

@@ -47,7 +47,7 @@ module GHC.Types.Id.Info (
         demandInfo, setDemandInfo, pprStrictness,
 
         -- ** Unfolding Info
-        unfoldingInfo, setUnfoldingInfo,
+        realUnfoldingInfo, unfoldingInfo, setUnfoldingInfo, hasInlineUnfolding,
 
         -- ** The InlinePragInfo type
         InlinePragInfo,
@@ -255,7 +255,7 @@ data IdInfo
         ruleInfo        :: RuleInfo,
         -- ^ Specialisations of the 'Id's function which exist.
         -- See Note [Specialisations and RULES in IdInfo]
-        unfoldingInfo   :: Unfolding,
+        realUnfoldingInfo   :: Unfolding,
         -- ^ The 'Id's unfolding
         inlinePragInfo  :: InlinePragma,
         -- ^ Any inline pragma attached to the 'Id'
@@ -377,13 +377,29 @@ setOccInfo :: IdInfo -> OccInfo -> IdInfo
 setOccInfo        info oc = oc `seq` info { occInfo = oc }
         -- Try to avoid space leaks by seq'ing
 
+-- | Essentially returns the 'realUnfoldingInfo' field, but does not expose the
+-- unfolding of a strong loop breaker.
+--
+-- This is the right thing to call if you plan to decide whether an unfolding
+-- will inline.
+unfoldingInfo :: IdInfo -> Unfolding
+unfoldingInfo info
+  | isStrongLoopBreaker (occInfo info) = zapUnfolding $ realUnfoldingInfo info
+  | otherwise                          =                realUnfoldingInfo info
+
 setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
 setUnfoldingInfo info uf
   = -- We don't seq the unfolding, as we generate intermediate
     -- unfoldings which are just thrown away, so evaluating them is a
     -- waste of time.
     -- seqUnfolding uf `seq`
-    info { unfoldingInfo = uf }
+    info { realUnfoldingInfo = uf }
+
+hasInlineUnfolding :: IdInfo -> Bool
+-- ^ True of a /non-loop-breaker/ Id that has a /stable/ unfolding that is
+--   (a) always inlined; that is, with an `UnfWhen` guidance, or
+--   (b) a DFunUnfolding which never needs to be inlined
+hasInlineUnfolding info = isInlineUnfolding (unfoldingInfo info)
 
 setArityInfo :: IdInfo -> ArityInfo -> IdInfo
 setArityInfo info ar =
@@ -418,7 +434,7 @@ vanillaIdInfo :: IdInfo
 vanillaIdInfo
   = IdInfo {
             ruleInfo       = emptyRuleInfo,
-            unfoldingInfo  = noUnfolding,
+            realUnfoldingInfo  = noUnfolding,
             inlinePragInfo = defaultInlinePragma,
             occInfo        = noOccInfo,
             demandInfo     = topDmd,
@@ -659,7 +675,7 @@ zapUsedOnceInfo info
 
 zapFragileInfo :: IdInfo -> Maybe IdInfo
 -- ^ Zap info that depends on free variables
-zapFragileInfo info@(IdInfo { occInfo = occ, unfoldingInfo = unf })
+zapFragileInfo info@(IdInfo { occInfo = occ, realUnfoldingInfo = unf })
   = new_unf `seq`  -- The unfolding field is not (currently) strict, so we
                    -- force it here to avoid a (zapFragileUnfolding unf) thunk
                    -- which might leak space