Refactor UnfoldingSource and IfaceUnfolding

I finally got tired of the way that IfaceUnfolding reflected
a previous structure of unfoldings, not the current one. This
MR refactors UnfoldingSource and IfaceUnfolding to be simpler
and more consistent.

It's largely just a refactor, but in UnfoldingSource (which moves
to GHC.Types.Basic, since it is now used in IfaceSyn too), I
distinguish between /user-specified/ and /system-generated/ stable
unfoldings.

    data UnfoldingSource
      = VanillaSrc
      | StableUserSrc   -- From a user-specified pragma
      | StableSystemSrc -- From a system-generated unfolding
      | CompulsorySrc

This has a minor effect in CSE (see the use of isisStableUserUnfolding
in GHC.Core.Opt.CSE), which I tripped over when working on
specialisation, but it seems like a Good Thing to know anyway.

38 files changed, 359 insertions, 366 deletions

diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index 664e8cac43..c1ed8d741d 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -65,7 +65,8 @@ module GHC.Core (
         maybeUnfoldingTemplate, otherCons,
         isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
         isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
-        isStableUnfolding, isInlineUnfolding, isBootUnfolding,
+        isStableUnfolding, isStableUserUnfolding, isStableSystemUnfolding,
+        isInlineUnfolding, isBootUnfolding,
         hasCoreUnfolding, hasSomeUnfolding,
         canUnfold, neverUnfoldGuidance, isStableSource,
 
@@ -1338,36 +1339,6 @@ data Unfolding
 
 
 ------------------------------------------------
-data UnfoldingSource
-  = -- See also Note [Historical note: unfoldings for wrappers]
-
-    InlineRhs          -- The current rhs of the function
-                       -- Replace uf_tmpl each time around
-
-  | InlineStable       -- From an INLINE or INLINABLE pragma
-                       --   INLINE     if guidance is UnfWhen
-                       --   INLINABLE  if guidance is UnfIfGoodArgs/UnfoldNever
-                       -- (well, technically an INLINABLE might be made
-                       -- UnfWhen if it was small enough, and then
-                       -- it will behave like INLINE outside the current
-                       -- module, but that is the way automatic unfoldings
-                       -- work so it is consistent with the intended
-                       -- meaning of INLINABLE).
-                       --
-                       -- uf_tmpl may change, but only as a result of
-                       -- gentle simplification, it doesn't get updated
-                       -- to the current RHS during compilation as with
-                       -- InlineRhs.
-                       --
-                       -- See Note [InlineStable]
-
-  | InlineCompulsory   -- Something that *has* no binding, so you *must* inline it
-                       -- Only a few primop-like things have this property
-                       -- (see "GHC.Types.Id.Make", calls to mkCompulsoryUnfolding).
-                       -- Inline absolutely always, however boring the context.
-
-
-
 -- | 'UnfoldingGuidance' says when unfolding should take place
 data UnfoldingGuidance
   = UnfWhen {   -- Inline without thinking about the *size* of the uf_tmpl
@@ -1472,12 +1443,6 @@ bootUnfolding = BootUnfolding
 mkOtherCon :: [AltCon] -> Unfolding
 mkOtherCon = OtherCon
 
-isStableSource :: UnfoldingSource -> Bool
--- Keep the unfolding template
-isStableSource InlineCompulsory   = True
-isStableSource InlineStable       = True
-isStableSource InlineRhs          = False
-
 -- | Retrieves the template of an unfolding: panics if none is known
 unfoldingTemplate :: Unfolding -> CoreExpr
 unfoldingTemplate = uf_tmpl
@@ -1542,8 +1507,8 @@ expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) =
 expandUnfolding_maybe _                                                       = Nothing
 
 isCompulsoryUnfolding :: Unfolding -> Bool
-isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
-isCompulsoryUnfolding _                                             = False
+isCompulsoryUnfolding (CoreUnfolding { uf_src = src }) = isCompulsorySource src
+isCompulsoryUnfolding _                                = False
 
 isStableUnfolding :: Unfolding -> Bool
 -- True of unfoldings that should not be overwritten
@@ -1552,6 +1517,16 @@ isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
 isStableUnfolding (DFunUnfolding {})               = True
 isStableUnfolding _                                = False
 
+isStableUserUnfolding :: Unfolding -> Bool
+-- True of unfoldings that arise from an INLINE or INLINEABLE pragma
+isStableUserUnfolding (CoreUnfolding { uf_src = src }) = isStableUserSource src
+isStableUserUnfolding _                                = False
+
+isStableSystemUnfolding :: Unfolding -> Bool
+-- True of unfoldings that arise from an INLINE or INLINEABLE pragma
+isStableSystemUnfolding (CoreUnfolding { uf_src = src }) = isStableSystemSource src
+isStableSystemUnfolding _                                = False
+
 isInlineUnfolding :: Unfolding -> Bool
 -- ^ True of a /stable/ unfolding that is
 --   (a) always inlined; that is, with an `UnfWhen` guidance, or
@@ -1608,8 +1583,8 @@ ones are
 
 We consider even a StableUnfolding as fragile, because it needs substitution.
 
-Note [InlineStable]
-~~~~~~~~~~~~~~~~~
+Note [Stable unfoldings]
+~~~~~~~~~~~~~~~~~~~~~~~~
 When you say
       {-# INLINE f #-}
       f x = <rhs>
@@ -1619,10 +1594,11 @@ with it.  Meanwhile, we can optimise <rhs> to our heart's content,
 leaving the original unfolding intact in Unfolding of 'f'. For example
         all xs = foldr (&&) True xs
         any p = all . map p  {-# INLINE any #-}
-We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
-which deforests well at the call site.
+We optimise any's RHS fully, but leave the stable unfolding for `any`
+saying "all . map p", which deforests well at the call site.
 
-So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
+So INLINE pragma gives rise to a stable unfolding, which captures the
+original RHS.
 
 Moreover, it's only used when 'f' is applied to the
 specified number of arguments; that is, the number of argument on
@@ -1636,9 +1612,6 @@ on the left, thus
 it'd only inline when applied to three arguments.  This slightly-experimental
 change was requested by Roman, but it seems to make sense.
 
-See also Note [Inlining an InlineRule] in GHC.Core.Unfold.
-
-
 Note [OccInfo in unfoldings and rules]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 In unfoldings and rules, we guarantee that the template is occ-analysed,
diff --git a/compiler/GHC/Core/Opt/CSE.hs b/compiler/GHC/Core/Opt/CSE.hs
index ff1bd3782e..64f845cc54 100644
--- a/compiler/GHC/Core/Opt/CSE.hs
+++ b/compiler/GHC/Core/Opt/CSE.hs
@@ -19,7 +19,7 @@ import GHC.Types.Var.Env ( mkInScopeSet )
 import GHC.Types.Id     ( Id, idType, idHasRules, zapStableUnfolding
                         , idInlineActivation, setInlineActivation
                         , zapIdOccInfo, zapIdUsageInfo, idInlinePragma
-                        , isJoinId, isJoinId_maybe )
+                        , isJoinId, isJoinId_maybe, idUnfolding )
 import GHC.Core.Utils   ( mkAltExpr
                         , exprIsTickedString
                         , stripTicksE, stripTicksT, mkTicks )
@@ -228,7 +228,7 @@ is small).  The conclusion here is this:
   might replace <rhs> by 'bar', and then later be unable to see that it
   really was <rhs>.
 
-An except to the rule is when the INLINE pragma is not from the user, e.g. from
+An exception to the rule is when the INLINE pragma is not from the user, e.g. from
 WorkWrap (see Note [Wrapper activation]). We can tell because noUserInlineSpec
 is then true.
 
@@ -262,27 +262,31 @@ There could conceivably be merit in rewriting the RHS of bar:
 but now bar's inlining behaviour will change, and importing
 modules might see that.  So it seems dodgy and we don't do it.
 
-Stable unfoldings are also created during worker/wrapper when we decide
-that a function's definition is so small that it should always inline.
-In this case we still want to do CSE (#13340). Hence the use of
-isAnyInlinePragma rather than isStableUnfolding.
-
-Now consider
-   foo = <expr>
-   bar {-# Unf = Stable ... #-}
-      = <expr>
-
-where the unfolding was added by strictness analysis, say.  Then
-CSE goes ahead, so we get
-   bar = foo
-and probably use SUBSTITUTE that will make 'bar' dead.  But just
-possibly not -- see Note [Dealing with ticks].  In that case we might
-be left with
-   bar = tick t1 (tick t2 foo)
-in which case we would really like to get rid of the stable unfolding
-(generated by the strictness analyser, say).  Hence the zapStableUnfolding
-in cse_bind.  Not a big deal, and only makes a difference when ticks
-get into the picture.
+Wrinkles
+
+* Stable unfoldings are also created during worker/wrapper when we
+  decide that a function's definition is so small that it should
+  always inline, or indeed for the wrapper function itself.  In this
+  case we still want to do CSE (#13340). Hence the use of
+  isStableUserUnfolding/isStableSystemUnfolding rather than
+  isStableUnfolding.
+
+* Consider
+     foo = <expr>
+     bar {-# Unf = Stable ... #-}
+        = <expr>
+  where the unfolding was added by strictness analysis, say.  Then
+  CSE goes ahead, so we get
+     bar = foo
+  and probably use SUBSTITUTE that will make 'bar' dead.  But just
+  possibly not -- see Note [Dealing with ticks].  In that case we might
+  be left with
+     bar = tick t1 (tick t2 foo)
+  in which case we would really like to get rid of the stable unfolding
+  (generated by the strictness analyser, say).
+
+  Hence the zapStableUnfolding in cse_bind.  Not a big deal, and only
+  makes a difference when ticks get into the picture.
 
 Note [Corner case for case expressions]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -508,14 +512,17 @@ extendCSEnvWithBinding env in_id out_id rhs' cse_done
 -- | Given a binder `let x = e`, this function
 -- determines whether we should add `e -> x` to the cs_map
 noCSE :: InId -> Bool
-noCSE id =  not (isAlwaysActive (idInlineActivation id)) &&
-            not (noUserInlineSpec (inlinePragmaSpec (idInlinePragma id)))
-             -- See Note [CSE for INLINE and NOINLINE]
-         || isAnyInlinePragma (idInlinePragma id)
-             -- See Note [CSE for stable unfoldings]
-         || isJoinId id
-             -- See Note [CSE for join points?]
-
+noCSE id
+  | isJoinId id                = no_cse  -- See Note [CSE for join points?]
+  | isStableUserUnfolding  unf = no_cse  -- See Note [CSE for stable unfoldings]
+  | user_activation_control    = no_cse  -- See Note [CSE for INLINE and NOINLINE]
+  | otherwise = yes_cse
+   where
+     unf = idUnfolding id
+     user_activation_control = not (isAlwaysActive (idInlineActivation id))
+                            && not (noUserInlineSpec (inlinePragmaSpec (idInlinePragma id)))
+     yes_cse = False
+     no_cse  = True
 
 {- Note [Take care with literal strings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
index afee252a40..d2bdace3e2 100644
--- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
@@ -628,7 +628,7 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co)
                            , extendIdSubst (setInScopeFromF env floats) old_bndr $
                              DoneEx triv_rhs Nothing ) }
 
-          else do { wrap_unf <- mkLetUnfolding uf_opts top_lvl InlineRhs bndr triv_rhs
+          else do { wrap_unf <- mkLetUnfolding uf_opts top_lvl VanillaSrc bndr triv_rhs
                   ; let bndr' = bndr `setInlinePragma` mkCastWrapperInlinePrag (idInlinePragma bndr)
                                 `setIdUnfolding`  wrap_unf
                         floats' = floats `extendFloats` NonRec bndr' triv_rhs
@@ -659,7 +659,7 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co)
       = 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 uf_opts top_lvl InlineRhs work_id work_rhs
+           _ -> mkLetUnfolding uf_opts top_lvl VanillaSrc work_id work_rhs
 
 tryCastWorkerWrapper env _ _ _ bndr rhs  -- All other bindings
   = do { traceSmpl "tcww:no" (vcat [ text "bndr:" <+> ppr bndr
@@ -841,7 +841,7 @@ makeTrivial env top_lvl dmd occ_fs expr
           -- the 'floats' from prepareRHS; but they are all fresh, so there is
           -- no danger of introducing name shadowig in eta expansion
 
-        ; unf <- mkLetUnfolding uf_opts top_lvl InlineRhs var expr2
+        ; unf <- mkLetUnfolding uf_opts top_lvl VanillaSrc var expr2
 
         ; let final_id = addLetBndrInfo var arity_type unf
               bind     = NonRec final_id expr2
@@ -4110,7 +4110,7 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf
   | otherwise
   = -- Otherwise, we end up retaining all the SimpleEnv
     let !opts = seUnfoldingOpts env
-    in mkLetUnfolding opts (bindContextLevel bind_cxt) InlineRhs id new_rhs
+    in mkLetUnfolding opts (bindContextLevel bind_cxt) VanillaSrc id new_rhs
 
 -------------------
 mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 86ad7df93d..6a143c8be8 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -2077,7 +2077,7 @@ abstractFloats uf_opts top_lvl main_tvs floats body
       = (poly_id `setIdUnfolding` unf, poly_rhs)
       where
         poly_rhs = mkLams tvs_here rhs
-        unf = mkUnfolding uf_opts InlineRhs is_top_lvl False poly_rhs
+        unf = mkUnfolding uf_opts VanillaSrc is_top_lvl False poly_rhs
 
         -- We want the unfolding.  Consider
         --      let
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index fc1d9e2785..711ce6dbd8 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -210,7 +210,7 @@ Solution:
 
   It's important that both get this, because the specialiser uses
   the existence of a /user-specified/ INLINE/INLINABLE pragma to
-  drive specialiation of imported functions.  See  GHC.Core.Opt.Specialise
+  drive specialisation of imported functions.  See  GHC.Core.Opt.Specialise
   Note [Specialising imported functions]
 
 * Remember, the subsequent inlining behaviour of the wrapper is expressed by
@@ -892,9 +892,13 @@ mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl
                                      , inl_rule   = rule_info }) rules
   = InlinePragma { inl_src    = SourceText "{-# INLINE"
                  , inl_sat    = Nothing
-                 , inl_inline = fn_inl -- See Note [Worker/wrapper for INLINABLE functions]
+
+                 , inl_inline = fn_inl
+                      -- See Note [Worker/wrapper for INLINABLE functions]
+
                  , inl_act    = activeAfter wrapper_phase
-                                -- See Note [Wrapper activation]
+                      -- See Note [Wrapper activation]
+
                  , inl_rule   = rule_info }  -- RuleMatchInfo is (and must be) unaffected
   where
     -- See Note [Wrapper activation]
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index d4b2cbeb93..e24dc20fb9 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -618,11 +618,6 @@ instance Outputable UnfoldingGuidance where
                int size,
                int discount ]
 
-instance Outputable UnfoldingSource where
-  ppr InlineCompulsory  = text "Compulsory"
-  ppr InlineStable      = text "InlineStable"
-  ppr InlineRhs         = text "<vanilla>"
-
 instance Outputable Unfolding where
   ppr NoUnfolding                = text "No unfolding"
   ppr BootUnfolding              = text "No unfolding (from boot)"
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index 75a5ed27a0..d8f2b4b5bd 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -756,7 +756,7 @@ add_info env old_bndr top_level new_rhs new_bndr
                  | otherwise
                  = unfolding_from_rhs
 
-   unfolding_from_rhs = mkUnfolding uf_opts InlineRhs
+   unfolding_from_rhs = mkUnfolding uf_opts VanillaSrc
                                     (isTopLevel top_level)
                                     False -- may be bottom or not
                                     new_rhs
diff --git a/compiler/GHC/Core/Tidy.hs b/compiler/GHC/Core/Tidy.hs
index 3a73ce7dd5..af48f42f23 100644
--- a/compiler/GHC/Core/Tidy.hs
+++ b/compiler/GHC/Core/Tidy.hs
@@ -400,7 +400,7 @@ two reasons:
 
   (a) To make printing tidy core nicer
 
-  (b) Because we tidy RULES and InlineRules, which may then propagate
+  (b) Because we tidy RULES and unfoldings, which may then propagate
       via --make into the compilation of the next module, and we want
       the benefit of that occurrence analysis when we use the rule or
       or inline the function.  In particular, it's vital not to lose
diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs
index 0cf19d81f8..49ef7ca02c 100644
--- a/compiler/GHC/Core/Unfold.hs
+++ b/compiler/GHC/Core/Unfold.hs
@@ -1307,20 +1307,6 @@ Note [Things to watch]
     Make sure that x does not inline unconditionally!
     Lest we get extra allocation.
 
-Note [Inlining an InlineRule]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-An InlineRules is used for
-  (a) programmer INLINE pragmas
-  (b) inlinings from worker/wrapper
-
-For (a) the RHS may be large, and our contract is that we *only* inline
-when the function is applied to all the arguments on the LHS of the
-source-code defn.  (The uf_arity in the rule.)
-
-However for worker/wrapper it may be worth inlining even if the
-arity is not satisfied (as we do in the CoreUnfolding case) so we don't
-require saturation.
-
 Note [Nested functions]
 ~~~~~~~~~~~~~~~~~~~~~~~
 At one time we treated a call of a non-top-level function as
@@ -1399,8 +1385,8 @@ RULE) so there's no gain.
 However, watch out:
 
  * Consider this:
-        foo = _inline_ (\n. [n])
-        bar = _inline_ (foo 20)
+        foo = \n. [n])  {-# INLINE foo #-}
+        bar = foo 20    {-# INLINE bar #-}
         baz = \n. case bar of { (m:_) -> m + n }
    Here we really want to inline 'bar' so that we can inline 'foo'
    and the whole thing unravels as it should obviously do.  This is
@@ -1408,9 +1394,9 @@ However, watch out:
    structure rather than a list.
 
    So the non-inlining of lone_variables should only apply if the
-   unfolding is regarded as cheap; because that is when exprIsConApp_maybe
-   looks through the unfolding.  Hence the "&& is_wf" in the
-   InlineRule branch.
+   unfolding is regarded as expandable; because that is when
+   exprIsConApp_maybe looks through the unfolding.  Hence the "&&
+   is_exp" in the CaseCtxt branch of interesting_call
 
  * Even a type application or coercion isn't a lone variable.
    Consider
diff --git a/compiler/GHC/Core/Unfold/Make.hs b/compiler/GHC/Core/Unfold/Make.hs
index 538af3db3d..e545f4a9f3 100644
--- a/compiler/GHC/Core/Unfold/Make.hs
+++ b/compiler/GHC/Core/Unfold/Make.hs
@@ -8,13 +8,12 @@ module GHC.Core.Unfold.Make
    , mkFinalUnfolding
    , mkSimpleUnfolding
    , mkWorkerUnfolding
-   , mkInlineUnfolding
-   , mkInlineUnfoldingWithArity
+   , mkInlineUnfoldingWithArity, mkInlineUnfoldingNoArity
    , mkInlinableUnfolding
    , mkWrapperUnfolding
-   , mkCompulsoryUnfolding
-   , mkCompulsoryUnfolding'
+   , mkCompulsoryUnfolding, mkCompulsoryUnfolding'
    , mkDFunUnfolding
+   , mkDataConUnfolding
    , specUnfolding
    , certainlyWillInline
    )
@@ -50,15 +49,14 @@ mkFinalUnfolding opts src strict_sig expr
                 (isDeadEndSig strict_sig)
                 expr
 
+-- | Same as 'mkCompulsoryUnfolding' but simplifies the unfolding first
+mkCompulsoryUnfolding' :: SimpleOpts -> CoreExpr -> Unfolding
+mkCompulsoryUnfolding' opts expr = mkCompulsoryUnfolding (simpleOptExpr opts expr)
+
 -- | Used for things that absolutely must be unfolded
-mkCompulsoryUnfolding :: SimpleOpts -> CoreExpr -> Unfolding
-mkCompulsoryUnfolding opts expr = mkCompulsoryUnfolding' (simpleOptExpr opts expr)
-
--- | Same as 'mkCompulsoryUnfolding' but no simple optimiser pass is performed
--- on the unfolding.
-mkCompulsoryUnfolding' :: CoreExpr -> Unfolding
-mkCompulsoryUnfolding' expr
-  = mkCoreUnfolding InlineCompulsory True
+mkCompulsoryUnfolding :: CoreExpr -> Unfolding
+mkCompulsoryUnfolding expr
+  = mkCoreUnfolding CompulsorySrc True
                     expr
                     (UnfWhen { ug_arity = 0    -- Arity of unfolding doesn't matter
                              , ug_unsat_ok = unSaturatedOk, ug_boring_ok = boringCxtOk })
@@ -71,7 +69,7 @@ mkCompulsoryUnfolding' expr
 
 mkSimpleUnfolding :: UnfoldingOpts -> CoreExpr -> Unfolding
 mkSimpleUnfolding !opts rhs
-  = mkUnfolding opts InlineRhs False False rhs
+  = mkUnfolding opts VanillaSrc False False rhs
 
 mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding
 mkDFunUnfolding bndrs con ops
@@ -80,11 +78,21 @@ mkDFunUnfolding bndrs con ops
                   , df_args = map occurAnalyseExpr ops }
                   -- See Note [Occurrence analysis of unfoldings]
 
+mkDataConUnfolding :: CoreExpr -> Unfolding
+-- Used for non-newtype data constructors with non-trivial wrappers
+mkDataConUnfolding expr
+  = mkCoreUnfolding StableSystemSrc True expr guide
+    -- No need to simplify the expression
+  where
+    guide = UnfWhen { ug_arity     = manifestArity expr
+                    , ug_unsat_ok  = unSaturatedOk
+                    , ug_boring_ok = False }
+
 mkWrapperUnfolding :: SimpleOpts -> CoreExpr -> Arity -> Unfolding
 -- Make the unfolding for the wrapper in a worker/wrapper split
 -- after demand/CPR analysis
 mkWrapperUnfolding opts expr arity
-  = mkCoreUnfolding InlineStable True
+  = mkCoreUnfolding StableSystemSrc True
                     (simpleOptExpr opts expr)
                     (UnfWhen { ug_arity     = arity
                              , ug_unsat_ok  = unSaturatedOk
@@ -103,13 +111,13 @@ mkWorkerUnfolding opts work_fn
 
 mkWorkerUnfolding _ _ _ = noUnfolding
 
--- | Make an unfolding that may be used unsaturated
+-- | Make an INLINE unfolding that may be used unsaturated
 -- (ug_unsat_ok = unSaturatedOk) and that is reported as having its
 -- manifest arity (the number of outer lambdas applications will
 -- resolve before doing any work).
-mkInlineUnfolding :: SimpleOpts -> CoreExpr -> Unfolding
-mkInlineUnfolding opts expr
-  = mkCoreUnfolding InlineStable
+mkInlineUnfoldingNoArity :: SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfolding
+mkInlineUnfoldingNoArity opts src expr
+  = mkCoreUnfolding src
                     True         -- Note [Top-level flag on inline rules]
                     expr' guide
   where
@@ -119,11 +127,11 @@ mkInlineUnfolding opts expr
                     , ug_boring_ok = boring_ok }
     boring_ok = inlineBoringOk expr'
 
--- | Make an unfolding that will be used once the RHS has been saturated
+-- | Make an INLINE unfolding that will be used once the RHS has been saturated
 -- to the given arity.
-mkInlineUnfoldingWithArity :: Arity -> SimpleOpts -> CoreExpr -> Unfolding
-mkInlineUnfoldingWithArity arity opts expr
-  = mkCoreUnfolding InlineStable
+mkInlineUnfoldingWithArity :: SimpleOpts -> UnfoldingSource -> Arity -> CoreExpr -> Unfolding
+mkInlineUnfoldingWithArity opts src arity expr
+  = mkCoreUnfolding src
                     True         -- Note [Top-level flag on inline rules]
                     expr' guide
   where
@@ -136,9 +144,9 @@ mkInlineUnfoldingWithArity arity opts expr
     boring_ok | arity == 0 = True
               | otherwise  = inlineBoringOk expr'
 
-mkInlinableUnfolding :: SimpleOpts -> CoreExpr -> Unfolding
-mkInlinableUnfolding opts expr
-  = mkUnfolding (so_uf_opts opts) InlineStable False False expr'
+mkInlinableUnfolding :: SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfolding
+mkInlinableUnfolding opts src expr
+  = mkUnfolding (so_uf_opts opts) src False False expr'
   where
     expr' = simpleOptExpr opts expr
 
@@ -316,29 +324,29 @@ mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr
                 -> UnfoldingGuidance -> Unfolding
 -- Occurrence-analyses the expression before capturing it
 mkCoreUnfolding src top_lvl expr guidance
-  =
-
-  let is_value = exprIsHNF expr
-      is_conlike = exprIsConLike expr
-      is_work_free = exprIsWorkFree expr
-      is_expandable = exprIsExpandable expr
-  in
-  -- See #20905 for what is going on here. We are careful to make sure we only
-  -- have one copy of an unfolding around at once.
-  -- Note [Thoughtful forcing in mkCoreUnfolding]
-  CoreUnfolding { uf_tmpl         = is_value `seq`
-                                    is_conlike `seq`
-                                    is_work_free `seq`
-                                    is_expandable `seq`
-                                      occurAnalyseExpr expr,
-                      -- See Note [Occurrence analysis of unfoldings]
-                    uf_src          = src,
-                    uf_is_top       = top_lvl,
-                    uf_is_value     = is_value,
-                    uf_is_conlike   = is_conlike,
-                    uf_is_work_free = is_work_free,
-                    uf_expandable   = is_expandable,
-                    uf_guidance     = guidance }
+  = CoreUnfolding { uf_tmpl = is_value `seq`
+                              is_conlike `seq`
+                              is_work_free `seq`
+                              is_expandable `seq`
+                              occurAnalyseExpr expr
+      -- occAnalyseExpr: see Note [Occurrence analysis of unfoldings]
+      -- See #20905 for what a discussion of these 'seq's
+      -- We are careful to make sure we only
+      -- have one copy of an unfolding around at once.
+      -- Note [Thoughtful forcing in mkCoreUnfolding]
+
+                  , uf_src          = src
+                  , uf_is_top       = top_lvl
+                  , uf_is_value     = is_value
+                  , uf_is_conlike   = is_conlike
+                  , uf_is_work_free = is_work_free
+                  , uf_expandable   = is_expandable
+                  , uf_guidance     = guidance }
+  where
+    is_value      = exprIsHNF expr
+    is_conlike    = exprIsConLike expr
+    is_work_free  = exprIsWorkFree expr
+    is_expandable = exprIsExpandable expr
 
 ----------------
 certainlyWillInline :: UnfoldingOpts -> IdInfo -> CoreExpr -> Maybe Unfolding
@@ -358,14 +366,12 @@ certainlyWillInline opts fn_info rhs'
              UnfIfGoodArgs { ug_size = size, ug_args = args }
                         -> do_cunf size args src' tmpl'
         where
-          src' = -- Do not change InlineCompulsory!
-                 case src of
-                   InlineCompulsory -> InlineCompulsory
-                   _                -> InlineStable
-          tmpl' = -- Do not overwrite stable unfoldings!
-                  case src of
-                    InlineRhs -> occurAnalyseExpr rhs'
-                    _         -> uf_tmpl fn_unf
+          src' | isCompulsorySource src = src  -- Do not change InlineCompulsory!
+               | otherwise              = StableSystemSrc
+
+          tmpl' | isStableSource src = uf_tmpl fn_unf
+                | otherwise          = occurAnalyseExpr rhs'
+                -- Do not overwrite stable unfoldings!
 
       DFunUnfolding {} -> Just fn_unf  -- Don't w/w DFuns; it never makes sense
                                        -- to do so, and even if it is currently a
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index 2564320eaa..0060d82f26 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -501,20 +501,11 @@ toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs
                                 , uf_src = src
                                 , uf_guidance = guidance })
   = Just $ HsUnfold lb $
-    case src of
-        InlineStable
-          -> case guidance of
-               UnfWhen {ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok =  boring_ok }
-                      -> IfInlineRule arity unsat_ok boring_ok if_rhs
-               _other -> IfCoreUnfold True if_rhs
-        InlineCompulsory -> IfCompulsory if_rhs
-        InlineRhs        -> IfCoreUnfold False if_rhs
+    IfCoreUnfold src (toIfGuidance src guidance) (toIfaceExpr rhs)
         -- Yes, even if guidance is UnfNever, expose the unfolding
         -- If we didn't want to expose the unfolding, GHC.Iface.Tidy would
         -- have stuck in NoUnfolding.  For supercompilation we want
         -- to see that unfolding!
-  where
-    if_rhs = toIfaceExpr rhs
 
 toIfUnfolding lb (DFunUnfolding { df_bndrs = bndrs, df_args = args })
   = Just (HsUnfold lb (IfDFunUnfold (map toIfaceBndr bndrs) (map toIfaceExpr args)))
@@ -531,6 +522,12 @@ toIfUnfolding _ BootUnfolding = Nothing
 
 toIfUnfolding _ NoUnfolding = Nothing
 
+toIfGuidance :: UnfoldingSource -> UnfoldingGuidance -> IfGuidance
+toIfGuidance src guidance
+  | UnfWhen arity unsat_ok boring_ok <- guidance
+  , isStableSource src = IfWhen arity unsat_ok boring_ok
+  | otherwise          = IfNoGuidance
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 983f3086b5..6da39a27bc 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -787,7 +787,7 @@ mkUnsafeCoercePrimPair _old_id old_expr
 
 
              info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
-                                `setUnfoldingInfo` mkCompulsoryUnfolding' rhs
+                                `setUnfoldingInfo` mkCompulsoryUnfolding rhs
                                 `setArityInfo`     arity
 
              ty = mkSpecForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 053c9959a2..b5e31de532 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -390,7 +390,7 @@ makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr
 makeCorePair dflags gbl_id is_default_method dict_arity rhs
   | is_default_method    -- Default methods are *always* inlined
                          -- See Note [INLINE and default methods] in GHC.Tc.TyCl.Instance
-  = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding simpl_opts rhs, rhs)
+  = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding' simpl_opts rhs, rhs)
 
   | otherwise
   = case inlinePragmaSpec inline_prag of
@@ -402,19 +402,20 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
   where
     simpl_opts    = initSimpleOpts dflags
     inline_prag   = idInlinePragma gbl_id
-    inlinable_unf = mkInlinableUnfolding simpl_opts rhs
+    inlinable_unf = mkInlinableUnfolding simpl_opts StableUserSrc rhs
     inline_pair
        | Just arity <- inlinePragmaSat inline_prag
         -- Add an Unfolding for an INLINE (but not for NOINLINE)
         -- And eta-expand the RHS; see Note [Eta-expanding INLINE things]
        , let real_arity = dict_arity + arity
-        -- NB: The arity in the InlineRule takes account of the dictionaries
-       = ( gbl_id `setIdUnfolding` mkInlineUnfoldingWithArity real_arity simpl_opts rhs
+        -- NB: The arity passed to mkInlineUnfoldingWithArity
+        --     must take account of the dictionaries
+       = ( gbl_id `setIdUnfolding` mkInlineUnfoldingWithArity simpl_opts StableUserSrc real_arity rhs
          , etaExpand real_arity rhs)
 
        | otherwise
        = pprTrace "makeCorePair: arity missing" (ppr gbl_id) $
-         (gbl_id `setIdUnfolding` mkInlineUnfolding simpl_opts rhs, rhs)
+         (gbl_id `setIdUnfolding` mkInlineUnfoldingNoArity simpl_opts StableUserSrc rhs, rhs)
 
 dictArity :: [Var] -> Arity
 -- Don't count coercion variables in arity
@@ -542,7 +543,7 @@ this:
         fromT :: T Bool -> Bool
         { fromT_1 ((TBool b)) = not b } } }
 
-Note the nested AbsBind.  The arity for the InlineRule on $cfromT should be
+Note the nested AbsBind.  The arity for the unfolding on $cfromT should be
 gotten from the binding for fromT_1.
 
 It might be better to have just one level of AbsBinds, but that requires more
@@ -976,7 +977,7 @@ And from that we want the rule
 
 But be careful!  That dInt might be GHC.Base.$fOrdInt, which is an External
 Name, and you can't bind them in a lambda or forall without getting things
-confused.   Likewise it might have an InlineRule or something, which would be
+confused.   Likewise it might have a stable unfolding or something, which would be
 utterly bogus. So we really make a fresh Id, with the same unique and type
 as the old one, but with an Internal name and no IdInfo.
 
diff --git a/compiler/GHC/HsToCore/Foreign/C.hs b/compiler/GHC/HsToCore/Foreign/C.hs
index a35e3feca6..13ba3123f4 100644
--- a/compiler/GHC/HsToCore/Foreign/C.hs
+++ b/compiler/GHC/HsToCore/Foreign/C.hs
@@ -324,9 +324,8 @@ dsFCall fn_id co fcall mDeclHeader = do
         wrap_rhs     = mkLams (tvs ++ args) wrapper_body
         wrap_rhs'    = Cast wrap_rhs co
         simpl_opts   = initSimpleOpts dflags
-        fn_id_w_inl  = fn_id `setIdUnfolding` mkInlineUnfoldingWithArity
-                                                (length args)
-                                                simpl_opts
+        fn_id_w_inl  = fn_id `setIdUnfolding` mkInlineUnfoldingWithArity simpl_opts
+                                                StableSystemSrc (length args)
                                                 wrap_rhs'
 
     return ([(work_id, work_rhs), (fn_id_w_inl, wrap_rhs')], mempty, CStub cDoc [] [])
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index fdbe0dd55a..1a7acea25f 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -600,12 +600,8 @@ rnIfaceInfoItem i
     = pure i
 
 rnIfaceUnfolding :: Rename IfaceUnfolding
-rnIfaceUnfolding (IfCoreUnfold stable if_expr)
-    = IfCoreUnfold stable <$> rnIfaceExpr if_expr
-rnIfaceUnfolding (IfCompulsory if_expr)
-    = IfCompulsory <$> rnIfaceExpr if_expr
-rnIfaceUnfolding (IfInlineRule arity unsat_ok boring_ok if_expr)
-    = IfInlineRule arity unsat_ok boring_ok <$> rnIfaceExpr if_expr
+rnIfaceUnfolding (IfCoreUnfold src guide if_expr)
+    = IfCoreUnfold src guide <$> rnIfaceExpr if_expr
 rnIfaceUnfolding (IfDFunUnfold bs ops)
     = IfDFunUnfold <$> rnIfaceBndrs bs <*> mapM rnIfaceExpr ops
 
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index 1affa46b42..7e7a1aa0c8 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -13,7 +13,7 @@ module GHC.Iface.Syntax (
         IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
         IfaceExpr(..), IfaceAlt(..), IfaceLetBndr(..), IfaceJoinInfo(..),
         IfaceBinding(..), IfaceConAlt(..),
-        IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..),
+        IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..),
         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
         IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
         IfaceClassBody(..),
@@ -360,21 +360,12 @@ data IfaceInfoItem
 -- only later attached to the Id.  Partial reason: some are orphans.
 
 data IfaceUnfolding
-  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
-                                -- Possibly could eliminate the Bool here, the information
-                                -- is also in the InlinePragma.
-
-  | IfCompulsory IfaceExpr      -- default methods and unsafeCoerce#
-                                -- for more about unsafeCoerce#, see
-                                -- Note [Wiring in unsafeCoerce#] in "GHC.HsToCore"
-
-  | IfInlineRule Arity          -- INLINE pragmas
-                 Bool           -- OK to inline even if *un*-saturated
-                 Bool           -- OK to inline even if context is boring
-                 IfaceExpr
-
+  = IfCoreUnfold UnfoldingSource IfGuidance IfaceExpr
   | IfDFunUnfold [IfaceBndr] [IfaceExpr]
 
+data IfGuidance
+  = IfNoGuidance            -- Compute it from the IfaceExpr
+  | IfWhen Arity Bool Bool  -- Just like UnfWhen in Core.UnfoldingGuidance
 
 -- We only serialise the IdDetails of top-level Ids, and even then
 -- we only need a very limited selection.  Notably, none of the
@@ -1488,17 +1479,15 @@ instance Outputable IfaceJoinInfo where
   ppr (IfaceJoinPoint ar) = angleBrackets (text "join" <+> ppr ar)
 
 instance Outputable IfaceUnfolding where
-  ppr (IfCompulsory e)     = text "<compulsory>" <+> parens (ppr e)
-  ppr (IfCoreUnfold s e)   = (if s
-                                then text "<stable>"
-                                else Outputable.empty)
-                              <+> parens (ppr e)
-  ppr (IfInlineRule a uok bok e) = sep [text "InlineRule"
-                                            <+> ppr (a,uok,bok),
-                                        pprParendIfaceExpr e]
+  ppr (IfCoreUnfold src guide e)
+    = sep [ text "Core:" <+> ppr src <+> ppr guide, ppr e ]
   ppr (IfDFunUnfold bs es) = hang (text "DFun:" <+> sep (map ppr bs) <> dot)
                                 2 (sep (map pprParendIfaceExpr es))
 
+instance Outputable IfGuidance where
+  ppr IfNoGuidance   = empty
+  ppr (IfWhen a u b) = angleBrackets (ppr a <> comma <> ppr u <> ppr b)
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1742,9 +1731,7 @@ freeNamesItem (HsLFInfo (IfLFCon n)) = unitNameSet n
 freeNamesItem _                      = emptyNameSet
 
 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
-freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e
-freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
-freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
+freeNamesIfUnfold (IfCoreUnfold _ _ e)   = freeNamesIfExpr e
 freeNamesIfUnfold (IfDFunUnfold bs es)   = freeNamesIfBndrs bs &&& fnList freeNamesIfExpr es
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
@@ -2264,39 +2251,41 @@ instance Binary IfaceInfoItem where
             _ -> HsTagSig <$> get bh
 
 instance Binary IfaceUnfolding where
-    put_ bh (IfCoreUnfold s e) = do
+    put_ bh (IfCoreUnfold s g e) = do
         putByte bh 0
         put_ bh s
+        put_ bh g
         put_ bh e
-    put_ bh (IfInlineRule a b c d) = do
-        putByte bh 1
-        put_ bh a
-        put_ bh b
-        put_ bh c
-        put_ bh d
     put_ bh (IfDFunUnfold as bs) = do
-        putByte bh 2
+        putByte bh 1
         put_ bh as
         put_ bh bs
-    put_ bh (IfCompulsory e) = do
-        putByte bh 3
-        put_ bh e
     get bh = do
         h <- getByte bh
         case h of
             0 -> do s <- get bh
+                    g <- get bh
                     e <- get bh
-                    return (IfCoreUnfold s e)
-            1 -> do a <- get bh
-                    b <- get bh
-                    c <- get bh
-                    d <- get bh
-                    return (IfInlineRule a b c d)
-            2 -> do as <- get bh
+                    return (IfCoreUnfold s g e)
+            _ -> do as <- get bh
                     bs <- get bh
                     return (IfDFunUnfold as bs)
-            _ -> do e <- get bh
-                    return (IfCompulsory e)
+
+instance Binary IfGuidance where
+    put_ bh IfNoGuidance = putByte bh 0
+    put_ bh (IfWhen a b c ) = do
+        putByte bh 1
+        put_ bh a
+        put_ bh b
+        put_ bh c
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return IfNoGuidance
+            _ -> do a <- get bh
+                    b <- get bh
+                    c <- get bh
+                    return (IfWhen a b c)
 
 instance Binary IfaceAlt where
     put_ bh (IfaceAlt a b c) = do
@@ -2610,16 +2599,15 @@ instance NFData IfaceInfoItem where
     HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further?
     HsTagSig sig -> sig `seq` ()
 
+instance NFData IfGuidance where
+  rnf = \case
+    IfNoGuidance -> ()
+    IfWhen a b c -> a `seq` b `seq` c `seq` ()
+
 instance NFData IfaceUnfolding where
   rnf = \case
-    IfCoreUnfold inlinable expr ->
-      rnf inlinable `seq` rnf expr
-    IfCompulsory expr ->
-      rnf expr
-    IfInlineRule arity b1 b2 e ->
-      rnf arity `seq` rnf b1 `seq` rnf b2 `seq` rnf e
-    IfDFunUnfold bndrs exprs ->
-      rnf bndrs `seq` rnf exprs
+    IfCoreUnfold src guidance expr -> src `seq` rnf guidance `seq` rnf expr
+    IfDFunUnfold bndrs exprs       -> rnf bndrs `seq` rnf exprs
 
 instance NFData IfaceExpr where
   rnf = \case
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 515402abc5..68733b3671 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -875,9 +875,9 @@ dffvBind(x,r)
 dffvLetBndr :: Bool -> Id -> DFFV ()
 -- Gather the free vars of the RULES and unfolding of a binder
 -- We always get the free vars of a *stable* unfolding, but
--- for a *vanilla* one (InlineRhs), the flag controls what happens:
+-- for a *vanilla* one (VanillaSrc), the flag controls what happens:
 --   True <=> get fvs of even a *vanilla* unfolding
---   False <=> ignore an InlineRhs
+--   False <=> ignore a VanillaSrc
 -- For nested bindings (call from dffvBind) we always say "False" because
 --       we are taking the fvs of the RHS anyway
 -- For top-level bindings (call from addExternal, via bndrFvsInOrder)
@@ -889,10 +889,9 @@ dffvLetBndr vanilla_unfold id
     idinfo = idInfo id
 
     go_unf (CoreUnfolding { uf_tmpl = rhs, uf_src = src })
-       = case src of
-           InlineRhs | vanilla_unfold -> dffvExpr rhs
-                     | otherwise      -> return ()
-           _                          -> dffvExpr rhs
+       | isStableSource src = dffvExpr rhs
+       | vanilla_unfold     = dffvExpr rhs
+       | otherwise          = return ()
 
     go_unf (DFunUnfolding { df_bndrs = bndrs, df_args = args })
              = extendScopeList bndrs $ mapM_ dffvExpr args
@@ -1292,7 +1291,6 @@ tidyTopIdInfo rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold
                  = tidyTopUnfolding rhs_tidy_env tidy_rhs unf_info
                  | otherwise
                  = minimal_unfold_info
---    unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig orig_rhs
      -- NB: use `orig_rhs` not `tidy_rhs` in this call to mkFinalUnfolding
      -- else you get a black hole (#22122). Reason: mkFinalUnfolding
      -- looks at IdInfo, and that is knot-tied in tidyTopBind (the Rec case)
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index a7c3162930..4ef629593c 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -57,6 +57,7 @@ import GHC.Core.FamInstEnv
 import GHC.Core
 import GHC.Core.Unify( RoughMatchTc(..) )
 import GHC.Core.Utils
+import GHC.Core.Unfold( calcUnfoldingGuidance )
 import GHC.Core.Unfold.Make
 import GHC.Core.Lint
 import GHC.Core.Make
@@ -97,6 +98,7 @@ import GHC.Types.Unique.FM
 import GHC.Types.Unique.DSet ( mkUniqDSet )
 import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
 import GHC.Types.Unique.Supply
+import GHC.Types.Demand( isDeadEndSig )
 import GHC.Types.Literal
 import GHC.Types.Var as Var
 import GHC.Types.Var.Set
@@ -1655,8 +1657,8 @@ tcIdInfo ignore_prags toplvl name ty info = do
     need_prag :: IfaceInfoItem -> Bool
       -- Always read in compulsory unfoldings
       -- See Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy
-    need_prag (HsUnfold _ (IfCompulsory {})) = True
-    need_prag _                              = False
+    need_prag (HsUnfold _ (IfCoreUnfold src _ _)) = isCompulsorySource src
+    need_prag _ = False
 
     tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
     tcPrag info HsNoCafRefs        = return (info `setCafInfo`   NoCafRefs)
@@ -1716,25 +1718,16 @@ tcLFInfo lfi = case lfi of
 
 tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
 -- See Note [Lazily checking Unfoldings]
-tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr)
+tcUnfolding toplvl name _ info (IfCoreUnfold src if_guidance if_expr)
   = do  { uf_opts <- unfoldingOpts <$> getDynFlags
-        ; expr <- tcUnfoldingRhs False toplvl name if_expr
-        ; let unf_src | stable    = InlineStable
-                      | otherwise = InlineRhs
-        ; return $ mkFinalUnfolding uf_opts unf_src strict_sig expr }
+        ; expr <- tcUnfoldingRhs (isCompulsorySource src) toplvl name if_expr
+        ; let guidance = case if_guidance of
+                 IfWhen arity unsat_ok boring_ok -> UnfWhen arity unsat_ok boring_ok
+                 IfNoGuidance -> calcUnfoldingGuidance uf_opts is_top_bottoming expr
+        ; return $ mkCoreUnfolding src True expr guidance }
   where
     -- Strictness should occur before unfolding!
-    strict_sig = dmdSigInfo info
-
-tcUnfolding toplvl name _ _ (IfCompulsory if_expr)
-  = do  { expr <- tcUnfoldingRhs True toplvl name if_expr
-        ; return $ mkCompulsoryUnfolding' expr }
-
-tcUnfolding toplvl name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
-  = do  { expr <- tcUnfoldingRhs False toplvl name if_expr
-        ; return $ mkCoreUnfolding InlineStable True expr guidance }
-  where
-    guidance = UnfWhen { ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok }
+    is_top_bottoming = isTopLevel toplvl && isDeadEndSig (dmdSigInfo info)
 
 tcUnfolding _toplvl name dfun_ty _ (IfDFunUnfold bs ops)
   = bindIfaceBndrs bs $ \ bs' ->
@@ -1765,7 +1758,7 @@ in the middle of checking (so looking at it would cause a loop).
 
 Conclusion: `tcUnfolding` must return an `Unfolding` whose `uf_src` field is readable without
 forcing the `uf_tmpl` field. In particular, all the functions used at the end of
-`tcUnfolding` (such as `mkFinalUnfolding`, `mkCompulsoryUnfolding'`, `mkCoreUnfolding`) must be
+`tcUnfolding` (such as `mkFinalUnfolding`, `mkCoreUnfolding`) must be
 lazy in `expr`.
 
 Ticket #21139
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index e1b7fc0f0f..8b3c34aa83 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -175,7 +175,7 @@ Note [Instances and loop breakers]
   inline df_i in it, and that in turn means that (since it'll be a
   loop-breaker because df_i isn't), op1_i will ironically never be
   inlined.  But this is OK: the recursion breaking happens by way of
-  a RULE (the magic ClassOp rule above), and RULES work inside InlineRule
+  a RULE (the magic ClassOp rule above), and RULES work inside stable
   unfoldings. See Note [RULEs enabled in InitialPhase] in GHC.Core.Opt.Simplify.Utils
 
 Note [ClassOp/DFun selection]
@@ -1349,7 +1349,7 @@ addDFunPrags :: DFunId -> [Id] -> DFunId
 -- is messing with.
 addDFunPrags dfun_id sc_meth_ids
  | is_newtype
-  = dfun_id `setIdUnfolding`  mkInlineUnfoldingWithArity 0 defaultSimpleOpts con_app
+  = dfun_id `setIdUnfolding`  mkInlineUnfoldingWithArity defaultSimpleOpts StableSystemSrc 0 con_app
             `setInlinePragma` alwaysInlinePragma { inl_sat = Just 0 }
  | otherwise
  = dfun_id `setIdUnfolding`  mkDFunUnfolding dfun_bndrs dict_con dict_args
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index 027fe63bad..bb8dcde29f 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -98,6 +98,9 @@ module GHC.Types.Basic (
         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
         pprInline, pprInlineDebug,
 
+        UnfoldingSource(..), isStableSource, isStableUserSource,
+        isStableSystemSource, isCompulsorySource,
+
         SuccessFlag(..), succeeded, failed, successIf,
 
         IntWithInf, infinity, treatZeroAsInf, subWithInf, mkIntWithInf, intGtLimit,
@@ -1433,7 +1436,7 @@ If you write nothing at all, you get defaultInlinePragma:
 It's not possible to get that combination by *writing* something, so
 if an Id has defaultInlinePragma it means the user didn't specify anything.
 
-If inl_inline = Inline or Inlineable, then the Id should have an InlineRule unfolding.
+If inl_inline = Inline or Inlineable, then the Id should have a stable unfolding.
 
 If you want to know where InlinePragmas take effect: Look in GHC.HsToCore.Binds.makeCorePair
 
@@ -1778,6 +1781,62 @@ pprInline' emptyInline (InlinePragma
               | otherwise      = ppr info
 
 
+{- *********************************************************************
+*                                                                      *
+                 UnfoldingSource
+*                                                                      *
+********************************************************************* -}
+
+data UnfoldingSource
+  = -- See also Note [Historical note: unfoldings for wrappers]
+    VanillaSrc         -- The current rhs of the function
+                       -- Replace uf_tmpl each time around
+
+  -- See Note [Stable unfoldings] in GHC.Core
+  | StableUserSrc   -- From a user-specified INLINE or INLINABLE pragma
+  | StableSystemSrc -- From a wrapper, or system-generated unfolding
+
+  | CompulsorySrc   -- Something that *has* no binding, so you *must* inline it
+                    -- Only a few primop-like things have this property
+                    -- (see "GHC.Types.Id.Make", calls to mkCompulsoryUnfolding).
+                    -- Inline absolutely always, however boring the context.
+
+isStableUserSource :: UnfoldingSource -> Bool
+isStableUserSource StableUserSrc = True
+isStableUserSource _             = False
+
+isStableSystemSource :: UnfoldingSource -> Bool
+isStableSystemSource StableSystemSrc = True
+isStableSystemSource _               = False
+
+isCompulsorySource :: UnfoldingSource -> Bool
+isCompulsorySource CompulsorySrc = True
+isCompulsorySource _             = False
+
+isStableSource :: UnfoldingSource -> Bool
+isStableSource CompulsorySrc   = True
+isStableSource StableSystemSrc = True
+isStableSource StableUserSrc   = True
+isStableSource VanillaSrc      = False
+
+instance Binary UnfoldingSource where
+    put_ bh CompulsorySrc   = putByte bh 0
+    put_ bh StableUserSrc   = putByte bh 1
+    put_ bh StableSystemSrc = putByte bh 2
+    put_ bh VanillaSrc      = putByte bh 3
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return CompulsorySrc
+            1 -> return StableUserSrc
+            2 -> return StableSystemSrc
+            _ -> return VanillaSrc
+
+instance Outputable UnfoldingSource where
+  ppr CompulsorySrc     = text "Compulsory"
+  ppr StableUserSrc     = text "StableUser"
+  ppr StableSystemSrc   = text "StableSystem"
+  ppr VanillaSrc        = text "<vanilla>"
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index 59452d2912..7b0e15df91 100644
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -483,8 +483,8 @@ mkDictSelId name clas
 
     info | new_tycon
          = base_info `setInlinePragInfo` alwaysInlinePragma
-                     `setUnfoldingInfo`  mkInlineUnfoldingWithArity 1
-                                           defaultSimpleOpts
+                     `setUnfoldingInfo`  mkInlineUnfoldingWithArity defaultSimpleOpts
+                                           StableSystemSrc 1
                                            (mkDictSelRhs clas val_index)
                    -- See Note [Single-method classes] in GHC.Tc.TyCl.Instance
                    -- for why alwaysInlinePragma
@@ -492,8 +492,8 @@ mkDictSelId name clas
          | otherwise
          = base_info `setRuleInfo` mkRuleInfo [rule]
                      `setInlinePragInfo` neverInlinePragma
-                     `setUnfoldingInfo`  mkInlineUnfoldingWithArity 1
-                                           defaultSimpleOpts
+                     `setUnfoldingInfo`  mkInlineUnfoldingWithArity defaultSimpleOpts
+                                           StableSystemSrc 1
                                            (mkDictSelRhs clas val_index)
                    -- Add a magic BuiltinRule, but no unfolding
                    -- so that the rule is always available to fire.
@@ -600,7 +600,7 @@ mkDataConWorkId wkr_name data_con
     newtype_unf  = assertPpr (isVanillaDataCon data_con && isSingleton arg_tys)
                              (ppr data_con) $
                               -- Note [Newtype datacons]
-                   mkCompulsoryUnfolding defaultSimpleOpts $
+                   mkCompulsoryUnfolding $
                    mkLams univ_tvs $ Lam id_arg1 $
                    wrapNewTypeBody tycon res_ty_args (Var id_arg1)
 
@@ -719,9 +719,9 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con
              -- See Note [Inline partially-applied constructor wrappers]
              -- Passing Nothing here allows the wrapper to inline when
              -- unsaturated.
-             wrap_unf | isNewTyCon tycon = mkCompulsoryUnfolding defaultSimpleOpts wrap_rhs
+             wrap_unf | isNewTyCon tycon = mkCompulsoryUnfolding wrap_rhs
                         -- See Note [Compulsory newtype unfolding]
-                      | otherwise        = mkInlineUnfolding defaultSimpleOpts wrap_rhs
+                      | otherwise        = mkDataConUnfolding wrap_rhs
              wrap_rhs = mkLams wrap_tvs $
                         mkLams wrap_args $
                         wrapFamInstBody tycon res_ty_args $
@@ -1431,14 +1431,14 @@ nullAddrId :: Id
 nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
   where
     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
-                       `setUnfoldingInfo`  mkCompulsoryUnfolding defaultSimpleOpts (Lit nullAddrLit)
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding (Lit nullAddrLit)
 
 ------------------------------------------------
 seqId :: Id     -- See Note [seqId magic]
 seqId = pcMiscPrelId seqName ty info
   where
     info = noCafIdInfo `setInlinePragInfo` inline_prag
-                       `setUnfoldingInfo`  mkCompulsoryUnfolding defaultSimpleOpts rhs
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
                        `setArityInfo`      arity
 
     inline_prag
@@ -1484,7 +1484,7 @@ oneShotId :: Id -- See Note [The oneShot function]
 oneShotId = pcMiscPrelId oneShotName ty info
   where
     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
-                       `setUnfoldingInfo`  mkCompulsoryUnfolding defaultSimpleOpts rhs
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
                        `setArityInfo`      arity
     ty  = mkInfForAllTys  [ runtimeRep1TyVar, runtimeRep2TyVar ] $
           mkSpecForAllTys [ openAlphaTyVar, openBetaTyVar ]      $
@@ -1525,7 +1525,7 @@ leftSectionId :: Id
 leftSectionId = pcMiscPrelId leftSectionName ty info
   where
     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
-                       `setUnfoldingInfo`  mkCompulsoryUnfolding defaultSimpleOpts rhs
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
                        `setArityInfo`      arity
     ty  = mkInfForAllTys  [runtimeRep1TyVar,runtimeRep2TyVar, multiplicityTyVar1] $
           mkSpecForAllTys [openAlphaTyVar,  openBetaTyVar]    $
@@ -1550,7 +1550,7 @@ rightSectionId :: Id
 rightSectionId = pcMiscPrelId rightSectionName ty info
   where
     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
-                       `setUnfoldingInfo`  mkCompulsoryUnfolding defaultSimpleOpts rhs
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
                        `setArityInfo`      arity
     ty  = mkInfForAllTys  [runtimeRep1TyVar,runtimeRep2TyVar,runtimeRep3TyVar
                           , multiplicityTyVar1, multiplicityTyVar2 ] $
@@ -1576,7 +1576,7 @@ coerceId :: Id
 coerceId = pcMiscPrelId coerceName ty info
   where
     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
-                       `setUnfoldingInfo`  mkCompulsoryUnfolding defaultSimpleOpts rhs
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
                        `setArityInfo`      2
     eqRTy     = mkTyConApp coercibleTyCon  [ tYPE_r,         a, b ]
     eqRPrimTy = mkTyConApp eqReprPrimTyCon [ tYPE_r, tYPE_r, a, b ]
@@ -1813,7 +1813,7 @@ voidPrimId :: Id     -- Global constant :: Void#
                      -- We cannot define it in normal Haskell, since it's
                      -- a top-level unlifted value.
 voidPrimId  = pcMiscPrelId voidPrimIdName unboxedUnitTy
-                (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts unboxedUnitExpr)
+                (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding unboxedUnitExpr)
 
 unboxedUnitExpr :: CoreExpr
 unboxedUnitExpr = Var (dataConWorkId unboxedUnitDataCon)
diff --git a/testsuite/tests/deSugar/should_compile/T19969.stderr b/testsuite/tests/deSugar/should_compile/T19969.stderr
index 3ded6f27a4..555a333349 100644
--- a/testsuite/tests/deSugar/should_compile/T19969.stderr
+++ b/testsuite/tests/deSugar/should_compile/T19969.stderr
@@ -16,7 +16,7 @@ g [InlPrag=INLINE (sat-args=1)] :: [Int] -> [Int]
  Arity=1,
  Str=<B>b,
  Cpr=b,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableUser, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=True)
          Tmpl= f}]
@@ -28,7 +28,7 @@ h [InlPrag=INLINE (sat-args=1)] :: [Int] -> [Int]
  Arity=1,
  Str=<B>b,
  Cpr=b,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableUser, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=True)
          Tmpl= f}]
diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr
index 9a1f79839d..3ff19d51ea 100644
--- a/testsuite/tests/deSugar/should_compile/T2431.stderr
+++ b/testsuite/tests/deSugar/should_compile/T2431.stderr
@@ -7,7 +7,7 @@ Result size of Tidy Core
 T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a
 [GblId[DataConWrapper],
  Caf=NoCafRefs,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=False)
          Tmpl= \ (@a) -> T2431.Refl @a @a @~(<a>_N :: a GHC.Prim.~# a)}]
@@ -64,8 +64,8 @@ T2431.$tc:~: :: GHC.Types.TyCon
 [GblId, Unf=OtherCon []]
 T2431.$tc:~:
   = GHC.Types.TyCon
-      4608886815921030019##
-      6030312177285011233##
+      4608886815921030019##64
+      6030312177285011233##64
       T2431.$trModule
       $tc:~:2
       0#
@@ -103,8 +103,8 @@ T2431.$tc'Refl :: GHC.Types.TyCon
 [GblId, Unf=OtherCon []]
 T2431.$tc'Refl
   = GHC.Types.TyCon
-      2478588351447975921##
-      2684375695874497811##
+      2478588351447975921##64
+      2684375695874497811##64
       T2431.$trModule
       $tc'Refl2
       1#
diff --git a/testsuite/tests/numeric/should_compile/T7116.stdout b/testsuite/tests/numeric/should_compile/T7116.stdout
index 90aeda659d..407a057855 100644
--- a/testsuite/tests/numeric/should_compile/T7116.stdout
+++ b/testsuite/tests/numeric/should_compile/T7116.stdout
@@ -45,7 +45,7 @@ dr :: Double -> Double
  Arity=1,
  Str=<1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (x [Occ=Once1!] :: Double) ->
@@ -73,7 +73,7 @@ fr :: Float -> Float
  Arity=1,
  Str=<1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (x [Occ=Once1!] :: Float) ->
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoRebox.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox.stderr
index ad82c9e16c..2be1c412df 100644
--- a/testsuite/tests/simplCore/should_compile/OpaqueNoRebox.stderr
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox.stderr
@@ -45,7 +45,7 @@ OpaqueNoRebox.$trModule
 -- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0}
 f [InlPrag=OPAQUE] :: (Int, Int) -> Int
 [GblId, Arity=1, Str=<1P(1L,1L)>, Unf=OtherCon []]
-f = / (ds :: (Int, Int)) ->
+f = \ (ds :: (Int, Int)) ->
       case ds of { (x, y) -> GHC.Num.$fNumInt_$c+ x y }
 
 -- RHS size: {terms: 19, types: 14, coercions: 0, joins: 0/0}
@@ -54,10 +54,10 @@ g [InlPrag=[2]] :: (Int, Int) -> Int
  Arity=1,
  Str=<1P(SL,SL)>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
-         Tmpl= / (p [Occ=Once1!] :: (Int, Int)) ->
+         Tmpl= \ (p [Occ=Once1!] :: (Int, Int)) ->
                  case p of wild { (x [Occ=Once1!], _ [Occ=Dead]) ->
                  case x of { GHC.Types.I# x1 [Occ=Once1] ->
                  case f (f wild, f wild) of { GHC.Types.I# y [Occ=Once1] ->
@@ -65,7 +65,7 @@ g [InlPrag=[2]] :: (Int, Int) -> Int
                  }
                  }
                  }}]
-g = / (p :: (Int, Int)) ->
+g = \ (p :: (Int, Int)) ->
       case p of wild { (x, ds1) ->
       case x of { GHC.Types.I# x1 ->
       case f (f wild, f wild) of { GHC.Types.I# y ->
@@ -73,3 +73,6 @@ g = / (p :: (Int, Int)) ->
       }
       }
       }
+
+
+
diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr
index 16189c6daa..1d4b3dd9fa 100644
--- a/testsuite/tests/simplCore/should_compile/T13143.stderr
+++ b/testsuite/tests/simplCore/should_compile/T13143.stderr
@@ -12,12 +12,12 @@ T13143.$wf = \ _ [Occ=Dead] (@a) -> T13143.$wf GHC.Prim.(##) @a
 end Rec }
 
 -- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
-f [InlPrag=[final]] :: forall a. Int -> a
+f [InlPrag=NOINLINE[final]] :: forall a. Int -> a
 [GblId,
  Arity=1,
  Str=<B>b,
  Cpr=b,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)
          Tmpl= \ (@a) _ [Occ=Dead] -> T13143.$wf GHC.Prim.(##) @a}]
@@ -94,7 +94,7 @@ g [InlPrag=[2]] :: Bool -> Bool -> Int -> Int
  Arity=3,
  Str=<1L><1L><1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
          Tmpl= \ (ds [Occ=Once1] :: Bool)
diff --git a/testsuite/tests/simplCore/should_compile/T18013.stderr b/testsuite/tests/simplCore/should_compile/T18013.stderr
index b94cec212b..719f70df19 100644
--- a/testsuite/tests/simplCore/should_compile/T18013.stderr
+++ b/testsuite/tests/simplCore/should_compile/T18013.stderr
@@ -139,7 +139,7 @@ mapMaybeRule [InlPrag=[2]]
 [GblId,
  Arity=1,
  Str=<1!P(L,LCS(C1(C1(P(L,1L)))))>,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (@a) (@b) (f [Occ=Once1!] :: Rule IO a b) ->
diff --git a/testsuite/tests/simplCore/should_compile/T18355.stderr b/testsuite/tests/simplCore/should_compile/T18355.stderr
index 6b7372c5af..a21a492b6d 100644
--- a/testsuite/tests/simplCore/should_compile/T18355.stderr
+++ b/testsuite/tests/simplCore/should_compile/T18355.stderr
@@ -1,25 +1,16 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 32, types: 23, coercions: 0, joins: 0/0}
+  = {terms: 32, types: 21, coercions: 0, joins: 0/0}
 
--- RHS size: {terms: 17, types: 10, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 17, types: 9, coercions: 0, joins: 0/0}
 f :: forall {a}. Num a => a -> Bool -> a -> a
 [GblId,
  Arity=4,
- Str=<S,1*U(1*C1(C1(U)),1*C1(C1(U)),A,A,A,A,A)><L,U><S,1*U><L,U>,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Str=<1P(MC1(C1(L)),MC1(C1(L)),A,A,A,A,A)><L><1L><L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
-         Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (@a)
-                 ($dNum [Occ=Once2] :: Num a)
-                 (x [Occ=Once2] :: a)
-                 (b [Occ=Once1!] :: Bool)
-                 (eta [Occ=Once2, OS=OneShot] :: a) ->
-                 case b of {
-                   False -> - @a $dNum x eta;
-                   True -> + @a $dNum x eta
-                 }}]
+         Guidance=IF_ARGS [60 0 70 0] 100 0}]
 f = \ (@a)
       ($dNum :: Num a)
       (x :: a)
diff --git a/testsuite/tests/simplCore/should_compile/T21261.hs b/testsuite/tests/simplCore/should_compile/T21261.hs
index 167d3f0f86..888c2fed13 100644
--- a/testsuite/tests/simplCore/should_compile/T21261.hs
+++ b/testsuite/tests/simplCore/should_compile/T21261.hs
@@ -1,3 +1,9 @@
+{-# OPTIONS_GHC -fno-worker-wrapper #-}
+
+-- The -fno-worker-wrapper stops f1, f2 etc from worker/wrappering
+-- via CPR analysis, after which they inline ane confuse the
+-- detection of eta-expansion or otherwise
+
 module T21261 where
 
 -- README: The convention here is that bindings starting with 'yes' should be
diff --git a/testsuite/tests/simplCore/should_compile/T21261.stderr b/testsuite/tests/simplCore/should_compile/T21261.stderr
index fadd73c219..6ed7bb9933 100644
--- a/testsuite/tests/simplCore/should_compile/T21261.stderr
+++ b/testsuite/tests/simplCore/should_compile/T21261.stderr
@@ -1,7 +1,7 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 139, types: 130, coercions: 0, joins: 0/0}
+  = {terms: 127, types: 120, coercions: 0, joins: 0/0}
 
 lvl = I# 3#
 
@@ -13,58 +13,49 @@ f2 = \ c -> case c lvl2 of { __DEFAULT -> c lvl lvl1 }
 
 yes1or2 = f2
 
-lvl3 = I# 2#
+lvl3 = I# 42#
 
-$wf4
+lvl4 = I# 2#
+
+f4
   = \ c ->
-      case c lvl2 lvl3 of { __DEFAULT ->
-      case c lvl lvl1 of { __DEFAULT -> 42# }
+      case c lvl2 lvl4 of { __DEFAULT ->
+      case c lvl lvl1 of { __DEFAULT -> lvl3 }
       }
 
-f4 = \ c -> case $wf4 c of ww { __DEFAULT -> I# ww }
-
-no3
-  = \ c ->
-      case $wf4 (\ x y z -> c x y z) of ww { __DEFAULT -> I# ww }
+no3 = \ c -> f4 (\ x y z -> c x y z)
 
-f6 = \ c -> case c lvl2 of { __DEFAULT -> c lvl3 lvl }
+f6 = \ c -> case c lvl2 of { __DEFAULT -> c lvl4 lvl }
 
 no_tricky = \ c -> f6 (\ x y -> c x y)
 
-$wf7 = \ c -> (# case c lvl2 of { __DEFAULT -> c lvl lvl1 } #)
-
-f7 = \ c -> case $wf7 c of { (# ww #) -> Just ww }
+f7 = \ c -> Just (case c lvl2 of { __DEFAULT -> c lvl lvl1 })
 
 no_tricky_lazy = \ c -> f7 (\ x y -> c x y)
 
-$wf5
+f5
   = \ c ->
-      (# case c lvl2 lvl3 of { I# x ->
+      Just
+        (case c lvl2 lvl4 of { I# x ->
          case c lvl lvl1 of { I# y -> I# (+# x y) }
-         } #)
-
-f5 = \ c -> case $wf5 c of { (# ww #) -> Just ww }
+         })
 
 yes2_lazy = f5
 
-$wf3
+f3
   = \ c ->
-      case c lvl2 lvl3 of { I# x ->
-      case c lvl lvl1 of { I# y -> +# x y }
+      case c lvl2 lvl4 of { I# x ->
+      case c lvl lvl1 of { I# y -> I# (+# x y) }
       }
 
-f3 = \ c -> case $wf3 c of ww { __DEFAULT -> I# ww }
-
 yes2 = f3
 
-$wf1
+f1
   = \ c ->
-      case c lvl2 lvl3 of { I# x ->
-      case c lvl lvl1 of { I# y -> +# x y }
+      case c lvl2 lvl4 of { I# x ->
+      case c lvl lvl1 of { I# y -> I# (+# x y) }
       }
 
-f1 = \ c -> case $wf1 c of ww { __DEFAULT -> I# ww }
-
 yes1 = f1
 
 
diff --git a/testsuite/tests/simplCore/should_compile/T3717.stderr b/testsuite/tests/simplCore/should_compile/T3717.stderr
index f131214132..5da8a9f302 100644
--- a/testsuite/tests/simplCore/should_compile/T3717.stderr
+++ b/testsuite/tests/simplCore/should_compile/T3717.stderr
@@ -58,7 +58,7 @@ foo [InlPrag=[2]] :: Int -> Int
  Arity=1,
  Str=<1!P(1L)>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (ds [Occ=Once1!] :: Int) ->
diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout
index 4a67fd8413..6faaab181a 100644
--- a/testsuite/tests/simplCore/should_compile/T3772.stdout
+++ b/testsuite/tests/simplCore/should_compile/T3772.stdout
@@ -62,12 +62,12 @@ T3772.$wfoo
       }
 
 -- RHS size: {terms: 9, types: 4, coercions: 0, joins: 0/0}
-foo [InlPrag=[final]] :: Int -> ()
+foo [InlPrag=NOINLINE[final]] :: Int -> ()
 [GblId,
  Arity=1,
  Str=<1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (n [Occ=Once1!] :: Int) ->
diff --git a/testsuite/tests/simplCore/should_compile/T4201.stdout b/testsuite/tests/simplCore/should_compile/T4201.stdout
index 920ae57662..68d0bc48fd 100644
--- a/testsuite/tests/simplCore/should_compile/T4201.stdout
+++ b/testsuite/tests/simplCore/should_compile/T4201.stdout
@@ -1,4 +1,4 @@
+  [HasNoCafRefs, TagSig: <TagProper>, LambdaFormInfo: LFReEntrant 1,
    Arity: 1, Strictness: <1!A>, CPR: 1,
-   Unfolding: (bof
-                 `cast`
-               (Sym (N:Foo[0]) %<'GHC.Types.Many>_N ->_R <T>_R))]
+   Unfolding: Core: <vanilla>
+              bof `cast` (Sym (N:Foo[0]) %<'GHC.Types.Many>_N ->_R <T>_R)]
diff --git a/testsuite/tests/simplCore/should_compile/T4908.stderr b/testsuite/tests/simplCore/should_compile/T4908.stderr
index 307c9fb728..a306a5a5e7 100644
--- a/testsuite/tests/simplCore/should_compile/T4908.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4908.stderr
@@ -61,7 +61,7 @@ f [InlPrag=[2]] :: Int -> (Int, Int) -> Bool
  Arity=2,
  Str=<1!P(1L)><MP(A,1P(1L))>,
  Cpr=2,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
          Tmpl= \ (ds [Occ=Once1!] :: Int) (x [Occ=Once1!] :: (Int, Int)) ->
diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr
index 413f892942..bc6bacdb40 100644
--- a/testsuite/tests/simplCore/should_compile/T4930.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4930.stderr
@@ -58,7 +58,7 @@ foo [InlPrag=[2]] :: Int -> Int
  Arity=1,
  Str=<1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (n [Occ=Once1!] :: Int) ->
diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr
index 345efa5a18..17eb1b5934 100644
--- a/testsuite/tests/simplCore/should_compile/T7360.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7360.stderr
@@ -9,7 +9,7 @@ T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo
  Arity=1,
  Caf=NoCafRefs,
  Str=<SL>,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (conrep [Occ=Once1!] :: Int) ->
@@ -27,12 +27,12 @@ T7360.$wfun1
   = \ (x :: Foo) -> case x of { __DEFAULT -> GHC.Prim.(##) }
 
 -- RHS size: {terms: 6, types: 2, coercions: 0, joins: 0/0}
-fun1 [InlPrag=[final]] :: Foo -> ()
+fun1 [InlPrag=NOINLINE[final]] :: Foo -> ()
 [GblId,
  Arity=1,
  Str=<1A>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (x [Occ=Once1] :: Foo) ->
@@ -54,7 +54,7 @@ fun2 :: forall {a}. [a] -> ((), Int)
  Arity=1,
  Str=<ML>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (@a) (x [Occ=Once1] :: [a]) ->
diff --git a/testsuite/tests/simplCore/should_compile/T7865.stdout b/testsuite/tests/simplCore/should_compile/T7865.stdout
index 1dd2c25893..c8758d3af1 100644
--- a/testsuite/tests/simplCore/should_compile/T7865.stdout
+++ b/testsuite/tests/simplCore/should_compile/T7865.stdout
@@ -1,6 +1,6 @@
 T7865.$wexpensive [InlPrag=NOINLINE]
 T7865.$wexpensive
-expensive [InlPrag=[final]] :: Int -> Int
+expensive [InlPrag=NOINLINE[final]] :: Int -> Int
                  case T7865.$wexpensive ww of ww1 [Occ=Once1] { __DEFAULT ->
 expensive
       case T7865.$wexpensive ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 }
diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index e0b2ad4962..8705eeacea 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -113,7 +113,7 @@ Roman.foo_go [InlPrag=[2]] :: Maybe Int -> Maybe Int -> Int
  Arity=2,
  Str=<1L><1L>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
          Tmpl= \ (u [Occ=Once1] :: Maybe Int)
@@ -145,7 +145,7 @@ foo :: Int -> Int
  Arity=1,
  Str=<1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (n [Occ=Once1!] :: Int) ->