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.

10 files changed, 31 insertions, 31 deletions

diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index 666725f320..26a46321b4 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/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)
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index d1ca3e3f9c..6c7379faa2 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/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
 
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index 58ac9f4c62..18b4d848e1 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/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
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index cc3159d646..f1791dfebf 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/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)
diff --git a/compiler/GHC/Core/Seq.hs b/compiler/GHC/Core/Seq.hs
index 129b87f932..0addae9775 100644
--- a/compiler/GHC/Core/Seq.hs
+++ b/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`
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index 67dc4609c3..16906df1c1 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/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
diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs
index 3d93084fc4..36f3bad0d4 100644
--- a/compiler/GHC/Core/Subst.hs
+++ b/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)
 
 ------------------
diff --git a/compiler/GHC/Core/Tidy.hs b/compiler/GHC/Core/Tidy.hs
index 933e8714c4..aaf42eafd2 100644
--- a/compiler/GHC/Core/Tidy.hs
+++ b/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]
diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs
index fc05566d9f..4e054ea709 100644
--- a/compiler/GHC/Core/Unfold.hs
+++ b/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.)
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index a9a8769259..a120bed3b0 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/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]]