Fix test outputs

16 files changed, 286 insertions, 125 deletions

diff --git a/compiler/GHC/Core/Opt/CSE.hs b/compiler/GHC/Core/Opt/CSE.hs
index b57952b91f..0876861203 100644
--- a/compiler/GHC/Core/Opt/CSE.hs
+++ b/compiler/GHC/Core/Opt/CSE.hs
@@ -14,7 +14,7 @@ import GHC.Types.Var.Env ( mkInScopeSet )
 import GHC.Types.Id     ( Id, idType, idHasRules, zapStableUnfolding
                         , idInlineActivation, setInlineActivation
                         , zapIdOccInfo, zapIdUsageInfo, idInlinePragma
-                        , isJoinId, isJoinId_maybe, idUnfolding, idHasInlineable )
+                        , isJoinId, isJoinId_maybe, idHasInlineable )
 import GHC.Core.Utils   ( mkAltExpr
                         , exprIsTickedString
                         , stripTicksE, stripTicksT, mkTicks )
diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
index 6385c6a1b9..82d84d0012 100644
--- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
@@ -35,7 +35,7 @@ import GHC.Core.DataCon
    , dataConRepArgTys, isUnboxedTupleDataCon
    , StrictnessMark (..) )
 import GHC.Core.Opt.Stats ( Tick(..) )
-import GHC.Core.Ppr     ( pprCoreExpr )
+import GHC.Core.Ppr
 import GHC.Core.Unfold
 import GHC.Core.Unfold.Make
 import GHC.Core.Utils
@@ -629,8 +629,8 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co)
                              DoneEx triv_rhs Nothing ) }
 
           else do { wrap_unf <- mkLetUnfolding uf_opts top_lvl VanillaSrc bndr triv_rhs
-                  ; let bndr' = bndr `setInlinePragma` mkCastWrapperInlinePrag (idInlinePragma bndr)
-                                `setIdUnfolding`  wrap_unf
+                  ; let bndr' = bndr  `setIdPragmaInfo` mkCastWrapperPragInfo (idPragmaInfo bndr)
+                                      `setIdUnfolding`  wrap_unf
                         floats' = floats `extendFloats` NonRec bndr' triv_rhs
                   ; return ( floats', setInScopeFromF env floats' ) } }
   where
@@ -666,20 +666,24 @@ tryCastWorkerWrapper env _ _ _ bndr rhs  -- All other bindings
                                    , text "rhs:" <+> ppr rhs ])
         ; return (mkFloatBind env (NonRec bndr rhs)) }
 
-mkCastWrapperInlinePrag :: InlinePragma -> InlinePragma
+mkCastWrapperPragInfo :: PragInfo -> PragInfo
 -- See Note [Cast worker/wrapper]
-mkCastWrapperInlinePrag (InlinePragma { inl_inline = fn_inl, inl_act = fn_act, inl_rule = rule_info })
-  = InlinePragma { inl_src    = SourceText "{-# INLINE"
-                 , inl_inline = fn_inl       -- See Note [Worker/wrapper for INLINABLE functions]
-                 , inl_sat    = Nothing      --     in GHC.Core.Opt.WorkWrap
-                 , inl_act    = wrap_act     -- See Note [Wrapper activation]
-                 , inl_rule   = rule_info }  --     in GHC.Core.Opt.WorkWrap
-                                -- RuleMatchInfo is (and must be) unaffected
+mkCastWrapperPragInfo prag_info
+  = mkPragInfo
+        InlinePragma { inl_src    = SourceText "{-# INLINE"
+                    , inl_inline = fn_inl       -- See Note [Worker/wrapper for INLINABLE functions]
+                    , inl_sat    = Nothing      --     in GHC.Core.Opt.WorkWrap
+                    , inl_act    = wrap_act     -- See Note [Wrapper activation]
+                    , inl_rule   = rule_info }  --     in GHC.Core.Opt.WorkWrap
+                                    -- RuleMatchInfo is (and must be) unaffected
+        (pragHasInlineable prag_info)
   where
     -- See Note [Wrapper activation] in GHC.Core.Opt.WorkWrap
     -- But simpler, because we don't need to disable during InitialPhase
     wrap_act | isNeverActive fn_act = activateDuringFinal
              | otherwise            = fn_act
+    InlinePragma { inl_inline = fn_inl, inl_act = fn_act, inl_rule = rule_info } = pragInfoInline prag_info
+
 
 
 {- *********************************************************************
@@ -4210,7 +4214,7 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf
 mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource
                -> InId -> OutExpr -> SimplM Unfolding
 mkLetUnfolding !uf_opts top_lvl src id new_rhs
-  = return (mkUnfolding uf_opts src is_top_lvl is_bottoming may_inline new_rhs Nothing)
+  = return (mkUnfolding uf_opts src is_top_lvl is_bottoming new_rhs Nothing)
             -- We make an  unfolding *even for loop-breakers*.
             -- Reason: (a) It might be useful to know that they are WHNF
             --         (b) In GHC.Iface.Tidy we currently assume that, if we want to
@@ -4223,7 +4227,6 @@ mkLetUnfolding !uf_opts top_lvl src id new_rhs
     !is_top_lvl   = isTopLevel top_lvl
     -- See Note [Force bottoming field]
     !is_bottoming = isDeadEndId id
-    !may_inline = not . isNoInlinePragma . idInlinePragma $ id
 
 -------------------
 simplStableUnfolding :: SimplEnv -> BindContext
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index ea700960ca..69ed8331f3 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -837,7 +837,6 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div
       -- (see Note [Don't w/w join points for CPR])
 
     work_id  = asWorkerLikeId $
-               modifyIdInfo (flip setHasInlineableInfo fn_has_inlineable) $
                mkWorkerId work_uniq fn_id (exprType work_rhs)
                 `setIdOccInfo` occInfo fn_info
                         -- Copy over occurrence info from parent
@@ -846,6 +845,7 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div
                         -- seems right-er to do so
 
                 `setInlinePragma` work_prag
+                `setHasInlineable` fn_has_inlineable
 
                 `setIdUnfolding` mkWorkerUnfolding simpl_opts work_fn fn_unfolding
                         -- See Note [Worker/wrapper for INLINABLE functions]
@@ -874,11 +874,14 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div
 
     wrap_rhs  = wrap_fn work_id
     wrap_prag = mkStrWrapperInlinePrag fn_inl_prag fn_rules
-    wrap_unf  = mkWrapperUnfolding simpl_opts wrap_rhs arity
+    wrap_unf  = mkWrapperUnfolding (simpleOptExpr simpl_opts wrap_rhs) arity
 
     wrap_id   = fn_id `setIdUnfolding`  wrap_unf
                       `setInlinePragma` wrap_prag
                       `setIdOccInfo`    noOccInfo
+                      -- We must keep hasInlineable to ensure wrappers can specialise
+                      -- if they are NOINLINE[final]
+                      `setHasInlineable`fn_has_inlineable
                         -- Zap any loop-breaker-ness, to avoid bleating from Lint
                         -- about a loop breaker with an INLINE rule
 
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index 374b2d7d97..9f7bb747b3 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -486,7 +486,10 @@ pprIdBndrInfo info
       (info `seq` doc) -- The seq is useful for poking on black holes
   where
     prag_info = inlinePragInfo info
-    keep_unf = inlineableInfo info
+    has_inlineable = inlineableInfo info &&
+                     isNoInlinePragma prag_info -- The flag is redundant
+                                                -- unless we have NOINLINE.
+
     occ_info  = occInfo info
     dmd_info  = demandInfo info
     lbv_info  = oneShotInfo info
@@ -498,8 +501,7 @@ pprIdBndrInfo info
 
     doc = showAttributes
           [ (has_prag, text "InlPrag=" <> pprInlineDebug prag_info)
-          -- Todo: This is only interesting for NoInline pragmas
-          , (keep_unf, text "Inlineable")
+          , (has_inlineable, text "Inlineable")
           , (has_occ,  text "Occ=" <> ppr occ_info)
           , (has_dmd,  text "Dmd=" <> ppr dmd_info)
           , (has_lbv , text "OS=" <> ppr lbv_info)
@@ -509,7 +511,7 @@ instance Outputable IdInfo where
   ppr info = showAttributes
     [ (has_prag,         text "InlPrag=" <> pprInlineDebug prag_info)
     -- Todo: This is only interesting for NoInline pragmas
-    , (keep_unf,         text "Inlineable")
+    , (has_inlineable,   text "Inlineable")
     , (has_occ,          text "Occ=" <> ppr occ_info)
     , (has_dmd,          text "Dmd=" <> ppr dmd_info)
     , (has_lbv ,         text "OS=" <> ppr lbv_info)
@@ -551,7 +553,9 @@ instance Outputable IdInfo where
       rules = ruleInfoRules (ruleInfo info)
       has_rules = not (null rules)
 
-      keep_unf = inlineableInfo info
+      has_inlineable = inlineableInfo info &&
+                       isNoInlinePragma prag_info -- The flag is redundant
+                                                  -- unless we have NOINLINE.
 
 
 {-
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index 7da73e423b..ba95baec64 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -759,7 +759,6 @@ add_info env old_bndr top_level new_rhs new_bndr
    unfolding_from_rhs = mkUnfolding uf_opts VanillaSrc
                                     (isTopLevel top_level)
                                     False -- may be bottom or not
-                                    True -- Allowed to inline
                                     new_rhs Nothing
 
 simpleUnfoldingFun :: IdUnfoldingFun
diff --git a/compiler/GHC/Core/Unfold/Make.hs b/compiler/GHC/Core/Unfold/Make.hs
index 2f054ad417..652833fcd0 100644
--- a/compiler/GHC/Core/Unfold/Make.hs
+++ b/compiler/GHC/Core/Unfold/Make.hs
@@ -44,21 +44,20 @@ import {-# SOURCE #-} GHC.Core.SimpleOpt
 
 
 
-mkFinalUnfolding :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> Bool -> CoreExpr -> Unfolding
+mkFinalUnfolding :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> CoreExpr -> Unfolding
 -- "Final" in the sense that this is a GlobalId that will not be further
 -- simplified; so the unfolding should be occurrence-analysed
-mkFinalUnfolding opts src strict_sig may_inline expr = mkFinalUnfolding' opts src strict_sig may_inline expr Nothing
+mkFinalUnfolding opts src strict_sig expr = mkFinalUnfolding' opts src strict_sig expr Nothing
 
 -- See Note [Tying the 'CoreUnfolding' knot] for why interfaces need
 -- to pass a precomputed 'UnfoldingCache'
-mkFinalUnfolding' :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> Bool -> CoreExpr -> Maybe UnfoldingCache -> Unfolding
+mkFinalUnfolding' :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> CoreExpr -> Maybe UnfoldingCache -> Unfolding
 -- "Final" in the sense that this is a GlobalId that will not be further
 -- simplified; so the unfolding should be occurrence-analysed
-mkFinalUnfolding' opts src strict_sig may_inline  expr
+mkFinalUnfolding' opts src strict_sig expr
   = mkUnfolding opts src
                 True {- Top level -}
                 (isDeadEndSig strict_sig)
-                may_inline
                 expr
 
 -- | Same as 'mkCompulsoryUnfolding' but simplifies the unfolding first
@@ -82,12 +81,12 @@ mkCompulsoryUnfolding expr
 -- | Make a regular compiler generated unfolding
 mkVanillaUnfolding :: UnfoldingOpts -> Bool -> Bool -> CoreExpr -> Unfolding
 mkVanillaUnfolding !opts is_top is_bottoming rhs
-  = mkUnfolding opts VanillaSrc is_top is_bottoming True rhs Nothing
+  = mkUnfolding opts VanillaSrc is_top is_bottoming rhs Nothing
 
 -- | Non top-lvl non-bottoming vanilla unfolding
 mkSimpleUnfolding :: UnfoldingOpts -> CoreExpr -> Unfolding
 mkSimpleUnfolding !opts rhs
-  = mkUnfolding opts VanillaSrc False False True rhs Nothing
+  = mkUnfolding opts VanillaSrc False False rhs Nothing
 
 mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding
 mkDFunUnfolding bndrs con ops
@@ -106,12 +105,12 @@ mkDataConUnfolding expr
                     , ug_unsat_ok  = unSaturatedOk
                     , ug_boring_ok = False }
 
-mkWrapperUnfolding :: SimpleOpts -> CoreExpr -> Arity -> Unfolding
+mkWrapperUnfolding :: CoreExpr -> Arity -> Unfolding
 -- Make the unfolding for the wrapper in a worker/wrapper split
 -- after demand/CPR analysis
-mkWrapperUnfolding opts expr arity
+mkWrapperUnfolding expr arity
   = mkCoreUnfolding StableSystemSrc True
-                    (simpleOptExpr opts expr) Nothing
+                    expr Nothing
                     (UnfWhen { ug_arity     = arity
                              , ug_unsat_ok  = unSaturatedOk
                              , ug_boring_ok = boringCxtNotOk })
@@ -162,9 +161,9 @@ mkInlineUnfoldingWithArity opts src arity expr
     boring_ok | arity == 0 = True
               | otherwise  = inlineBoringOk expr'
 
-mkInlinableUnfolding :: SimpleOpts -> UnfoldingSource -> Bool -> CoreExpr -> Unfolding
-mkInlinableUnfolding opts src may_inline expr
-  = mkUnfolding (so_uf_opts opts) src False False may_inline expr' Nothing
+mkInlinableUnfolding :: SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfolding
+mkInlinableUnfolding opts src expr
+  = mkUnfolding (so_uf_opts opts) src False False expr' Nothing
   where
     expr' = simpleOptExpr opts expr
 
@@ -327,19 +326,16 @@ mkUnfolding :: UnfoldingOpts
             -> Bool       -- ^ Is top-level
             -> Bool       -- ^ Definitely a bottoming binding
                           -- (only relevant for top-level bindings)
-            -> Bool       -- ^ Allow inlining, False <=> UnfNever guidance
             -> CoreExpr
             -> Maybe UnfoldingCache
             -> Unfolding
 -- Calculates unfolding guidance
 -- Occurrence-analyses the expression before capturing it
-mkUnfolding opts src top_lvl is_bottoming may_inline expr cache
+mkUnfolding opts src top_lvl is_bottoming expr cache
   = mkCoreUnfolding src top_lvl expr cache guidance
   where
     is_top_bottoming = top_lvl && is_bottoming
-    guidance
-      | may_inline = calcUnfoldingGuidance opts is_top_bottoming expr
-      | otherwise = UnfNever
+    guidance = calcUnfoldingGuidance opts is_top_bottoming expr
         -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))!
         -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]
 
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 30c9a48414..4479d9659c 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -340,7 +340,7 @@ dsAbsBinds dflags tyvars dicts exports
                            -- The type checker put the inline pragma
                            -- on the *global* Id, so we need to transfer it
     inline_env
-      = mkVarEnv [ (lcl_id, setPragmaInfo lcl_id prag)
+      = mkVarEnv [ (lcl_id, setIdPragmaInfo lcl_id prag)
                  | ABE { abe_mono = lcl_id, abe_poly = gbl_id } <- exports
                  , let prag = idPragmaInfo gbl_id ]
 
@@ -405,7 +405,9 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
     prag_info     = idPragmaInfo gbl_id
     keep_unf      = pragHasInlineable prag_info
     inline_prag   = pragInfoInline prag_info
-    inlinable_unf may_inline = mkInlinableUnfolding simpl_opts StableUserSrc may_inline rhs
+    inlinable_unf may_inline
+        | may_inline = mkInlinableUnfolding simpl_opts StableUserSrc rhs
+        | otherwise = mkInlinableUnfolding simpl_opts StableUserNoInlineSrc rhs
     inline_pair
        | Just arity <- inlinePragmaSat inline_prag
         -- Add an Unfolding for an INLINE (but not for NOINLINE)
@@ -720,7 +722,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
              simpl_opts = initSimpleOpts dflags
              spec_unf   = specUnfolding simpl_opts spec_bndrs core_app rule_lhs_args fn_unf
              spec_id    = mkLocalId spec_name ManyTy spec_ty -- Specialised binding is toplevel, hence Many.
-                            `setPragmaInfo` spec_prag_info
+                            `setIdPragmaInfo` spec_prag_info
                             `setIdUnfolding`  spec_unf
 
              rule = mkSpecRule dflags this_mod RuleSrcUser rule_act (text "USPEC")
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 609fc95380..cb5458899a 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -1243,7 +1243,7 @@ tidyTopIdInfo rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold
         `setDmdSigInfo`      final_sig
         `setCprSigInfo`      final_cpr
         `setOccInfo`         robust_occ_info
-        `setPragInfo`        pragInfo idinfo
+        `setPragInfo`        prag_info
         `setUnfoldingInfo`   unfold_info
                 -- NB: we throw away the Rules
                 -- They have already been extracted by findExternalRules
@@ -1281,6 +1281,7 @@ tidyTopIdInfo rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold
           Nothing            -> False
           Just (arity, _, _) -> not (isDeadEndAppSig id_sig arity)
 
+    prag_info = mkPragInfo (inlinePragInfo idinfo) (inlineableInfo idinfo)
     --------- Unfolding ------------
     -- Force unfold_info (hence bangs), otherwise the old unfolding
     -- is retained during code generation. See #22071
@@ -1296,6 +1297,8 @@ tidyTopIdInfo rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold
      -- else you get a black hole (#22122). Reason: mkFinalUnfolding
      -- looks at IdInfo, and that is knot-tied in tidyTopBind (the Rec case)
 
+
+
     --------- Arity ------------
     -- Usually the Id will have an accurate arity on it, because
     -- the simplifier has just run, but not always.
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 2961fa10cf..4163d06f6f 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -56,7 +56,7 @@ import GHC.Core.TyCo.Rep( mkNakedFunTy )
 
 import GHC.Types.Error
 import GHC.Types.Var ( TyVar, Specificity(..), tyVarKind, binderVars, invisArgTypeLike )
-import GHC.Types.Id  ( Id, idName, idType, setPragmaInfo
+import GHC.Types.Id  ( Id, idName, idType, setIdPragmaInfo
                      , mkLocalId, realIdUnfolding )
 import GHC.Types.Id.Info
 import GHC.Types.Basic
@@ -669,7 +669,7 @@ addInlinePrags poly_id prags_for_me
             Nothing -> do warn_multiple_inlines inl inls
                           return init_info
 
-       ; return (poly_id `setPragmaInfo` prag_info) }
+       ; return (poly_id `setIdPragmaInfo` prag_info) }
   | otherwise
   = return poly_id
   where
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index edf847ba92..253431ca6a 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -99,7 +99,7 @@ module GHC.Types.Basic (
         pprInline, pprInlineDebug,
 
         UnfoldingSource(..), isStableSource, isStableUserSource,
-        isStableSystemSource, isCompulsorySource,
+        isStableSystemSource, isCompulsorySource, isNoInlineSource,
 
         SuccessFlag(..), succeeded, failed, successIf,
 
@@ -1829,7 +1829,8 @@ data UnfoldingSource
                        -- Replace uf_tmpl each time around
 
   -- See Note [Stable unfoldings] in GHC.Core
-  | StableUserSrc   -- From a user-specified INLINE or INLINABLE pragma
+  | StableUserSrc   -- From a regular user-specified INLINE or INLINABLE pragma
+  | StableUserNoInlineSrc  -- Like above, but should never be inlined automatically
   | StableSystemSrc -- From a wrapper, or system-generated unfolding
 
   | CompulsorySrc   -- Something that *has* no binding, so you *must* inline it
@@ -1837,9 +1838,11 @@ data UnfoldingSource
                     -- (see "GHC.Types.Id.Make", calls to mkCompulsoryUnfolding).
                     -- Inline absolutely always, however boring the context.
 
+-- | NB: This might still be a NOINLINE unfolding
 isStableUserSource :: UnfoldingSource -> Bool
-isStableUserSource StableUserSrc = True
-isStableUserSource _             = False
+isStableUserSource StableUserSrc      = True
+isStableUserSource StableUserNoInlineSrc = True
+isStableUserSource _                  = False
 
 isStableSystemSource :: UnfoldingSource -> Bool
 isStableSystemSource StableSystemSrc = True
@@ -1850,29 +1853,37 @@ isCompulsorySource CompulsorySrc = True
 isCompulsorySource _             = False
 
 isStableSource :: UnfoldingSource -> Bool
-isStableSource CompulsorySrc   = True
-isStableSource StableSystemSrc = True
-isStableSource StableUserSrc   = True
-isStableSource VanillaSrc      = False
+isStableSource CompulsorySrc      = True
+isStableSource StableSystemSrc    = True
+isStableSource StableUserSrc      = True
+isStableSource StableUserNoInlineSrc = True
+isStableSource VanillaSrc         = False
+
+isNoInlineSource :: UnfoldingSource -> Bool
+isNoInlineSource StableUserNoInlineSrc = True
+isNoInlineSource _                  = 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
+    put_ bh CompulsorySrc       = putByte bh 0
+    put_ bh StableUserSrc       = putByte bh 1
+    put_ bh StableUserNoInlineSrc  = putByte bh 2
+    put_ bh StableSystemSrc     = putByte bh 3
+    put_ bh VanillaSrc          = putByte bh 4
     get bh = do
         h <- getByte bh
         case h of
             0 -> return CompulsorySrc
             1 -> return StableUserSrc
-            2 -> return StableSystemSrc
+            2 -> return StableUserNoInlineSrc
+            3 -> return StableSystemSrc
             _ -> return VanillaSrc
 
 instance Outputable UnfoldingSource where
-  ppr CompulsorySrc     = text "Compulsory"
-  ppr StableUserSrc     = text "StableUser"
-  ppr StableSystemSrc   = text "StableSystem"
-  ppr VanillaSrc        = text "<vanilla>"
+  ppr CompulsorySrc       = text "Compulsory"
+  ppr StableUserSrc       = text "StableUser"
+  ppr StableUserNoInlineSrc  = text "StableUserNoInl"
+  ppr StableSystemSrc     = text "StableSystem"
+  ppr VanillaSrc          = text "<vanilla>"
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
index bdc3d64919..f186fc3c5b 100644
--- a/compiler/GHC/Types/Id.hs
+++ b/compiler/GHC/Types/Id.hs
@@ -82,7 +82,8 @@ module GHC.Types.Id (
         asJoinId, asJoinId_maybe, zapJoinId,
 
         -- ** Inline pragma stuff
-        idPragmaInfo, idInlinePragma, idHasInlineable, setInlinePragma, setPragmaInfo, modifyInlinePragma,
+        idPragmaInfo, idInlinePragma, idHasInlineable, setInlinePragma,
+        setIdPragmaInfo, modifyInlinePragma, setHasInlineable,
         idInlineActivation, setInlineActivation, idRuleMatchInfo,
 
         -- ** One-shot lambdas
@@ -174,7 +175,8 @@ infixl  1 `setIdUnfolding`,
 
           `setIdSpecialisation`,
           `setInlinePragma`,
-          `setPragmaInfo`,
+          `setHasInlineable`,
+          `setIdPragmaInfo`,
           `setInlineActivation`,
           `idCafInfo`,
 
@@ -903,8 +905,11 @@ idPragmaInfo id = pragInfo (idInfo id)
 setInlinePragma :: Id -> InlinePragma -> Id
 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
 
-setPragmaInfo :: Id -> PragInfo -> Id
-setPragmaInfo id pragInfo = modifyIdInfo (`setPragInfo` pragInfo) id
+setHasInlineable :: Id -> Bool -> Id
+setHasInlineable id inlineable = modifyIdInfo (`setHasInlineableInfo` inlineable) id
+
+setIdPragmaInfo :: Id -> PragInfo -> Id
+setIdPragmaInfo id pragInfo = modifyIdInfo (`setPragInfo` pragInfo) id
 
 modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id
 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
diff --git a/testsuite/tests/simplCore/should_compile/T15445.hs b/testsuite/tests/simplCore/should_compile/T15445.hs
index 36bf61dbbb..79c094056c 100644
--- a/testsuite/tests/simplCore/should_compile/T15445.hs
+++ b/testsuite/tests/simplCore/should_compile/T15445.hs
@@ -2,7 +2,7 @@ module T15445 where
 
 import T15445a
 
-
+-- The core dump should contain a call to the specialization of plusTwoRec and plusTwoRec'
 foo :: IO ()
 foo = do { print (plusTwoRec [1..10 :: Int])
          ; print (plusTwoRec' [1..20 :: Int]) }
diff --git a/testsuite/tests/simplCore/should_compile/T20103.stderr b/testsuite/tests/simplCore/should_compile/T20103.stderr
index c0f04a0ead..46d8fed6cb 100644
--- a/testsuite/tests/simplCore/should_compile/T20103.stderr
+++ b/testsuite/tests/simplCore/should_compile/T20103.stderr
@@ -31,8 +31,9 @@ lvl4 = GHC.CString.unpackCString# lvl3
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T20103.$trModule2 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 30 0}]
 T20103.$trModule2 = "T20103"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
@@ -43,8 +44,9 @@ lvl5 = GHC.CString.unpackCString# T20103.$trModule2
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T20103.$trModule4 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
 T20103.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
@@ -167,8 +169,8 @@ foo [InlPrag=[2]] :: HasCallStack => Int -> Int
  Arity=2,
  Str=<SL><1!P(1L)>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=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= \ ($dIP [Occ=Once1] :: HasCallStack)
                  (eta [Occ=Once1!] :: Int) ->
@@ -186,22 +188,25 @@ foo
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T20103.$trModule3 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T20103.$trModule3 = GHC.Types.TrNameS T20103.$trModule4
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T20103.$trModule1 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T20103.$trModule1 = GHC.Types.TrNameS T20103.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T20103.$trModule :: GHC.Types.Module
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T20103.$trModule
   = GHC.Types.Module T20103.$trModule3 T20103.$trModule1
 
diff --git a/testsuite/tests/simplCore/should_compile/T22629d.hs b/testsuite/tests/simplCore/should_compile/T22629d.hs
index a138b04b85..a0cf52bc57 100644
--- a/testsuite/tests/simplCore/should_compile/T22629d.hs
+++ b/testsuite/tests/simplCore/should_compile/T22629d.hs
@@ -4,10 +4,8 @@ import Data.List.NonEmpty as NE
 
 import T22629d_Lib
 
--- getNumbers should get a specialization here.
--- As a result this while binding will optimize to just 42
--- so that's what the test checks for.
-
+-- getNumbers should get a specialization and W/Wed here.
+-- So we check specialise output for $s$wgetNumbers
 {-# NOINLINE foo #-}
 foo = NE.head getNumbers :: Int
 
diff --git a/testsuite/tests/simplCore/should_compile/T22629d.stderr b/testsuite/tests/simplCore/should_compile/T22629d.stderr
index c598677629..866cd782d9 100644
--- a/testsuite/tests/simplCore/should_compile/T22629d.stderr
+++ b/testsuite/tests/simplCore/should_compile/T22629d.stderr
@@ -1,56 +1,188 @@
 [1 of 2] Compiling T22629d_Lib      ( T22629d_Lib.hs, T22629d_Lib.o )
 
-==================== Tidy Core ====================
-Result size of Tidy Core
-  = {terms: 51, types: 67, coercions: 0, joins: 0/1}
-
-lvl = IS 42#
+==================== Specialise ====================
+Result size of Specialise
+  = {terms: 34, types: 29, coercions: 0, joins: 0/1}
 
 Rec {
+-- RHS size: {terms: 19, types: 19, coercions: 0, joins: 0/1}
+getNumbers [InlPrag=NOINLINE, Inlineable, Occ=LoopBreaker]
+  :: forall a. Num a => NonEmpty a
+[LclIdX,
+ Arity=1,
+ Unf=Unf{Src=StableUserNoInl, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [30] 110 10
+         Tmpl= \ (@a) ($dNum :: Num a) ->
+                 GHC.Base.:|
+                   @a
+                   (fromInteger @a $dNum (GHC.Num.Integer.IS 42#))
+                   (let {
+                      ds :: NonEmpty a
+                      [LclId,
+                       Unf=Unf{Src=<vanilla>, TopLvl=False,
+                               Value=False, ConLike=False, WorkFree=False, Expandable=True,
+                               Guidance=IF_ARGS [] 20 0}]
+                      ds = getNumbers @a $dNum } in
+                    GHC.Types.:
+                      @a
+                      (case ds of { :| a1 [Occ=Once1] _ [Occ=Dead] -> a1 })
+                      (case ds of { :| _ [Occ=Dead] as [Occ=Once1] -> as }))}]
 getNumbers
-  = \ @a $dNum ->
-      case $wgetNumbers $dNum of { (# ww, ww1 #) -> :| ww ww1 }
-
-$wgetNumbers
-  = \ @a $dNum ->
-      (# fromInteger $dNum lvl,
-         let {
-           ds = case $wgetNumbers $dNum of { (# ww, ww1 #) -> :| ww ww1 } } in
-         : (case ds of { :| a1 as -> a1 })
-           (case ds of { :| a1 as -> as }) #)
+  = \ (@a) ($dNum :: Num a) ->
+      GHC.Base.:|
+        @a
+        (fromInteger @a $dNum (GHC.Num.Integer.IS 42#))
+        (let {
+           ds :: NonEmpty a
+           [LclId,
+            Unf=Unf{Src=<vanilla>, TopLvl=False,
+                    Value=False, ConLike=False, WorkFree=False, Expandable=True,
+                    Guidance=IF_ARGS [] 20 0}]
+           ds = getNumbers @a $dNum } in
+         GHC.Types.:
+           @a (case ds of { :| a1 as -> a1 }) (case ds of { :| a1 as -> as }))
 end Rec }
 
-$trModule4 = "main"#
-
-$trModule3 = TrNameS $trModule4
-
-$trModule2 = "T22629d_Lib"#
-
-$trModule1 = TrNameS $trModule2
-
-$trModule = Module $trModule3 $trModule1
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule :: Addr#
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
+$trModule = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule :: GHC.Types.TrName
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+$trModule = GHC.Types.TrNameS $trModule
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule :: Addr#
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 40 0}]
+$trModule = "T22629d_Lib"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule :: GHC.Types.TrName
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+$trModule = GHC.Types.TrNameS $trModule
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T22629d_Lib.$trModule :: GHC.Types.Module
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+T22629d_Lib.$trModule = GHC.Types.Module $trModule $trModule
 
 
 
 [2 of 2] Compiling T22629d          ( T22629d.hs, T22629d.o )
 
-==================== Tidy Core ====================
-Result size of Tidy Core
-  = {terms: 19, types: 7, coercions: 0, joins: 0/0}
-
-$trModule2 = "T22629d"#
+==================== Specialise ====================
+Result size of Specialise
+  = {terms: 46, types: 52, coercions: 0, joins: 0/1}
 
-$trModule1 = TrNameS $trModule2
-
-$trModule4 = "main"#
-
-$trModule3 = TrNameS $trModule4
-
-$trModule = Module $trModule3 $trModule1
-
-lvl = I# 42#
-
-foo = lvl
+Rec {
+-- RHS size: {terms: 17, types: 20, coercions: 0, joins: 0/1}
+$s$wgetNumbers [InlPrag=[~]] :: (# #) -> (# Int, [Int] #)
+[LclId, Arity=1]
+$s$wgetNumbers
+  = \ (void :: (# #)) ->
+      (# GHC.Num.$fNumInt_$cfromInteger (GHC.Num.Integer.IS 42#),
+         let {
+           ds :: NonEmpty Int
+           [LclId,
+            Unf=Unf{Src=<vanilla>, TopLvl=False,
+                    Value=False, ConLike=False, WorkFree=False, Expandable=True,
+                    Guidance=IF_ARGS [] 20 0}]
+           ds = getNumbers @Int GHC.Num.$fNumInt } in
+         GHC.Types.:
+           @Int
+           (case ds of { :| a1 [Occ=Once1] _ [Occ=Dead] -> a1 })
+           (case ds of { :| _ [Occ=Dead] as [Occ=Once1] -> as }) #)
+
+-- RHS size: {terms: 7, types: 11, coercions: 0, joins: 0/0}
+$sgetNumbers [InlPrag=NOINLINE[final]] :: NonEmpty Int
+[LclId,
+ Unf=Unf{Src=StableSystem, TopLvl=True,
+         Value=False, ConLike=False, WorkFree=False, Expandable=False,
+         Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=False)
+         Tmpl= case T22629d_Lib.$wgetNumbers @Int GHC.Num.$fNumInt of
+               { (# ww [Occ=Once1], ww1 [Occ=Once1] #) ->
+               GHC.Base.:| @Int ww ww1
+               }}]
+$sgetNumbers
+  = case T22629d_Lib.$wgetNumbers @Int GHC.Num.$fNumInt of
+    { (# ww [Occ=Once1], ww1 [Occ=Once1] #) ->
+    GHC.Base.:| @Int ww ww1
+    }
+end Rec }
 
+-- RHS size: {terms: 5, types: 6, coercions: 0, joins: 0/0}
+foo [InlPrag=NOINLINE] :: Int
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=False, ConLike=False, WorkFree=False, Expandable=False,
+         Guidance=IF_ARGS [] 30 0}]
+foo = case getNumbers @Int GHC.Num.$fNumInt of { :| a1 ds1 -> a1 }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule :: GHC.Prim.Addr#
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
+$trModule = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule :: GHC.Types.TrName
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+$trModule = GHC.Types.TrNameS $trModule
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule :: GHC.Prim.Addr#
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 30 0}]
+$trModule = "T22629d"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule :: GHC.Types.TrName
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+$trModule = GHC.Types.TrNameS $trModule
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T22629d.$trModule :: GHC.Types.Module
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+T22629d.$trModule = GHC.Types.Module $trModule $trModule
+
+
+------ Local rules for imported ids --------
+"SPEC/T22629d $wgetNumbers @Int" [final]
+    forall ($dNum :: Num Int).
+      T22629d_Lib.$wgetNumbers @Int $dNum
+      = $s$wgetNumbers GHC.Prim.void#
+"SPEC/T22629d getNumbers @Int" [final]
+    forall ($dNum :: Num Int). getNumbers @Int $dNum = $sgetNumbers
 
 
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 7e21265938..2e5c66afb4 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -464,4 +464,4 @@ test('T22623', normal, multimod_compile, ['T22623', '-O -v0'])
 test('T22629a', normal, compile, [''])
 test('T22629b', normal, compile, [''])
 test('T22629c', normal, compile, [''])
-test('T22629d', [grep_errmsg(r'I# 42')], multimod_compile, ['T22629d', '-O -ddump-simpl -dsuppress-uniques -dsuppress-all'])
+test('T22629d', [grep_errmsg(r'\$s\$wgetNumbers')], multimod_compile, ['T22629d', '-O -ddump-spec -dsuppress-uniques'])