Allow combination of NOINLINE/INLINEABLE.

We do this by also tracking INLINEABLE outside of the Unfolding data
type as it's own flag.

In the proccess of this I made a few other smaller changes.

* Allow NOINLINE bindings to specialise with -fspecialise-aggressively.
  Fixes #21036
* Made rule source a proper type instead of Bool.

-------------------------
Metric Decrease:
    T14766
    T18304
Metric Increase:
    T10359
    T13386
    T15263
-------------------------

39 files changed, 458 insertions, 117 deletions

diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index 92b34ffc21..23306a29d0 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -1134,7 +1134,8 @@ data CoreRule
                                         -- See Note [OccInfo in unfoldings and rules]
 
         -- Locality
-        ru_auto :: Bool,   -- ^ @True@  <=> this rule is auto-generated
+        ru_auto :: RuleSource,
+                           -- ^ @True@  <=> this rule is auto-generated
                            --               (notably by Specialise or SpecConstr)
                            --   @False@ <=> generated at the user's behest
                            -- See Note [Trimming auto-rules] in "GHC.Iface.Tidy"
@@ -1187,7 +1188,10 @@ isBuiltinRule _                = False
 
 isAutoRule :: CoreRule -> Bool
 isAutoRule (BuiltinRule {}) = False
-isAutoRule (Rule { ru_auto = is_auto }) = is_auto
+isAutoRule (Rule { ru_auto = is_auto }) =
+  case is_auto of
+    RuleSrcAuto -> True
+    RuleSrcUser -> False
 
 -- | The number of arguments the 'ru_fn' must be applied
 -- to before the rule can match on it
@@ -1273,7 +1277,7 @@ data Unfolding
   | CoreUnfolding {             -- An unfolding for an Id with no pragma,
                                 -- or perhaps a NOINLINE pragma
                                 -- (For NOINLINE, the phase, if any, is in the
-                                -- InlinePragInfo for this Id.)
+                                -- PragInfo for this Id.)
         uf_tmpl       :: CoreExpr,        -- Template; occurrence info is correct
         uf_src        :: UnfoldingSource, -- Where the unfolding came from
         uf_is_top     :: Bool,          -- True <=> top level binding
@@ -1340,7 +1344,7 @@ data UnfoldingGuidance
     }                     -- a context (case (thing args) of ...),
                           -- (where there are the right number of arguments.)
 
-  | UnfNever        -- The RHS is big, so don't inline it
+  | UnfNever        -- The RHS is big or marked NOINLINE so don't inline it
   deriving (Eq)
 
 {- Note [UnfoldingCache]
diff --git a/compiler/GHC/Core/Opt/CSE.hs b/compiler/GHC/Core/Opt/CSE.hs
index 2f7718709a..b57952b91f 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 )
+                        , isJoinId, isJoinId_maybe, idUnfolding, idHasInlineable )
 import GHC.Core.Utils   ( mkAltExpr
                         , exprIsTickedString
                         , stripTicksE, stripTicksT, mkTicks )
@@ -225,7 +225,7 @@ is small).  The conclusion here is this:
   really was <rhs>.
 
 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
+WorkWrap (see Note [Wrapper activation]). We can tell because isNoUserInlineSpec
 is then true.
 
 Note that we do not (currently) do CSE on the unfolding stored inside
@@ -233,7 +233,7 @@ an Id, even if it is a 'stable' unfolding.  That means that when an
 unfolding happens, it is always faithful to what the stable unfolding
 originally was.
 
-Note [CSE for stable unfoldings]
+Note [CSE for INLINEABLE unfoldings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
    {-# Unf = Stable (\pq. build blah) #-}
@@ -264,8 +264,7 @@ Wrinkles
   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.
+  idHasInlineable rather than isStableUnfolding.
 
 * Consider
      foo = <expr>
@@ -510,13 +509,12 @@ extendCSEnvWithBinding env in_id out_id rhs' cse_done
 noCSE :: InId -> Bool
 noCSE id
   | isJoinId id                = no_cse  -- See Note [CSE for join points?]
-  | isStableUserUnfolding  unf = no_cse  -- See Note [CSE for stable unfoldings]
+  | idHasInlineable id         = no_cse  -- See Note [CSE for INLINEABLE 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)))
+                            && not (isNoUserInlineSpec (inlinePragmaSpec (idInlinePragma id)))
      yes_cse = False
      no_cse  = True
 
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 7b7b439e33..2eed519d3c 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -561,7 +561,7 @@ transferIdInfo exported_id local_id
     transfer exp_info = exp_info `setDmdSigInfo`     dmdSigInfo local_info
                                  `setCprSigInfo`     cprSigInfo local_info
                                  `setUnfoldingInfo`  realUnfoldingInfo local_info
-                                 `setInlinePragInfo` inlinePragInfo local_info
+                                 `setPragInfo`       pragInfo local_info
                                  `setRuleInfo`       addRuleInfo (ruleInfo exp_info) new_info
     new_info = setRuleInfoHead (idName exported_id)
                                (ruleInfo local_info)
diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
index d8b95e7358..6385c6a1b9 100644
--- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
@@ -644,7 +644,7 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co)
     work_info = vanillaIdInfo `setDmdSigInfo`     dmdSigInfo info
                               `setCprSigInfo`     cprSigInfo info
                               `setDemandInfo`     demandInfo info
-                              `setInlinePragInfo` inlinePragInfo info
+                              `setPragInfo`       pragInfo info
                               `setArityInfo`      work_arity
            -- We do /not/ want to transfer OccInfo, Rules
            -- Note [Preserve strictness in cast w/w]
@@ -4210,7 +4210,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 new_rhs Nothing)
+  = return (mkUnfolding uf_opts src is_top_lvl is_bottoming may_inline 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,6 +4223,7 @@ 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/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 25a7779274..5883c67bc9 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -2193,7 +2193,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 VanillaSrc is_top_lvl False poly_rhs Nothing
+        unf = mkVanillaUnfolding uf_opts is_top_lvl False poly_rhs
 
         -- We want the unfolding.  Consider
         --      let
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs
index 157cec6e49..91c61c7bbd 100644
--- a/compiler/GHC/Core/Opt/SpecConstr.hs
+++ b/compiler/GHC/Core/Opt/SpecConstr.hs
@@ -1960,7 +1960,7 @@ spec_one env fn arg_bndrs body (call_pat, rule_number)
                               dropTail (length extra_bndrs) spec_call_args
               inline_act = idInlineActivation fn
               this_mod   = sc_module $ sc_opts env
-              rule       = mkRule this_mod True {- Auto -} True {- Local -}
+              rule       = mkRule this_mod RuleSrcAuto {- Auto -} True {- Local -}
                                   rule_name inline_act
                                   fn_name qvars' pats' rule_rhs
                            -- See Note [Transfer activation]
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index dda10da34e..73024ed79b 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -24,6 +24,7 @@ import GHC.Core.Opt.Monad
 import qualified GHC.Core.Subst as Core
 import GHC.Core.Unfold.Make
 import GHC.Core
+-- import GHC.Core.Ppr
 import GHC.Core.Make      ( mkLitRubbish )
 import GHC.Core.Unify     ( tcMatchTy )
 import GHC.Core.Rules
@@ -715,7 +716,7 @@ specialisation (see canSpecImport):
 
 (2) Without -fspecialise-aggressively, specialise only imported things
     that have a /user-supplied/ INLINE or INLINABLE pragma (hence
-    isAnyInlinePragma rather than isStableSource).
+    isAnyInlinePragma || idHasInlineable rather than isStableSource).
 
     In particular, we don't want to specialise workers created by
     worker/wrapper (for functions with no pragma) because they won't
@@ -791,7 +792,8 @@ spec_import :: SpecEnv               -- Passed in so that all top-level Ids are
                      , [CoreBind] )  -- Specialised bindings
 spec_import env callers dict_binds cis@(CIS fn _)
   | isIn "specImport" fn callers
-  = return (env, [], [])  -- No warning.  This actually happens all the time
+  = -- pprTrace "spec_import.1" (ppr (fn,callers)) $
+    return (env, [], [])  -- No warning.  This actually happens all the time
                           -- when specialising a recursive function, because
                           -- the RHS of the specialised function contains a recursive
                           -- call to the original function
@@ -799,7 +801,9 @@ spec_import env callers dict_binds cis@(CIS fn _)
   | null good_calls
   = return (env, [], [])
 
-  | Just rhs <- canSpecImport dflags fn
+  | r <- canSpecImport dflags fn
+  -- , pprTrace "canSpecImport.2" (ppr (fn, r)) True
+  , Just rhs <- r
   = do {     -- Get rules from the external package state
              -- We keep doing this in case we "page-fault in"
              -- more rules as we go along
@@ -850,8 +854,9 @@ canSpecImport dflags fn
               -- have dict args; there is no benefit.
 
   | CoreUnfolding { uf_tmpl = rhs } <- unf
+  -- , pprTrace "canSpecImport" (ppr (fn, idHasInlineable fn, unf)) True
     -- CoreUnfolding: see Note [Specialising imported functions] point (1).
-  , isAnyInlinePragma (idInlinePragma fn)
+  , isAnyInlinePragma (idInlinePragma fn) || idHasInlineable fn
     -- See Note [Specialising imported functions] point (2).
   = Just rhs
 
@@ -880,7 +885,9 @@ tryWarnMissingSpecs dflags callers fn calls_for_fn
   | wopt Opt_WarnAllMissedSpecs dflags    = doWarn $ WarningWithFlag Opt_WarnAllMissedSpecs
   | otherwise                             = return ()
   where
-    allCallersInlined = all (isAnyInlinePragma . idInlinePragma) callers
+    allCallersInlined = all (\caller -> isAnyInlinePragma (idInlinePragma caller) ||
+                                        idHasInlineable caller)
+                            callers
     diag_opts = initDiagOpts dflags
     doWarn reason =
       msg (mkMCDiagnostic diag_opts reason Nothing)
@@ -1155,6 +1162,13 @@ specVar env@(SE { se_subst = Core.Subst in_scope ids _ _ }) v
 specExpr :: SpecEnv -> CoreExpr -> SpecM (CoreExpr, UsageDetails)
 
 ---------------- First the easy cases --------------------
+-- specExpr env e
+--   | pprTrace "specExpr" (
+--       ppr e
+--       -- ppr env
+--       )
+--     False
+--   = undefined
 specExpr env (Var v)       = specVar env v
 specExpr env (Type ty)     = return (Type     (substTy env ty), emptyUDs)
 specExpr env (Coercion co) = return (Coercion (substCo env co), emptyUDs)
@@ -1597,18 +1611,16 @@ type SpecInfo = ( [CoreRule]       -- Specialisation rules
 specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
         -- The first case is the interesting one
   |  notNull calls_for_me               -- And there are some calls to specialise
-  && not (isNeverActive (idInlineActivation fn))
-        -- Don't specialise NOINLINE things
-        -- See Note [Auto-specialisation and RULES]
-        --
-        -- Don't specialise OPAQUE things, see Note [OPAQUE pragma].
-        -- Since OPAQUE things are always never-active (see
-        -- GHC.Parser.PostProcess.mkOpaquePragma) this guard never fires for
-        -- OPAQUE things.
-
---   && not (certainlyWillInline (idUnfolding fn))      -- And it's not small
---      See Note [Inline specialisations] for why we do not
---      switch off specialisation for inline functions
+  ,  not (isNeverActive inl_act)
+  || idHasInlineable fn -- Explicit INLINEABLE pragma
+  || gopt Opt_SpecialiseAggressively dflags -- -fspecialise-aggressively
+  , not (isOpaquePragma inl_prag)
+  -- Don't specialise NOINLINE things by default.
+  -- See Note [Auto-specialisation and RULES]
+  --
+  -- Don't specialise OPAQUE things, see Note [OPAQUE pragma].
+  -- We specialise even INLINE functions. See Note [Inline specialisations] for
+  -- why we do notswitch off specialisation for inline functions.
 
   = -- pprTrace "specCalls: some" (ppr fn $$ ppr calls_for_me $$ ppr existing_rules) $
     foldlM spec_call ([], [], emptyUDs) calls_for_me
@@ -1670,19 +1682,19 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
              , spec_bndrs1, dx_binds, spec_args) <- specHeader env_with_dict_bndrs
                                                                rhs_bndrs all_call_args
 
---           ; pprTrace "spec_call" (vcat [ text "fun:       "  <+> ppr fn
---                                        , text "call info: "  <+> ppr _ci
---                                        , text "useful:    "  <+> ppr useful
---                                        , text "rule_bndrs:"  <+> ppr rule_bndrs
---                                        , text "lhs_args:  "  <+> ppr rule_lhs_args
---                                        , text "spec_bndrs1:" <+> ppr spec_bndrs1
---                                        , text "leftover_bndrs:" <+> pprIds leftover_bndrs
---                                        , text "spec_args: "  <+> ppr spec_args
---                                        , text "dx_binds:  "  <+> ppr dx_binds
---                                        , text "rhs_body"     <+> ppr rhs_body
---                                        , text "rhs_env2:  "  <+> ppr (se_subst rhs_env2)
---                                        , ppr dx_binds ]) $
---             return ()
+          -- ; pprTrace "spec_call" (vcat [ text "fun:       "  <+> ppr fn
+          --                              , text "call info: "  <+> ppr _ci
+          --                              , text "useful:    "  <+> ppr useful
+          --                              , text "rule_bndrs:"  <+> ppr rule_bndrs
+          --                              , text "lhs_args:  "  <+> ppr rule_lhs_args
+          --                              , text "spec_bndrs1:" <+> ppr spec_bndrs1
+          --                              , text "leftover_bndrs:" <+> pprIds leftover_bndrs
+          --                              , text "spec_args: "  <+> ppr spec_args
+          --                              , text "dx_binds:  "  <+> ppr dx_binds
+          --                              , text "rhs_body"     <+> ppr rhs_body
+          --                              , text "rhs_env2:  "  <+> ppr (se_subst rhs_env2)
+          --                              , ppr dx_binds ]) $
+          --   return ()
 
            ; if not useful  -- No useful specialisation
                 || already_covered rhs_env2 rules_acc rule_lhs_args
@@ -1729,7 +1741,11 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
                        | otherwise = -- Specialising local fn
                                      text "SPEC"
 
-                spec_rule = mkSpecRule dflags this_mod True inl_act
+                spec_act
+                  | isNeverActive (idInlineActivation fn) = activeAfter FinalPhase
+                  | otherwise = inl_act
+
+                spec_rule = mkSpecRule dflags this_mod RuleSrcAuto spec_act
                                     herald fn rule_bndrs rule_lhs_args
                                     (mkVarApps (Var spec_fn) spec_bndrs)
 
@@ -2276,7 +2292,8 @@ should jolly well do anyway, even aside from specialisation, to ensure
 that g doesn't inline too early.
 
 This in turn means that the RULE would never fire for a NOINLINE
-thing so not much point in generating a specialisation at all.
+thing. So in the presence of a NOINLINE pragma we set the rules activation
+to FinalPhase instead.
 
 Note [Specialisation shape]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index 1ed95703af..ea700960ca 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -19,6 +19,7 @@ import GHC.Core.Utils  ( exprType, exprIsHNF )
 import GHC.Core.Type
 import GHC.Core.Opt.WorkWrap.Utils
 import GHC.Core.SimpleOpt
+import GHC.Core.Rules
 
 import GHC.Types.Var
 import GHC.Types.Id
@@ -836,6 +837,7 @@ 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
@@ -883,6 +885,7 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div
     fn_inl_prag     = inlinePragInfo fn_info
     fn_inline_spec  = inl_inline fn_inl_prag
     fn_unfolding    = realUnfoldingInfo fn_info
+    fn_has_inlineable = inlineableInfo fn_info
     fn_rules        = ruleInfoRules (ruleInfo fn_info)
 
 mkStrWrapperInlinePrag :: InlinePragma -> [CoreRule] -> InlinePragma
@@ -901,17 +904,13 @@ mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl
                  , inl_rule   = rule_info }  -- RuleMatchInfo is (and must be) unaffected
   where
     -- See Note [Wrapper activation]
-    wrapper_phase = foldr (laterPhase . get_rule_phase) earliest_inline_phase rules
+    wrapper_phase = earliest_inline_phase `afterRules` rules
     earliest_inline_phase = beginPhase fn_act `laterPhase` nextPhase InitialPhase
           -- laterPhase (nextPhase InitialPhase) is a temporary hack
           -- to inline no earlier than phase 2.  I got regressions in
           -- 'mate', due to changes in full laziness due to Note [Case
           -- MFEs], when I did earlier inlining.
 
-    get_rule_phase :: CoreRule -> CompilerPhase
-    -- The phase /after/ the rule is first active
-    get_rule_phase rule = nextPhase (beginPhase (ruleActivation rule))
-
 {-
 Note [Demand on the worker]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index 17559cf4a9..374b2d7d97 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -486,6 +486,7 @@ pprIdBndrInfo info
       (info `seq` doc) -- The seq is useful for poking on black holes
   where
     prag_info = inlinePragInfo info
+    keep_unf = inlineableInfo info
     occ_info  = occInfo info
     dmd_info  = demandInfo info
     lbv_info  = oneShotInfo info
@@ -497,6 +498,8 @@ pprIdBndrInfo info
 
     doc = showAttributes
           [ (has_prag, text "InlPrag=" <> pprInlineDebug prag_info)
+          -- Todo: This is only interesting for NoInline pragmas
+          , (keep_unf, text "Inlineable")
           , (has_occ,  text "Occ=" <> ppr occ_info)
           , (has_dmd,  text "Dmd=" <> ppr dmd_info)
           , (has_lbv , text "OS=" <> ppr lbv_info)
@@ -505,6 +508,8 @@ pprIdBndrInfo info
 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_occ,          text "Occ=" <> ppr occ_info)
     , (has_dmd,          text "Dmd=" <> ppr dmd_info)
     , (has_lbv ,         text "OS=" <> ppr lbv_info)
@@ -546,6 +551,9 @@ instance Outputable IdInfo where
       rules = ruleInfoRules (ruleInfo info)
       has_rules = not (null rules)
 
+      keep_unf = inlineableInfo info
+
+
 {-
 -----------------------------------------------------
 --      IdDetails and IdInfo
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index d9bd0a912c..7e8547a0a2 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -30,7 +30,10 @@ module GHC.Core.Rules (
         rulesOfBinds, getRules, pprRulesForUser,
 
         -- * Making rules
-        mkRule, mkSpecRule, roughTopNames
+        mkRule, mkSpecRule, roughTopNames,
+
+        -- * Dealing with when rules fire
+        afterRules
 
     ) where
 
@@ -182,7 +185,19 @@ to apply the specialised function to, are handled by the fact that the
 Rule contains a template for the result of the specialisation.
 -}
 
-mkRule :: Module -> Bool -> Bool -> RuleName -> Activation
+-- Sometimes we want to push some activation back such that it fires after a
+-- given set of activations. But at least FinalPhase
+afterRules :: CompilerPhase -> [CoreRule] -> CompilerPhase
+afterRules earliest_phase rules
+  = wrapper_phase
+  where
+    wrapper_phase = foldr (laterPhase . get_rule_phase) earliest_phase rules
+
+    get_rule_phase :: CoreRule -> CompilerPhase
+    -- The phase /after/ the rule is first active
+    get_rule_phase rule = nextPhase (beginPhase (ruleActivation rule))
+
+mkRule :: Module -> RuleSource -> Bool -> RuleName -> Activation
        -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule
 -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being
 -- compiled. See also 'GHC.Core.CoreRule'
@@ -208,7 +223,7 @@ mkRule this_mod is_auto is_local name act fn bndrs args rhs
     orph = chooseOrphanAnchor local_lhs_names
 
 --------------
-mkSpecRule :: DynFlags -> Module -> Bool -> Activation -> SDoc
+mkSpecRule :: DynFlags -> Module -> RuleSource -> Activation -> SDoc
            -> Id -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule
 -- Make a specialisation rule, for Specialise or SpecConstr
 mkSpecRule dflags this_mod is_auto inl_act herald fn bndrs args rhs
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index ba95baec64..7da73e423b 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -759,6 +759,7 @@ 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/Tidy.hs b/compiler/GHC/Core/Tidy.hs
index 5326346ead..2b258c33bf 100644
--- a/compiler/GHC/Core/Tidy.hs
+++ b/compiler/GHC/Core/Tidy.hs
@@ -355,6 +355,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id
                     `setDmdSigInfo`     zapDmdEnvSig (dmdSigInfo old_info)
                     `setDemandInfo`     demandInfo old_info
                     `setInlinePragInfo` inlinePragInfo old_info
+                    `setHasInlineableInfo`    inlineableInfo old_info
                     `setUnfoldingInfo`  new_unf
 
         old_unf = realUnfoldingInfo old_info
diff --git a/compiler/GHC/Core/Unfold/Make.hs b/compiler/GHC/Core/Unfold/Make.hs
index 479187005b..2f054ad417 100644
--- a/compiler/GHC/Core/Unfold/Make.hs
+++ b/compiler/GHC/Core/Unfold/Make.hs
@@ -7,6 +7,7 @@ module GHC.Core.Unfold.Make
    , mkCoreUnfolding
    , mkFinalUnfolding
    , mkFinalUnfolding'
+   , mkVanillaUnfolding
    , mkSimpleUnfolding
    , mkWorkerUnfolding
    , mkInlineUnfoldingWithArity, mkInlineUnfoldingNoArity
@@ -43,20 +44,21 @@ import {-# SOURCE #-} GHC.Core.SimpleOpt
 
 
 
-mkFinalUnfolding :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> CoreExpr -> Unfolding
+mkFinalUnfolding :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> Bool -> 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 expr = mkFinalUnfolding' opts src strict_sig expr Nothing
+mkFinalUnfolding opts src strict_sig may_inline expr = mkFinalUnfolding' opts src strict_sig may_inline expr Nothing
 
 -- See Note [Tying the 'CoreUnfolding' knot] for why interfaces need
 -- to pass a precomputed 'UnfoldingCache'
-mkFinalUnfolding' :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> CoreExpr -> Maybe UnfoldingCache -> Unfolding
+mkFinalUnfolding' :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> Bool -> 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 expr
+mkFinalUnfolding' opts src strict_sig may_inline  expr
   = mkUnfolding opts src
                 True {- Top level -}
                 (isDeadEndSig strict_sig)
+                may_inline
                 expr
 
 -- | Same as 'mkCompulsoryUnfolding' but simplifies the unfolding first
@@ -77,9 +79,15 @@ mkCompulsoryUnfolding expr
 -- top-level flag to True.  It gets set more accurately by the simplifier
 -- Simplify.simplUnfolding.
 
+-- | 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
+
+-- | Non top-lvl non-bottoming vanilla unfolding
 mkSimpleUnfolding :: UnfoldingOpts -> CoreExpr -> Unfolding
 mkSimpleUnfolding !opts rhs
-  = mkUnfolding opts VanillaSrc False False rhs Nothing
+  = mkUnfolding opts VanillaSrc False False True rhs Nothing
 
 mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding
 mkDFunUnfolding bndrs con ops
@@ -154,9 +162,9 @@ mkInlineUnfoldingWithArity opts src arity expr
     boring_ok | arity == 0 = True
               | otherwise  = inlineBoringOk expr'
 
-mkInlinableUnfolding :: SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfolding
-mkInlinableUnfolding opts src expr
-  = mkUnfolding (so_uf_opts opts) src False False expr' Nothing
+mkInlinableUnfolding :: SimpleOpts -> UnfoldingSource -> Bool -> CoreExpr -> Unfolding
+mkInlinableUnfolding opts src may_inline expr
+  = mkUnfolding (so_uf_opts opts) src False False may_inline expr' Nothing
   where
     expr' = simpleOptExpr opts expr
 
@@ -316,19 +324,22 @@ to arise for non-0-ary functions too, but let's wait and see.
 
 mkUnfolding :: UnfoldingOpts
             -> UnfoldingSource
-            -> Bool       -- Is top-level
-            -> Bool       -- Definitely a bottoming binding
+            -> 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 expr cache
+mkUnfolding opts src top_lvl is_bottoming may_inline expr cache
   = mkCoreUnfolding src top_lvl expr cache guidance
   where
     is_top_bottoming = top_lvl && is_bottoming
-    guidance         = calcUnfoldingGuidance opts is_top_bottoming expr
+    guidance
+      | may_inline = calcUnfoldingGuidance opts is_top_bottoming expr
+      | otherwise = UnfNever
         -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))!
         -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]
 
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index c88ddb3d55..a2a5dace21 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -2230,7 +2230,7 @@ diffIdInfo env bndr1 bndr2
   | arityInfo info1 == arityInfo info2
     && cafInfo info1 == cafInfo info2
     && oneShotInfo info1 == oneShotInfo info2
-    && inlinePragInfo info1 == inlinePragInfo info2
+    && pragInfo info1 == pragInfo info2
     && occInfo info1 == occInfo info2
     && demandInfo info1 == demandInfo info2
     && callArityInfo info1 == callArityInfo info2
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index 98595f0403..d2ad8f161d 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -463,7 +463,7 @@ toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
 toIfaceIdInfo :: IdInfo -> IfaceIdInfo
 toIfaceIdInfo id_info
   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, cpr_hsinfo,
-               inline_hsinfo,  unfold_hsinfo]
+               inline_hsinfo,  has_inlineable_hsinfo, unfold_hsinfo]
                -- NB: strictness and arity must appear in the list before unfolding
                -- See GHC.IfaceToCore.tcUnfolding
   where
@@ -497,6 +497,13 @@ toIfaceIdInfo id_info
     inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
                   | otherwise = Just (HsInline inline_prag)
 
+    ------------ Inlineable flag ------------
+    has_inlineable = inlineableInfo id_info
+    has_inlineable_hsinfo
+      | has_inlineable = Just HsInlineable
+      | otherwise = Nothing
+
+
 toIfaceJoinInfo :: Maybe JoinArity -> IfaceJoinInfo
 toIfaceJoinInfo (Just ar) = IfaceJoinPoint ar
 toIfaceJoinInfo Nothing   = IfaceNotJoinPoint
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 3c6ec71079..523fa542c7 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -477,7 +477,7 @@ dsRule (L loc (HsRule { rd_name = name
               simpl_opts = initSimpleOpts dflags
               final_rhs = simpleOptExpr simpl_opts rhs''    -- De-crap it
               rule_name = unLoc name
-              rule = mkRule this_mod False is_local rule_name rule_act
+              rule = mkRule this_mod RuleSrcUser is_local rule_name rule_act
                             fn_name final_bndrs args final_rhs
         ; dsWarnOrphanRule rule
         ; dsWarnRuleShadowing fn_id rule
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 21cab8439d..30c9a48414 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -60,6 +60,7 @@ import GHC.Builtin.Types ( naturalTy, typeSymbolKind, charTy )
 import GHC.Tc.Types.Evidence
 
 import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Types.Name
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
@@ -339,9 +340,9 @@ 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, setInlinePragma lcl_id prag)
+      = mkVarEnv [ (lcl_id, setPragmaInfo lcl_id prag)
                  | ABE { abe_mono = lcl_id, abe_poly = gbl_id } <- exports
-                 , let prag = idInlinePragma gbl_id ]
+                 , let prag = idPragmaInfo gbl_id ]
 
     global_env :: IdEnv Id -- Maps local Id to its global exported Id
     global_env =
@@ -393,14 +394,18 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
   | otherwise
   = case inlinePragmaSpec inline_prag of
           NoUserInlinePrag -> (gbl_id, rhs)
-          NoInline  {}     -> (gbl_id, rhs)
+          NoInline  {}
+            | keep_unf  -> (gbl_id `setIdUnfolding` inlinable_unf False, rhs)
+            | otherwise -> (gbl_id, rhs)
           Opaque    {}     -> (gbl_id, rhs)
-          Inlinable {}     -> (gbl_id `setIdUnfolding` inlinable_unf, rhs)
+          Inlinable {}     -> (gbl_id `setIdUnfolding` inlinable_unf True, rhs)
           Inline    {}     -> inline_pair
   where
     simpl_opts    = initSimpleOpts dflags
-    inline_prag   = idInlinePragma gbl_id
-    inlinable_unf = mkInlinableUnfolding simpl_opts StableUserSrc 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
     inline_pair
        | Just arity <- inlinePragmaSat inline_prag
         -- Add an Unfolding for an INLINE (but not for NOINLINE)
@@ -715,10 +720,10 @@ 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.
-                            `setInlinePragma` inl_prag
+                            `setPragmaInfo` spec_prag_info
                             `setIdUnfolding`  spec_unf
 
-             rule = mkSpecRule dflags this_mod False rule_act (text "USPEC")
+             rule = mkSpecRule dflags this_mod RuleSrcUser rule_act (text "USPEC")
                                poly_id rule_bndrs rule_lhs_args
                                (mkVarApps (Var spec_id) spec_bndrs)
              spec_rhs = mkLams spec_bndrs (core_app poly_rhs)
@@ -742,7 +747,8 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
              | otherwise = pprPanic "dsImpSpecs" (ppr poly_id)
                             -- The type checker has checked that it *has* an unfolding
 
-    id_inl = idInlinePragma poly_id
+    id_pragInfo = idPragmaInfo poly_id
+    id_inl = pragInfoInline id_pragInfo
 
     -- See Note [Activation pragmas for SPECIALISE]
     inl_prag | not (isDefaultInlinePragma spec_inl)    = spec_inl
@@ -753,6 +759,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
      -- Get the INLINE pragma from SPECIALISE declaration, or,
      -- failing that, from the original Id
 
+    spec_prag_info = id_pragInfo { pragInfoInline = inl_prag }
     spec_prag_act = inlinePragmaActivation spec_inl
 
     -- See Note [Activation pragmas for SPECIALISE]
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 045de30ed6..13595a8f00 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1105,7 +1105,7 @@ rep_specialise nm ty ispec loc
        ; ty1 <- repHsSigType ty
        ; phases <- repPhases $ inl_act ispec
        ; let inline = inl_inline ispec
-       ; pragma <- if noUserInlineSpec inline
+       ; pragma <- if isNoUserInlineSpec inline
                    then -- SPECIALISE
                      repPragSpec nm1 ty1 phases
                    else -- SPECIALISE INLINE
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 886bc12192..0d001e94d9 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -53,6 +53,7 @@ import GHC.Utils.Logger
 import GHC.Utils.Constants (debugIsOn)
 
 import GHC.Types.Annotations
+import GHC.Types.Basic (RuleSource(..))
 import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.SrcLoc
@@ -1256,7 +1257,7 @@ addFingerprints hsc_env iface0
       , mi_opt_hash    = opt_hash
       , mi_hpc_hash    = hpc_hash
       , mi_plugin_hash = plugin_hash
-      , mi_orphan      = not (   all ifRuleAuto orph_rules
+      , mi_orphan      = not (   all (is_if_auto_rule . ifRuleAuto) orph_rules
                                    -- See Note [Orphans and auto-generated rules]
                               && null orph_insts
                               && null orph_fis)
@@ -1279,6 +1280,9 @@ addFingerprints hsc_env iface0
     (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph    (mi_rules iface0)
     (non_orph_fis,   orph_fis)   = mkOrphMap ifFamInstOrph (mi_fam_insts iface0)
     ann_fn = mkIfaceAnnCache (mi_anns iface0)
+    is_if_auto_rule src = case src of
+      RuleSrcAuto -> True
+      RuleSrcUser -> False
 
 -- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules
 -- (in particular, the orphan modules which are transitively imported by the
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index 4ff4ab7eee..f57fefd4e7 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -319,7 +319,7 @@ data IfaceRule
         ifRuleHead   :: IfExtName,      -- Head of lhs
         ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
         ifRuleRhs    :: IfaceExpr,
-        ifRuleAuto   :: Bool,
+        ifRuleAuto   :: RuleSource,
         ifRuleOrph   :: IsOrphan   -- Just like IfaceClsInst
     }
 
@@ -357,6 +357,7 @@ data IfaceInfoItem
   | HsInline        InlinePragma
   | HsUnfold        Bool             -- True <=> isStrongLoopBreaker is true
                     IfaceUnfolding   -- See Note [Expose recursive functions]
+  | HsInlineable
   | HsNoCafRefs
   | HsLFInfo        IfaceLFInfo
   | HsTagSig        TagSig
@@ -1515,6 +1516,7 @@ instance Outputable IfaceInfoItem where
                               <> ppWhen lb (text "(loop-breaker)")
                               <> colon <+> ppr unf
   ppr (HsInline prag)       = text "Inline:" <+> ppr prag
+  ppr (HsInlineable)        = text "HasInlineable:True"
   ppr (HsArity arity)       = text "Arity:" <+> int arity
   ppr (HsDmdSig str)        = text "Strictness:" <+> ppr str
   ppr (HsCprSig cpr)        = text "CPR:" <+> ppr cpr
@@ -2285,6 +2287,7 @@ instance Binary IfaceInfoItem where
     put_ bh (HsCprSig cpr)        = putByte bh 6 >> put_ bh cpr
     put_ bh (HsLFInfo lf_info)    = putByte bh 7 >> put_ bh lf_info
     put_ bh (HsTagSig sig)        = putByte bh 8 >> put_ bh sig
+    put_ bh (HsInlineable)           = putByte bh 9
 
     get bh = do
         h <- getByte bh
@@ -2298,7 +2301,9 @@ instance Binary IfaceInfoItem where
             4 -> return HsNoCafRefs
             6 -> HsCprSig <$> get bh
             7 -> HsLFInfo <$> get bh
-            _ -> HsTagSig <$> get bh
+            8 -> HsTagSig <$> get bh
+            9 -> pure HsInlineable
+            _ -> error "Binary:IfaceInfoItem - Invalid byte"
 
 instance Binary IfaceUnfolding where
     put_ bh (IfCoreUnfold s c g e) = do
@@ -2707,6 +2712,7 @@ instance NFData IfaceInfoItem where
     HsCprSig cpr -> cpr `seq` ()
     HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further?
     HsTagSig sig -> sig `seq` ()
+    HsInlineable -> ()
 
 instance NFData IfGuidance where
   rnf = \case
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 327bb28412..609fc95380 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -761,6 +761,7 @@ addExternal opts id
     never_active   = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
     loop_breaker   = isStrongLoopBreaker (occInfo idinfo)
     bottoming_fn   = isDeadEndSig (dmdSigInfo idinfo)
+    inlineable     = inlineableInfo idinfo
 
         -- Stuff to do with the Id's unfolding
         -- We leave the unfolding there even if there is a worker
@@ -774,6 +775,8 @@ addExternal opts id
        || isStableSource src     -- Always expose things whose
                                  -- source is an inline rule
 
+       || inlineable
+
        || not dont_inline
        where
          dont_inline
@@ -1240,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
-        `setInlinePragInfo`  inlinePragInfo idinfo
+        `setPragInfo`        pragInfo idinfo
         `setUnfoldingInfo`   unfold_info
                 -- NB: we throw away the Rules
                 -- They have already been extracted by findExternalRules
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index a69cc34a73..b065b24383 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -1724,6 +1724,7 @@ tcIdInfo ignore_prags toplvl name ty info = do
     tcPrag info (HsDmdSig str)     = return (info `setDmdSigInfo` str)
     tcPrag info (HsCprSig cpr)     = return (info `setCprSigInfo` cpr)
     tcPrag info (HsInline prag)    = return (info `setInlinePragInfo` prag)
+    tcPrag info (HsInlineable)     = return (info `setHasInlineableInfo` True)
     tcPrag info (HsLFInfo lf_info) = do
       lf_info <- tcLFInfo lf_info
       return (info `setLFInfo` lf_info)
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 349fc770b6..aa3f33b8da 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -58,7 +58,7 @@ import GHC.Types.Name.Set
 import GHC.Types.Name.Reader ( RdrName, rdrNameOcc )
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Data.List.SetOps    ( findDupsEq )
-import GHC.Types.Basic         ( RecFlag(..), TypeOrKind(..) )
+import GHC.Types.Basic
 import GHC.Data.Graph.Directed ( SCC(..) )
 import GHC.Data.Bag
 import GHC.Utils.Misc
@@ -1185,7 +1185,11 @@ findDupSigs sigs
     matching_sig :: (LocatedN RdrName, Sig GhcPs) -> (LocatedN RdrName, Sig GhcPs) -> Bool --AZ
     matching_sig (L _ n1,sig1) (L _ n2,sig2)       = n1 == n2 && mtch sig1 sig2
     mtch (FixSig {})           (FixSig {})         = True
-    mtch (InlineSig {})        (InlineSig {})      = True
+    mtch (InlineSig _ _ prag1)        (InlineSig _ _ prag2)
+      |  isInlinablePragma prag1
+      || isInlinablePragma prag2
+                                                   = False
+      | otherwise                                  = True
     mtch (TypeSig {})          (TypeSig {})        = True
     mtch (ClassOpSig _ d1 _ _) (ClassOpSig _ d2 _ _) = d1 == d2
     mtch (PatSynSig _ _ _)     (PatSynSig _ _ _)   = True
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 00b37709bd..484c178b96 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -954,7 +954,11 @@ instance Diagnostic TcRnMessage where
              2 (vcat (text "Ignoring all but the first"
                       : map pp_inl (fst_inl_prag : NE.toList inl_prags)))
          where
-           pp_inl (L loc prag) = ppr prag <+> parens (ppr loc)
+           pp_inl :: (LocatedA InlinePragma) -> SDoc
+           pp_inl loc_prag =
+              let prag = (unLoc loc_prag)
+                  loc = getLocA loc_prag
+              in (pprInlineDebug prag) <+> text "at" <+> (ppr loc)
     TcRnUnexpectedPragmas poly_id bad_sigs
       -> mkSimpleDecorated $
            hang (text "Discarding unexpected pragmas for" <+> ppr poly_id)
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 0c74bd54f6..2961fa10cf 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -56,8 +56,9 @@ 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, setInlinePragma
+import GHC.Types.Id  ( Id, idName, idType, setPragmaInfo
                      , mkLocalId, realIdUnfolding )
+import GHC.Types.Id.Info
 import GHC.Types.Basic
 import GHC.Types.Name
 import GHC.Types.Name.Env
@@ -74,7 +75,6 @@ import GHC.Data.Maybe( orElse, whenIsJust )
 
 import Data.Maybe( mapMaybe )
 import qualified Data.List.NonEmpty as NE
-import Control.Monad( unless )
 
 
 {- -------------------------------------------------------------
@@ -622,22 +622,63 @@ lhsBindArity _ env = env        -- PatBind/VarBind
 
 
 -----------------
+
+-- Potentially combine INLINEABLE/NOINLINE pragma combinations
+computePragmaInfo :: PragInfo -> [InlinePragma] -> Maybe PragInfo
+computePragmaInfo info [] = Just info
+computePragmaInfo info (prag:prags)
+  = case old_spec of
+    Inline{} -> Nothing
+    Inlinable{}
+      -- INLINEABLE + NOINLINE
+      | NoInline{} <- new_spec
+      , isDefaultActivationPragma old_prag
+      -> computePragmaInfo (mkPragInfo prag True) prags
+      | otherwise -> Nothing
+    NoInline{}
+      -- NOINLINE + INLINEABLE
+      | isInlinableSpec new_spec
+      , isDefaultActivationPragma prag
+      -> Just info{ pragHasInlineable = True }
+      | otherwise
+      -> Nothing
+    Opaque{} -> Nothing
+    NoUserInlinePrag ->
+      computePragmaInfo
+          (mkPragInfo prag (isInlinablePragma prag))
+          prags
+  where
+    old_prag = pragInfoInline $ info
+    old_spec = inl_inline old_prag
+    new_spec = inl_inline prag
+
+
+
+-----------------
 addInlinePrags :: TcId -> [LSig GhcRn] -> TcM TcId
 addInlinePrags poly_id prags_for_me
-  | inl@(L _ prag) : inls <- inl_prags
-  = do { traceTc "addInlinePrag" (ppr poly_id $$ ppr prag)
-       ; unless (null inls) (warn_multiple_inlines inl inls)
-       ; return (poly_id `setInlinePragma` prag) }
+  | inl@(L _ inl_prag) : inls <- inl_prags
+  = do { traceTc "addInlinePrag" (ppr poly_id $$ ppr inl_prag)
+       ; let  init_info = (mkPragInfo inl_prag $ isInlinablePragma inl_prag)
+              m_prag_info = computePragmaInfo
+                            init_info
+                            (map unLoc inls)
+
+       ; prag_info <- case m_prag_info of
+            Just info -> return info
+            Nothing -> do warn_multiple_inlines inl inls
+                          return init_info
+
+       ; return (poly_id `setPragmaInfo` prag_info) }
   | otherwise
   = return poly_id
   where
-    inl_prags = [L loc prag | L loc (InlineSig _ _ prag) <- prags_for_me]
+    inl_prags = [L loc prag | L loc (InlineSig _ _ prag) <- prags_for_me] -- :: [LocatedA InlinePragma]
 
     warn_multiple_inlines _ [] = return ()
-
     warn_multiple_inlines inl1@(L loc prag1) (inl2@(L _ prag2) : inls)
        | inlinePragmaActivation prag1 == inlinePragmaActivation prag2
-       , noUserInlineSpec (inlinePragmaSpec prag1)
+       , isNoUserInlineSpec (inlinePragmaSpec prag1)
        =    -- Tiresome: inl1 is put there by virtue of being in a hs-boot loop
             -- and inl2 is a user NOINLINE pragma; we don't want to complain
          warn_multiple_inlines inl2 inls
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 6fda868642..f3980ed481 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -2104,6 +2104,9 @@ mkDefMethBind loc dfun_id clas sel_id dm_name
   = do  { logger <- getLogger
         ; dm_id <- tcLookupId dm_name
         ; let inline_prag = idInlinePragma dm_id
+              -- TODO: Here one would expect us to transfer NOINLINE as well.
+              -- But it seems we don't. See #22689
+              -- If we do we might also need to transfer the keep unfolding flag.
               inline_prags | isAnyInlinePragma inline_prag
                            = [noLocA (InlineSig noAnn fn inline_prag)]
                            | otherwise
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index 1ad6b608fc..edf847ba92 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -83,8 +83,9 @@ module GHC.Types.Basic (
         isNeverActive, isAlwaysActive, activeInFinalPhase,
         activateAfterInitial, activateDuringFinal, activeAfter,
 
+        RuleSource(..),
         RuleMatchInfo(..), isConLike, isFunLike,
-        InlineSpec(..), noUserInlineSpec,
+        InlineSpec(..), isNoUserInlineSpec, isInlinableSpec,
         InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
         neverInlinePragma, dfunInlinePragma,
         isDefaultInlinePragma,
@@ -93,7 +94,7 @@ module GHC.Types.Basic (
         inlinePragmaSource,
         inlinePragmaName, inlineSpecSource,
         inlinePragmaSpec, inlinePragmaSat,
-        inlinePragmaActivation, inlinePragmaRuleMatchInfo,
+        inlinePragmaActivation, isDefaultActivationPragma, inlinePragmaRuleMatchInfo,
         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
         pprInline, pprInlineDebug,
 
@@ -124,11 +125,12 @@ import GHC.Utils.Panic
 import GHC.Utils.Binary
 import GHC.Types.SourceText
 import qualified GHC.LanguageExtensions as LangExt
-import Data.Data
-import qualified Data.Semigroup as Semi
 import {-# SOURCE #-} Language.Haskell.Syntax.Type (PromotionFlag(..), isPromoted)
 import Language.Haskell.Syntax.Basic (Boxity(..), isBoxed, ConTag)
 
+import Data.Data
+import qualified Data.Semigroup as Semi
+import Control.DeepSeq
 {- *********************************************************************
 *                                                                      *
           Binary choice
@@ -452,6 +454,27 @@ type RuleName = FastString
 pprRuleName :: RuleName -> SDoc
 pprRuleName rn = doubleQuotes (ftext rn)
 
+data RuleSource
+    = RuleSrcUser -- ^ User written rule
+    | RuleSrcAuto -- ^ Rule generated by GHC. Currently only SpecConstr or Specialise.
+    deriving (Eq,Ord,Data)
+
+instance Binary RuleSource where
+    put_ bh RuleSrcUser = putByte bh 0
+    put_ bh RuleSrcAuto = putByte bh 1
+    get bh = do
+        h <- getByte bh
+        case h of
+          0 -> return RuleSrcUser
+          1 -> return RuleSrcAuto
+          _ -> panic "Binary:RuleSource - invalid byte"
+
+instance Outputable RuleSource where
+    ppr RuleSrcUser = text "User"
+    ppr RuleSrcAuto = text "Auto"
+
+instance NFData RuleSource where
+    rnf !_ = ()
 
 {-
 ************************************************************************
@@ -1547,9 +1570,14 @@ isFunLike :: RuleMatchInfo -> Bool
 isFunLike FunLike = True
 isFunLike _       = False
 
-noUserInlineSpec :: InlineSpec -> Bool
-noUserInlineSpec NoUserInlinePrag = True
-noUserInlineSpec _                = False
+isNoUserInlineSpec :: InlineSpec -> Bool
+isNoUserInlineSpec NoUserInlinePrag = True
+isNoUserInlineSpec _                = False
+
+isInlinableSpec :: InlineSpec -> Bool
+isInlinableSpec Inlinable{} = True
+isInlinableSpec _                = False
+
 
 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
   :: InlinePragma
@@ -1595,7 +1623,7 @@ isDefaultInlinePragma :: InlinePragma -> Bool
 isDefaultInlinePragma (InlinePragma { inl_act = activation
                                     , inl_rule = match_info
                                     , inl_inline = inline })
-  = noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info
+  = isNoUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info
 
 isInlinePragma :: InlinePragma -> Bool
 isInlinePragma prag = case inl_inline prag of
@@ -1630,6 +1658,15 @@ inlinePragmaSat = inl_sat
 inlinePragmaActivation :: InlinePragma -> Activation
 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
 
+isDefaultActivationPragma :: InlinePragma -> Bool
+isDefaultActivationPragma (InlinePragma { inl_act = activation
+                                  , inl_inline = inl })
+    = case inl of
+      NoInline{} -> activation == NeverActive
+      Opaque{}   -> activation == NeverActive
+      _          -> activation == AlwaysActive
+
+
 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
 
diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
index 4744147dcf..bdc3d64919 100644
--- a/compiler/GHC/Types/Id.hs
+++ b/compiler/GHC/Types/Id.hs
@@ -82,7 +82,7 @@ module GHC.Types.Id (
         asJoinId, asJoinId_maybe, zapJoinId,
 
         -- ** Inline pragma stuff
-        idInlinePragma, setInlinePragma, modifyInlinePragma,
+        idPragmaInfo, idInlinePragma, idHasInlineable, setInlinePragma, setPragmaInfo, modifyInlinePragma,
         idInlineActivation, setInlineActivation, idRuleMatchInfo,
 
         -- ** One-shot lambdas
@@ -174,6 +174,7 @@ infixl  1 `setIdUnfolding`,
 
           `setIdSpecialisation`,
           `setInlinePragma`,
+          `setPragmaInfo`,
           `setInlineActivation`,
           `idCafInfo`,
 
@@ -893,9 +894,18 @@ OK not to if optimisation is switched off.
 idInlinePragma :: Id -> InlinePragma
 idInlinePragma id = inlinePragInfo (idInfo id)
 
+idHasInlineable :: Id -> Bool
+idHasInlineable id = inlineableInfo (idInfo id)
+
+idPragmaInfo :: Id -> PragInfo
+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
+
 modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id
 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
 
@@ -1037,6 +1047,7 @@ transferPolyIdInfo old_id abstract_wrt new_id
     old_info        = idInfo old_id
     old_arity       = arityInfo old_info
     old_inline_prag = inlinePragInfo old_info
+    old_unf_info    = inlineableInfo old_info
     old_occ_info    = occInfo old_info
     new_arity       = old_arity + arity_increase
     new_occ_info    = zapOccTailCallInfo old_occ_info
@@ -1060,6 +1071,7 @@ transferPolyIdInfo old_id abstract_wrt new_id
       | otherwise = Just NotMarkedCbv
     transfer new_info = new_info `setArityInfo`      new_arity
                                  `setInlinePragInfo` old_inline_prag
+                                 `setHasInlineableInfo` old_unf_info
                                  `setOccInfo`        new_occ_info
                                  `setDmdSigInfo`     new_strictness
                                  `setCprSigInfo`     new_cpr
diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs
index edd1ba0da0..7fb83d8c20 100644
--- a/compiler/GHC/Types/Id/Info.hs
+++ b/compiler/GHC/Types/Id/Info.hs
@@ -48,10 +48,12 @@ module GHC.Types.Id.Info (
 
         -- ** Unfolding Info
         realUnfoldingInfo, unfoldingInfo, setUnfoldingInfo, hasInlineUnfolding,
+        inlinePragInfo, setInlinePragInfo, inlineableInfo, setHasInlineableInfo,
 
-        -- ** The InlinePragInfo type
-        InlinePragInfo,
-        inlinePragInfo, setInlinePragInfo,
+        -- ** The PragInfo type
+        setPragInfo, pragInfo, PragInfo, mkPragInfo,
+        pragInfoInline, pragHasInlineable,
+        setPragInfoInline,
 
         -- ** The OccInfo type
         OccInfo(..),
@@ -114,9 +116,11 @@ import GHC.StgToCmm.Types (LambdaFormInfo)
 infixl  1 `setRuleInfo`,
           `setArityInfo`,
           `setInlinePragInfo`,
+          `setHasInlineableInfo`,
           `setUnfoldingInfo`,
           `setOneShotInfo`,
           `setOccInfo`,
+          `setPragInfo`,
           `setCafInfo`,
           `setDmdSigInfo`,
           `setCprSigInfo`,
@@ -348,7 +352,7 @@ data IdInfo
         -- See Note [Specialisations and RULES in IdInfo]
         realUnfoldingInfo   :: Unfolding,
         -- ^ The 'Id's unfolding
-        inlinePragInfo  :: InlinePragma,
+        pragInfo  :: PragInfo,
         -- ^ Any inline pragma attached to the 'Id'
         occInfo         :: OccInfo,
         -- ^ How the 'Id' occurs in the program
@@ -429,6 +433,12 @@ bitfieldSetArityInfo info (BitField bits) =
 
 -- Getters
 
+inlinePragInfo :: IdInfo -> InlinePragma
+inlinePragInfo = pragInfoInline . pragInfo
+
+inlineableInfo :: IdInfo -> Bool
+inlineableInfo = pragHasInlineable . pragInfo
+
 -- | Info about a lambda-bound variable, if the 'Id' is one
 oneShotInfo :: IdInfo -> OneShotInfo
 oneShotInfo = bitfieldGetOneShotInfo . bitfield
@@ -455,10 +465,15 @@ tagSigInfo = tagSig
 
 setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
 setRuleInfo       info sp = sp `seq` info { ruleInfo = sp }
-setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
-setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
 setOccInfo :: IdInfo -> OccInfo -> IdInfo
 setOccInfo        info oc = oc `seq` info { occInfo = oc }
+setPragInfo :: IdInfo -> PragInfo -> IdInfo
+setPragInfo info pr = pr `seq` info { pragInfo = pr}
+
+setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
+setInlinePragInfo info pr = pr `seq` info { pragInfo = setPragInfoInline pr (pragInfo info) }
+setHasInlineableInfo :: IdInfo -> Bool -> IdInfo
+setHasInlineableInfo  info pr = pr `seq` info { pragInfo = setPragInfoUnf pr (pragInfo info) }
         -- Try to avoid space leaks by seq'ing
 
 -- | Essentially returns the 'realUnfoldingInfo' field, but does not expose the
@@ -522,7 +537,7 @@ vanillaIdInfo
   = IdInfo {
             ruleInfo       = emptyRuleInfo,
             realUnfoldingInfo  = noUnfolding,
-            inlinePragInfo = defaultInlinePragma,
+            pragInfo       = defaultPragInfo,
             occInfo        = noOccInfo,
             demandInfo     = topDmd,
             dmdSigInfo     = nopSig,
@@ -622,9 +637,37 @@ ppArityInfo n = hsep [text "Arity", int n]
 -- If there was an @INLINE@ pragma, then as a separate matter, the
 -- RHS will have been made to look small with a Core inline 'Note'
 --
--- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
+-- The default 'PragInfo' is 'AlwaysActive', so the info serves
 -- entirely as a way to inhibit inlining until we want it
-type InlinePragInfo = InlinePragma
+data PragInfo = PragInfo
+  { -- | INLINE etc info
+    pragInfoInline :: !InlinePragma
+  , -- | Should we keep the unfolding?
+    pragHasInlineable :: !Bool
+  } deriving Eq
+
+instance Outputable PragInfo where
+  ppr prag = text "PragInfo=" <> braces
+    (ppr (pragInfoInline prag) <> comma <>
+     text "HasInlineable:" <> ppr (pragHasInlineable prag))
+
+-- | mkPragInfo inl_prag has_inlineable
+mkPragInfo :: InlinePragma -> Bool -> PragInfo
+mkPragInfo = PragInfo
+
+setPragInfoInline :: InlinePragma -> PragInfo -> PragInfo
+setPragInfoInline inl prag_info = prag_info { pragInfoInline = inl }
+
+setPragInfoUnf :: Bool -> PragInfo -> PragInfo
+setPragInfoUnf keep prag_info = prag_info { pragHasInlineable = keep }
+
+defaultPragInfo :: PragInfo
+defaultPragInfo = PragInfo
+  { pragInfoInline = defaultInlinePragma
+  , pragHasInlineable = defaultHasInlineableInfo }
+
+defaultHasInlineableInfo :: Bool
+defaultHasInlineableInfo = False
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index 0107f6fc6a..11c1230297 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -756,8 +756,11 @@ lambda     = unicodeSyntax (char 'λ') (char '\\')
 
 semi, comma, colon, equals, space, underscore, dot, vbar :: IsLine doc => doc
 lparen, rparen, lbrack, rbrack, lbrace, rbrace :: IsLine doc => doc
+-- | ;
 semi       = char ';'
+-- | ,
 comma      = char ','
+-- | :
 colon      = char ':'
 equals     = char '='
 space      = char ' '
diff --git a/docs/users_guide/exts/pragmas.rst b/docs/users_guide/exts/pragmas.rst
index 0197a2fa1a..3256fef5e5 100644
--- a/docs/users_guide/exts/pragmas.rst
+++ b/docs/users_guide/exts/pragmas.rst
@@ -396,7 +396,11 @@ behaviour:
 
 -  Unlike ``INLINE``, it is OK to use an ``INLINABLE`` pragma on a
    recursive function. The principal reason do to so to allow later use
-   of ``SPECIALISE``
+   of ``SPECIALISE``. Further ``INLINABLE`` can also be combined with
+   ``NOINLINE`` which allows both specialisation as well as manual inlining
+   through the magic ``inline`` function.
+   When ``INLINABLE`` is combined with ``NOINLINE`` no phase control is allowed
+   on the ``INLINABLE`` pragma.
 
 The alternative spelling ``INLINEABLE`` is also accepted by GHC.
 
diff --git a/testsuite/tests/simplCore/should_compile/T22629a.hs b/testsuite/tests/simplCore/should_compile/T22629a.hs
new file mode 100644
index 0000000000..f7dd4f179a
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22629a.hs
@@ -0,0 +1,5 @@
+module T22629 where
+
+{-# INLINABLE foo #-}
+{-# NOINLINE foo #-}
+foo = case error "wombat" of { True -> "fred"; False -> "bill" }
diff --git a/testsuite/tests/simplCore/should_compile/T22629b.hs b/testsuite/tests/simplCore/should_compile/T22629b.hs
new file mode 100644
index 0000000000..8ab97055d1
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22629b.hs
@@ -0,0 +1,6 @@
+module T22629 where
+
+-- This should not work as the activation here is not allowed.
+{-# INLINABLE[1] foo #-}
+{-# NOINLINE foo #-}
+foo = case error "wombat" of { True -> "fred"; False -> "bill" }
diff --git a/testsuite/tests/simplCore/should_compile/T22629b.stderr b/testsuite/tests/simplCore/should_compile/T22629b.stderr
new file mode 100644
index 0000000000..f8854b6485
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22629b.stderr
@@ -0,0 +1,6 @@
+
+T22629b.hs:4:1: warning: [GHC-96665]
+    Multiple INLINE pragmas for foo
+      Ignoring all but the first
+      INLINABLE[1] at T22629b.hs:4:1-24
+      NOINLINE at T22629b.hs:5:1-20
diff --git a/testsuite/tests/simplCore/should_compile/T22629c.hs b/testsuite/tests/simplCore/should_compile/T22629c.hs
new file mode 100644
index 0000000000..0b0adc037e
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22629c.hs
@@ -0,0 +1,6 @@
+module T22629 where
+
+-- This should work.
+{-# INLINABLE foo #-}
+{-# NOINLINE[1] foo #-}
+foo = case error "wombat" of { True -> "fred"; False -> "bill" }
diff --git a/testsuite/tests/simplCore/should_compile/T22629d.hs b/testsuite/tests/simplCore/should_compile/T22629d.hs
new file mode 100644
index 0000000000..a138b04b85
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22629d.hs
@@ -0,0 +1,13 @@
+module T22629d where
+
+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.
+
+{-# 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
new file mode 100644
index 0000000000..c598677629
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22629d.stderr
@@ -0,0 +1,56 @@
+[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#
+
+Rec {
+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 }) #)
+end Rec }
+
+$trModule4 = "main"#
+
+$trModule3 = TrNameS $trModule4
+
+$trModule2 = "T22629d_Lib"#
+
+$trModule1 = TrNameS $trModule2
+
+$trModule = Module $trModule3 $trModule1
+
+
+
+[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"#
+
+$trModule1 = TrNameS $trModule2
+
+$trModule4 = "main"#
+
+$trModule3 = TrNameS $trModule4
+
+$trModule = Module $trModule3 $trModule1
+
+lvl = I# 42#
+
+foo = lvl
+
+
+
diff --git a/testsuite/tests/simplCore/should_compile/T22629d_Lib.hs b/testsuite/tests/simplCore/should_compile/T22629d_Lib.hs
new file mode 100644
index 0000000000..3e3b569c8b
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22629d_Lib.hs
@@ -0,0 +1,11 @@
+module T22629d_Lib where
+
+import GHC.Exts
+import GHC.Int
+import Data.List.NonEmpty as NE
+import Data.Foldable as F
+
+{-# INLINABLE getNumbers #-}
+{-# NOINLINE getNumbers #-}
+getNumbers :: Num a => NonEmpty a
+getNumbers = 42 :| (F.toList getNumbers)
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index edbefd6145..7e21265938 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -461,3 +461,7 @@ test('T21476', normal, compile, [''])
 test('T22272', normal, multimod_compile, ['T22272', '-O -fexpose-all-unfoldings -fno-omit-interface-pragmas -fno-ignore-interface-pragmas'])
 test('T22459', normal, compile, [''])
 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'])