Fix loop in the interface representation of some `Unfolding` fieldswip/T22272

As discovered in #22272, dehydration of the unfolding info of a
recursive definition used to involve a traversal of the definition
itself, which in turn involves traversing the unfolding info. Hence,
a loop.

Instead, we now store enough data in the interface that we can produce
the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot]
for details.

Fixes #22272

Co-authored-by: Simon Peyton Jones <simon.peytonjones@gmail.com>

23 files changed, 332 insertions, 169 deletions

diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index 61fc14e815..92b34ffc21 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -52,7 +52,7 @@ module GHC.Core (
         isRuntimeArg, isRuntimeVar,
 
         -- * Unfolding data types
-        Unfolding(..),  UnfoldingGuidance(..), UnfoldingSource(..),
+        Unfolding(..),  UnfoldingCache(..), UnfoldingGuidance(..), UnfoldingSource(..),
 
         -- ** Constructing 'Unfolding's
         noUnfolding, bootUnfolding, evaldUnfolding, mkOtherCon,
@@ -1277,15 +1277,8 @@ data Unfolding
         uf_tmpl       :: CoreExpr,        -- Template; occurrence info is correct
         uf_src        :: UnfoldingSource, -- Where the unfolding came from
         uf_is_top     :: Bool,          -- True <=> top level binding
-        uf_is_value   :: Bool,          -- exprIsHNF template (cached); it is ok to discard
-                                        --      a `seq` on this variable
-        uf_is_conlike :: Bool,          -- True <=> applicn of constructor or CONLIKE function
-                                        --      Cached version of exprIsConLike
-        uf_is_work_free :: Bool,                -- True <=> doesn't waste (much) work to expand
-                                        --          inside an inlining
-                                        --      Cached version of exprIsCheap
-        uf_expandable :: Bool,          -- True <=> can expand in RULE matching
-                                        --      Cached version of exprIsExpandable
+        uf_cache      :: UnfoldingCache,        -- Cache of flags computable from the expr
+                                                -- See Note [Tying the 'CoreUnfolding' knot]
         uf_guidance   :: UnfoldingGuidance      -- Tells about the *size* of the template.
     }
   -- ^ An unfolding with redundant cached information. Parameters:
@@ -1305,7 +1298,22 @@ data Unfolding
   --  uf_guidance:  Tells us about the /size/ of the unfolding template
 
 
-------------------------------------------------
+-- | Properties of a 'CoreUnfolding' that could be computed on-demand from its template.
+-- See Note [UnfoldingCache]
+data UnfoldingCache
+  = UnfoldingCache {
+        uf_is_value   :: !Bool,         -- exprIsHNF template (cached); it is ok to discard
+                                        --      a `seq` on this variable
+        uf_is_conlike :: !Bool,         -- True <=> applicn of constructor or CONLIKE function
+                                        --      Cached version of exprIsConLike
+        uf_is_work_free :: !Bool,       -- True <=> doesn't waste (much) work to expand
+                                        --          inside an inlining
+                                        --      Cached version of exprIsCheap
+        uf_expandable :: !Bool          -- True <=> can expand in RULE matching
+                                        --      Cached version of exprIsExpandable
+    }
+  deriving (Eq)
+
 -- | 'UnfoldingGuidance' says when unfolding should take place
 data UnfoldingGuidance
   = UnfWhen {   -- Inline without thinking about the *size* of the uf_tmpl
@@ -1335,7 +1343,23 @@ data UnfoldingGuidance
   | UnfNever        -- The RHS is big, so don't inline it
   deriving (Eq)
 
-{-
+{- Note [UnfoldingCache]
+~~~~~~~~~~~~~~~~~~~~~~~~
+The UnfoldingCache field of an Unfolding holds four (strict) booleans,
+all derived from the uf_tmpl field of the unfolding.
+
+* We serialise the UnfoldingCache to and from interface files, for
+  reasons described in  Note [Tying the 'CoreUnfolding' knot] in
+  GHC.IfaceToCore
+
+* Because it is a strict data type, we must be careful not to
+  pattern-match on it until we actually want its values.  E.g
+  GHC.Core.Unfold.callSiteInline/tryUnfolding are careful not to force
+  it unnecessarily.  Just saves a bit of work.
+
+* When `seq`ing Core to eliminate space leaks, to suffices to `seq` on
+  the cache, but not its fields, because it is strict in all fields.
+
 Note [Historical note: unfoldings for wrappers]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We used to have a nice clever scheme in interface files for
@@ -1436,42 +1460,44 @@ otherCons _               = []
 -- yield a value (something in HNF): returns @False@ if unsure
 isValueUnfolding :: Unfolding -> Bool
         -- Returns False for OtherCon
-isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
-isValueUnfolding (DFunUnfolding {})                         = True
-isValueUnfolding _                                          = False
+isValueUnfolding (CoreUnfolding { uf_cache = cache }) = uf_is_value cache
+isValueUnfolding (DFunUnfolding {})                   = True
+isValueUnfolding _                                    = False
 
 -- | Determines if it possibly the case that the unfolding will
 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
 -- for 'OtherCon'
 isEvaldUnfolding :: Unfolding -> Bool
         -- Returns True for OtherCon
-isEvaldUnfolding (OtherCon _)                               = True
-isEvaldUnfolding (DFunUnfolding {})                         = True
-isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
-isEvaldUnfolding _                                          = False
+isEvaldUnfolding (OtherCon _)                         = True
+isEvaldUnfolding (DFunUnfolding {})                   = True
+isEvaldUnfolding (CoreUnfolding { uf_cache = cache }) = uf_is_value cache
+isEvaldUnfolding _                                    = False
 
 -- | @True@ if the unfolding is a constructor application, the application
 -- of a CONLIKE function or 'OtherCon'
 isConLikeUnfolding :: Unfolding -> Bool
-isConLikeUnfolding (OtherCon _)                             = True
-isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con })  = con
-isConLikeUnfolding _                                        = False
+isConLikeUnfolding (OtherCon _)                         = True
+isConLikeUnfolding (CoreUnfolding { uf_cache = cache }) = uf_is_conlike cache
+isConLikeUnfolding _                                    = False
 
 -- | Is the thing we will unfold into certainly cheap?
 isCheapUnfolding :: Unfolding -> Bool
-isCheapUnfolding (CoreUnfolding { uf_is_work_free = is_wf }) = is_wf
-isCheapUnfolding _                                           = False
+isCheapUnfolding (CoreUnfolding { uf_cache = cache }) = uf_is_work_free cache
+isCheapUnfolding _                                    = False
 
 isExpandableUnfolding :: Unfolding -> Bool
-isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
-isExpandableUnfolding _                                              = False
+isExpandableUnfolding (CoreUnfolding { uf_cache = cache }) = uf_expandable cache
+isExpandableUnfolding _                                    = False
 
 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
 -- Expand an expandable unfolding; this is used in rule matching
 --   See Note [Expanding variables] in GHC.Core.Rules
 -- The key point here is that CONLIKE things can be expanded
-expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
-expandUnfolding_maybe _                                                       = Nothing
+expandUnfolding_maybe (CoreUnfolding { uf_cache = cache, uf_tmpl = rhs })
+  | uf_expandable cache
+    = Just rhs
+expandUnfolding_maybe _ = Nothing
 
 isCompulsoryUnfolding :: Unfolding -> Bool
 isCompulsoryUnfolding (CoreUnfolding { uf_src = src }) = isCompulsorySource src
diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
index 36c969224c..1e285dcccd 100644
--- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
@@ -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)
+  = 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
@@ -4270,7 +4270,7 @@ simplStableUnfolding env bind_cxt id rhs_ty id_arity unf
                         -- A test case is #4138
                         -- But retain a previous boring_ok of True; e.g. see
                         -- the way it is set in calcUnfoldingGuidanceWithArity
-                        in return (mkCoreUnfolding src is_top_lvl expr' guide')
+                        in return (mkCoreUnfolding src is_top_lvl expr' Nothing guide')
                             -- See Note [Top-level flag on inline rules] in GHC.Core.Unfold
 
                   _other              -- Happens for INLINABLE things
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 262272b5d8..3a8a6b4acc 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -2169,7 +2169,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
+        unf = mkUnfolding uf_opts VanillaSrc is_top_lvl False poly_rhs Nothing
 
         -- We want the unfolding.  Consider
         --      let
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index e24dc20fb9..17559cf4a9 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -627,18 +627,14 @@ instance Outputable Unfolding where
                 <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow)
             2 (ppr con <+> sep (map ppr args))
   ppr (CoreUnfolding { uf_src = src
-                     , uf_tmpl=rhs, uf_is_top=top, uf_is_value=hnf
-                     , uf_is_conlike=conlike, uf_is_work_free=wf
-                     , uf_expandable=exp, uf_guidance=g })
+                     , uf_tmpl=rhs, uf_is_top=top
+                     , uf_cache=cache, uf_guidance=g })
         = text "Unf" <> braces (pp_info $$ pp_rhs)
     where
       pp_info = fsep $ punctuate comma
                 [ text "Src="        <> ppr src
                 , text "TopLvl="     <> ppr top
-                , text "Value="      <> ppr hnf
-                , text "ConLike="    <> ppr conlike
-                , text "WorkFree="   <> ppr wf
-                , text "Expandable=" <> ppr exp
+                , ppr cache
                 , text "Guidance="   <> ppr g ]
       pp_tmpl = ppUnlessOption sdocSuppressUnfoldings
                   (text "Tmpl=" <+> ppr rhs)
@@ -647,6 +643,15 @@ instance Outputable Unfolding where
             -- Don't print the RHS or we get a quadratic
             -- blowup in the size of the printout!
 
+instance Outputable UnfoldingCache where
+    ppr (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike
+                        , uf_is_work_free = wf, uf_expandable = exp })
+        = fsep $ punctuate comma
+          [ text "Value="      <> ppr hnf
+          , text "ConLike="    <> ppr conlike
+          , text "WorkFree="   <> ppr wf
+          , text "Expandable=" <> ppr exp ]
+
 {-
 -----------------------------------------------------
 --      Rules
diff --git a/compiler/GHC/Core/Seq.hs b/compiler/GHC/Core/Seq.hs
index 0addae9775..2f72fc4c9f 100644
--- a/compiler/GHC/Core/Seq.hs
+++ b/compiler/GHC/Core/Seq.hs
@@ -104,10 +104,11 @@ seqAlts (Alt c bs e:alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts al
 
 seqUnfolding :: Unfolding -> ()
 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
-                uf_is_value = b1, uf_is_work_free = b2,
-                uf_expandable = b3, uf_is_conlike = b4,
-                uf_guidance = g})
-  = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
+                uf_cache = cache, uf_guidance = g})
+  = seqExpr e `seq` top `seq` cache `seq` seqGuidance g
+    -- The unf_cache :: UnfoldingCache field is a strict data type,
+    -- so it is sufficient to use plain `seq` for this field
+    -- See Note [UnfoldingCache] in GHC.Core
 
 seqUnfolding _ = ()
 
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index 5638762e08..ba95baec64 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -759,7 +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
-                                    new_rhs
+                                    new_rhs Nothing
 
 simpleUnfoldingFun :: IdUnfoldingFun
 simpleUnfoldingFun id
diff --git a/compiler/GHC/Core/Tidy.hs b/compiler/GHC/Core/Tidy.hs
index 2a4c538ab1..5326346ead 100644
--- a/compiler/GHC/Core/Tidy.hs
+++ b/compiler/GHC/Core/Tidy.hs
@@ -375,15 +375,16 @@ tidyNestedUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = arg
     (tidy_env', bndrs') = tidyBndrs tidy_env bndrs
 
 tidyNestedUnfolding tidy_env
-    unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src, uf_is_value = is_value })
+    unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src, uf_cache = cache })
   | isStableSource src
   = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs }    -- Preserves OccInfo
-            -- This seqIt avoids a space leak: otherwise the uf_is_value,
-            -- uf_is_conlike, ... fields may retain a reference to the
-            -- pre-tidied expression forever (GHC.CoreToIface doesn't look at them)
+            -- This seqIt avoids a space leak: otherwise the uf_cache
+            -- field may retain a reference to the pre-tidied
+            -- expression forever (GHC.CoreToIface doesn't look at
+            -- them)
 
   -- Discard unstable unfoldings, but see Note [Preserve evaluatedness]
-  | is_value = evaldUnfolding
+  | uf_is_value cache = evaldUnfolding
   | otherwise = noUnfolding
 
   where
diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs
index 56f8251e3d..7446a2e983 100644
--- a/compiler/GHC/Core/Unfold.hs
+++ b/compiler/GHC/Core/Unfold.hs
@@ -1036,11 +1036,11 @@ callSiteInline logger opts !case_depth id active_unfolding lone_variable arg_inf
       -- Things with an INLINE pragma may have an unfolding *and*
       -- be a loop breaker  (maybe the knot is not yet untied)
         CoreUnfolding { uf_tmpl = unf_template
-                      , uf_is_work_free = is_wf
-                      , uf_guidance = guidance, uf_expandable = is_exp }
+                      , uf_cache = unf_cache
+                      , uf_guidance = guidance }
           | active_unfolding -> tryUnfolding logger opts case_depth id lone_variable
                                     arg_infos cont_info unf_template
-                                    is_wf is_exp guidance
+                                    unf_cache guidance
           | otherwise -> traceInline logger opts id "Inactive unfolding:" (ppr id) Nothing
         NoUnfolding      -> Nothing
         BootUnfolding    -> Nothing
@@ -1162,11 +1162,10 @@ needed on a per-module basis.
 -}
 
 tryUnfolding :: Logger -> UnfoldingOpts -> Int -> Id -> Bool -> [ArgSummary] -> CallCtxt
-             -> CoreExpr -> Bool -> Bool -> UnfoldingGuidance
+             -> CoreExpr -> UnfoldingCache -> UnfoldingGuidance
              -> Maybe CoreExpr
-tryUnfolding logger opts !case_depth id lone_variable
-             arg_infos cont_info unf_template
-             is_wf is_exp guidance
+tryUnfolding logger opts !case_depth id lone_variable arg_infos
+             cont_info unf_template unf_cache guidance
  = case guidance of
      UnfNever -> traceInline logger opts id str (text "UnfNever") Nothing
 
@@ -1178,7 +1177,7 @@ tryUnfolding logger opts !case_depth id lone_variable
         -> traceInline logger opts id str (mk_doc some_benefit empty False) Nothing
         where
           some_benefit = calc_some_benefit uf_arity
-          enough_args = (n_val_args >= uf_arity) || (unsat_ok && n_val_args > 0)
+          enough_args  = (n_val_args >= uf_arity) || (unsat_ok && n_val_args > 0)
 
      UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }
         | unfoldingVeryAggressive opts
@@ -1189,9 +1188,6 @@ tryUnfolding logger opts !case_depth id lone_variable
         -> traceInline logger opts id str (mk_doc some_benefit extra_doc False) Nothing
         where
           some_benefit = calc_some_benefit (length arg_discounts)
-          extra_doc = vcat [ text "case depth =" <+> int case_depth
-                           , text "depth based penalty =" <+> int depth_penalty
-                           , text "discounted size =" <+> int adjusted_size ]
           -- See Note [Avoid inlining into deeply nested cases]
           depth_treshold = unfoldingCaseThreshold opts
           depth_scaling = unfoldingCaseScaling opts
@@ -1201,7 +1197,18 @@ tryUnfolding logger opts !case_depth id lone_variable
           small_enough = adjusted_size <= unfoldingUseThreshold opts
           discount = computeDiscount arg_discounts res_discount arg_infos cont_info
 
+          extra_doc = vcat [ text "case depth =" <+> int case_depth
+                           , text "depth based penalty =" <+> int depth_penalty
+                           , text "discounted size =" <+> int adjusted_size ]
+
   where
+    -- Unpack the UnfoldingCache lazily because it may not be needed, and all
+    -- its fields are strict; so evaluating unf_cache at all forces all the
+    -- isWorkFree etc computations to take place.  That risks wasting effort for
+    -- Ids that are never going to inline anyway.
+    -- See Note [UnfoldingCache] in GHC.Core
+    UnfoldingCache{ uf_is_work_free = is_wf, uf_expandable = is_exp } = unf_cache
+
     mk_doc some_benefit extra_doc yes_or_no
       = vcat [ text "arg infos" <+> ppr arg_infos
              , text "interesting continuation" <+> ppr cont_info
diff --git a/compiler/GHC/Core/Unfold/Make.hs b/compiler/GHC/Core/Unfold/Make.hs
index adbbdec763..479187005b 100644
--- a/compiler/GHC/Core/Unfold/Make.hs
+++ b/compiler/GHC/Core/Unfold/Make.hs
@@ -6,6 +6,7 @@ module GHC.Core.Unfold.Make
    , mkUnfolding
    , mkCoreUnfolding
    , mkFinalUnfolding
+   , mkFinalUnfolding'
    , mkSimpleUnfolding
    , mkWorkerUnfolding
    , mkInlineUnfoldingWithArity, mkInlineUnfoldingNoArity
@@ -35,6 +36,8 @@ import GHC.Utils.Outputable
 import GHC.Utils.Misc
 import GHC.Utils.Panic
 
+import Data.Maybe ( fromMaybe )
+
 -- the very simple optimiser is used to optimise unfoldings
 import {-# SOURCE #-} GHC.Core.SimpleOpt
 
@@ -43,7 +46,14 @@ import {-# SOURCE #-} GHC.Core.SimpleOpt
 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 expr
+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 -> 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
   = mkUnfolding opts src
                 True {- Top level -}
                 (isDeadEndSig strict_sig)
@@ -57,7 +67,7 @@ mkCompulsoryUnfolding' opts expr = mkCompulsoryUnfolding (simpleOptExpr opts exp
 mkCompulsoryUnfolding :: CoreExpr -> Unfolding
 mkCompulsoryUnfolding expr
   = mkCoreUnfolding CompulsorySrc True
-                    expr
+                    expr Nothing
                     (UnfWhen { ug_arity = 0    -- Arity of unfolding doesn't matter
                              , ug_unsat_ok = unSaturatedOk, ug_boring_ok = boringCxtOk })
 
@@ -69,7 +79,7 @@ mkCompulsoryUnfolding expr
 
 mkSimpleUnfolding :: UnfoldingOpts -> CoreExpr -> Unfolding
 mkSimpleUnfolding !opts rhs
-  = mkUnfolding opts VanillaSrc False False rhs
+  = mkUnfolding opts VanillaSrc False False rhs Nothing
 
 mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding
 mkDFunUnfolding bndrs con ops
@@ -81,7 +91,7 @@ mkDFunUnfolding bndrs con ops
 mkDataConUnfolding :: CoreExpr -> Unfolding
 -- Used for non-newtype data constructors with non-trivial wrappers
 mkDataConUnfolding expr
-  = mkCoreUnfolding StableSystemSrc True expr guide
+  = mkCoreUnfolding StableSystemSrc True expr Nothing guide
     -- No need to simplify the expression
   where
     guide = UnfWhen { ug_arity     = manifestArity expr
@@ -93,7 +103,7 @@ mkWrapperUnfolding :: SimpleOpts -> CoreExpr -> Arity -> Unfolding
 -- after demand/CPR analysis
 mkWrapperUnfolding opts expr arity
   = mkCoreUnfolding StableSystemSrc True
-                    (simpleOptExpr opts expr)
+                    (simpleOptExpr opts expr) Nothing
                     (UnfWhen { ug_arity     = arity
                              , ug_unsat_ok  = unSaturatedOk
                              , ug_boring_ok = boringCxtNotOk })
@@ -104,7 +114,7 @@ mkWorkerUnfolding opts work_fn
                   (CoreUnfolding { uf_src = src, uf_tmpl = tmpl
                                  , uf_is_top = top_lvl })
   | isStableSource src
-  = mkCoreUnfolding src top_lvl new_tmpl guidance
+  = mkCoreUnfolding src top_lvl new_tmpl Nothing guidance
   where
     new_tmpl = simpleOptExpr opts (work_fn tmpl)
     guidance = calcUnfoldingGuidance (so_uf_opts opts) False new_tmpl
@@ -119,7 +129,7 @@ mkInlineUnfoldingNoArity :: SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfoldi
 mkInlineUnfoldingNoArity opts src expr
   = mkCoreUnfolding src
                     True         -- Note [Top-level flag on inline rules]
-                    expr' guide
+                    expr' Nothing guide
   where
     expr' = simpleOptExpr opts expr
     guide = UnfWhen { ug_arity = manifestArity expr'
@@ -133,7 +143,7 @@ mkInlineUnfoldingWithArity :: SimpleOpts -> UnfoldingSource -> Arity -> CoreExpr
 mkInlineUnfoldingWithArity opts src arity expr
   = mkCoreUnfolding src
                     True         -- Note [Top-level flag on inline rules]
-                    expr' guide
+                    expr' Nothing guide
   where
     expr' = simpleOptExpr opts expr
     guide = UnfWhen { ug_arity = arity
@@ -146,7 +156,7 @@ mkInlineUnfoldingWithArity opts src arity expr
 
 mkInlinableUnfolding :: SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfolding
 mkInlinableUnfolding opts src expr
-  = mkUnfolding (so_uf_opts opts) src False False expr'
+  = mkUnfolding (so_uf_opts opts) src False False expr' Nothing
   where
     expr' = simpleOptExpr opts expr
 
@@ -180,7 +190,7 @@ specUnfolding opts spec_bndrs spec_app rule_lhs_args
                              , uf_guidance = old_guidance })
  | isStableSource src  -- See Note [Specialising unfoldings]
  , UnfWhen { ug_arity = old_arity } <- old_guidance
- = mkCoreUnfolding src top_lvl new_tmpl
+ = mkCoreUnfolding src top_lvl new_tmpl Nothing
                    (old_guidance { ug_arity = old_arity - arity_decrease })
  where
    new_tmpl = simpleOptExpr opts $
@@ -310,11 +320,12 @@ mkUnfolding :: UnfoldingOpts
             -> Bool       -- Definitely a bottoming binding
                           -- (only relevant for top-level bindings)
             -> CoreExpr
+            -> Maybe UnfoldingCache
             -> Unfolding
 -- Calculates unfolding guidance
 -- Occurrence-analyses the expression before capturing it
-mkUnfolding opts src top_lvl is_bottoming expr
-  = mkCoreUnfolding src top_lvl expr guidance
+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         = calcUnfoldingGuidance opts is_top_bottoming expr
@@ -322,26 +333,20 @@ mkUnfolding opts src top_lvl is_bottoming expr
         -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]
 
 mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr
-                -> UnfoldingGuidance -> Unfolding
+                -> Maybe UnfoldingCache -> UnfoldingGuidance -> Unfolding
 -- Occurrence-analyses the expression before capturing it
-mkCoreUnfolding src top_lvl expr guidance
-  = CoreUnfolding { uf_tmpl = is_value `seq`
-                              is_conlike `seq`
-                              is_work_free `seq`
-                              is_expandable `seq`
+mkCoreUnfolding src top_lvl expr precomputed_cache guidance
+  = CoreUnfolding { uf_tmpl = cache `seq`
                               occurAnalyseExpr expr
       -- occAnalyseExpr: see Note [Occurrence analysis of unfoldings]
-      -- See #20905 for what a discussion of these 'seq's
+      -- See #20905 for what a discussion of this 'seq'.
       -- We are careful to make sure we only
       -- have one copy of an unfolding around at once.
       -- Note [Thoughtful forcing in mkCoreUnfolding]
 
                   , uf_src          = src
                   , uf_is_top       = top_lvl
-                  , uf_is_value     = is_value
-                  , uf_is_conlike   = is_conlike
-                  , uf_is_work_free = is_work_free
-                  , uf_expandable   = is_expandable
+                  , uf_cache        = cache
                   , uf_guidance     = guidance }
   where
     is_value      = exprIsHNF expr
@@ -349,6 +354,13 @@ mkCoreUnfolding src top_lvl expr guidance
     is_work_free  = exprIsWorkFree expr
     is_expandable = exprIsExpandable expr
 
+    recomputed_cache = UnfoldingCache { uf_is_value = is_value
+                                      , uf_is_conlike = is_conlike
+                                      , uf_is_work_free = is_work_free
+                                      , uf_expandable = is_expandable }
+
+    cache = fromMaybe recomputed_cache precomputed_cache
+
 ----------------
 certainlyWillInline :: UnfoldingOpts -> IdInfo -> CoreExpr -> Maybe Unfolding
 -- ^ Sees if the unfolding is pretty certain to inline.
@@ -476,4 +488,3 @@ reducing memory pressure.
 The result of fixing this led to a 1G reduction in peak memory usage (12G -> 11G) when
 compiling a very large module (peak 3 million terms). For more discussion see #20905.
 -}
-
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 3f3ef30a14..c88ddb3d55 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -2253,10 +2253,9 @@ diffUnfold env (DFunUnfolding bs1 c1 a1)
   | c1 == c2 && equalLength bs1 bs2
   = concatMap (uncurry (diffExpr False env')) (zip a1 a2)
   where env' = rnBndrs2 env bs1 bs2
-diffUnfold env (CoreUnfolding t1 _ _ v1 cl1 wf1 x1 g1)
-               (CoreUnfolding t2 _ _ v2 cl2 wf2 x2 g2)
-  | v1 == v2 && cl1 == cl2
-    && wf1 == wf2 && x1 == x2 && g1 == g2
+diffUnfold env (CoreUnfolding t1 _ _ c1 g1)
+               (CoreUnfolding t2 _ _ c2 g2)
+  | c1 == c2 && g1 == g2
   = diffExpr False env t1 t2
 diffUnfold _   uf1 uf2
   = [fsep [ppr uf1, text "/=", ppr uf2]]
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index 88a450e3df..4194939082 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -508,9 +508,10 @@ toIfaceJoinInfo Nothing   = IfaceNotJoinPoint
 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
 toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs
                                 , uf_src = src
+                                , uf_cache = cache
                                 , uf_guidance = guidance })
   = Just $ HsUnfold lb $
-    IfCoreUnfold src (toIfGuidance src guidance) (toIfaceExpr rhs)
+    IfCoreUnfold src cache (toIfGuidance src guidance) (toIfaceExpr rhs)
         -- Yes, even if guidance is UnfNever, expose the unfolding
         -- If we didn't want to expose the unfolding, GHC.Iface.Tidy would
         -- have stuck in NoUnfolding.  For supercompilation we want
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index a14b3959ea..922f8881ff 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -596,8 +596,8 @@ rnIfaceInfoItem i
     = pure i
 
 rnIfaceUnfolding :: Rename IfaceUnfolding
-rnIfaceUnfolding (IfCoreUnfold src guide if_expr)
-    = IfCoreUnfold src guide <$> rnIfaceExpr if_expr
+rnIfaceUnfolding (IfCoreUnfold src cache guide if_expr)
+    = IfCoreUnfold src cache guide <$> rnIfaceExpr if_expr
 rnIfaceUnfolding (IfDFunUnfold bs ops)
     = IfDFunUnfold <$> rnIfaceBndrs bs <*> mapM rnIfaceExpr ops
 
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index a633f59fbc..4ff4ab7eee 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -49,7 +49,7 @@ import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey,
 import GHC.Types.Unique ( hasKey )
 import GHC.Iface.Type
 import GHC.Iface.Recomp.Binary
-import GHC.Core( IsOrphan, isOrphan )
+import GHC.Core( IsOrphan, isOrphan, UnfoldingCache(..) )
 import GHC.Types.Demand
 import GHC.Types.Cpr
 import GHC.Core.Class
@@ -365,9 +365,14 @@ data IfaceInfoItem
 -- only later attached to the Id.  Partial reason: some are orphans.
 
 data IfaceUnfolding
-  = IfCoreUnfold UnfoldingSource IfGuidance IfaceExpr
+  = IfCoreUnfold UnfoldingSource
+                 IfUnfoldingCache -- See Note [Tying the 'CoreUnfolding' knot]
+                 IfGuidance
+                 IfaceExpr
   | IfDFunUnfold [IfaceBndr] [IfaceExpr]
 
+type IfUnfoldingCache = UnfoldingCache
+
 data IfGuidance
   = IfNoGuidance            -- Compute it from the IfaceExpr
   | IfWhen Arity Bool Bool  -- Just like UnfWhen in Core.UnfoldingGuidance
@@ -1522,7 +1527,7 @@ instance Outputable IfaceJoinInfo where
   ppr (IfaceJoinPoint ar) = angleBrackets (text "join" <+> ppr ar)
 
 instance Outputable IfaceUnfolding where
-  ppr (IfCoreUnfold src guide e)
+  ppr (IfCoreUnfold src _ guide e)
     = sep [ text "Core:" <+> ppr src <+> ppr guide, ppr e ]
   ppr (IfDFunUnfold bs es) = hang (text "DFun:" <+> sep (map ppr bs) <> dot)
                                 2 (sep (map pprParendIfaceExpr es))
@@ -1774,7 +1779,7 @@ freeNamesItem (HsLFInfo (IfLFCon n)) = unitNameSet n
 freeNamesItem _                      = emptyNameSet
 
 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
-freeNamesIfUnfold (IfCoreUnfold _ _ e)   = freeNamesIfExpr e
+freeNamesIfUnfold (IfCoreUnfold _ _ _ e) = freeNamesIfExpr e
 freeNamesIfUnfold (IfDFunUnfold bs es)   = freeNamesIfBndrs bs &&& fnList freeNamesIfExpr es
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
@@ -2296,9 +2301,10 @@ instance Binary IfaceInfoItem where
             _ -> HsTagSig <$> get bh
 
 instance Binary IfaceUnfolding where
-    put_ bh (IfCoreUnfold s g e) = do
+    put_ bh (IfCoreUnfold s c g e) = do
         putByte bh 0
         put_ bh s
+        putUnfoldingCache bh c
         put_ bh g
         put_ bh e
     put_ bh (IfDFunUnfold as bs) = do
@@ -2309,9 +2315,10 @@ instance Binary IfaceUnfolding where
         h <- getByte bh
         case h of
             0 -> do s <- get bh
+                    c <- getUnfoldingCache bh
                     g <- get bh
                     e <- get bh
-                    return (IfCoreUnfold s g e)
+                    return (IfCoreUnfold s c g e)
             _ -> do as <- get bh
                     bs <- get bh
                     return (IfDFunUnfold as bs)
@@ -2332,6 +2339,26 @@ instance Binary IfGuidance where
                     c <- get bh
                     return (IfWhen a b c)
 
+putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO ()
+putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike
+                                     , uf_is_work_free = wf, uf_expandable = exp }) = do
+    let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp
+    putByte bh b
+
+getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache
+getUnfoldingCache bh = do
+    b <- getByte bh
+    let hnf     = testBit b 3
+        conlike = testBit b 2
+        wf      = testBit b 1
+        exp     = testBit b 0
+    return (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike
+                           , uf_is_work_free = wf, uf_expandable = exp })
+
+infixl 9 .<<|.
+(.<<|.) :: (Bits a) => a -> Bool -> a
+x .<<|. b = (if b then (`setBit` 0) else id) (x `shiftL` 1)
+
 instance Binary IfaceAlt where
     put_ bh (IfaceAlt a b c) = do
         put_ bh a
@@ -2688,8 +2715,9 @@ instance NFData IfGuidance where
 
 instance NFData IfaceUnfolding where
   rnf = \case
-    IfCoreUnfold src guidance expr -> src `seq` rnf guidance `seq` rnf expr
-    IfDFunUnfold bndrs exprs       -> rnf bndrs `seq` rnf exprs
+    IfCoreUnfold src cache guidance expr -> src `seq` cache `seq` rnf guidance `seq` rnf expr
+    IfDFunUnfold bndrs exprs             -> rnf bndrs `seq` rnf exprs
+    -- See Note [UnfoldingCache] in GHC.Core for why it suffices to merely `seq` on cache
 
 instance NFData IfaceExpr where
   rnf = \case
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index f4bb4057c9..a69cc34a73 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -1715,7 +1715,7 @@ tcIdInfo ignore_prags toplvl name ty info = do
     need_prag :: IfaceInfoItem -> Bool
       -- Always read in compulsory unfoldings
       -- See Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy
-    need_prag (HsUnfold _ (IfCoreUnfold src _ _)) = isCompulsorySource src
+    need_prag (HsUnfold _ (IfCoreUnfold src _ _ _)) = isCompulsorySource src
     need_prag _ = False
 
     tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
@@ -1776,13 +1776,14 @@ tcLFInfo lfi = case lfi of
 
 tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
 -- See Note [Lazily checking Unfoldings]
-tcUnfolding toplvl name _ info (IfCoreUnfold src if_guidance if_expr)
+tcUnfolding toplvl name _ info (IfCoreUnfold src cache if_guidance if_expr)
   = do  { uf_opts <- unfoldingOpts <$> getDynFlags
         ; expr <- tcUnfoldingRhs (isCompulsorySource src) toplvl name if_expr
         ; let guidance = case if_guidance of
                  IfWhen arity unsat_ok boring_ok -> UnfWhen arity unsat_ok boring_ok
                  IfNoGuidance -> calcUnfoldingGuidance uf_opts is_top_bottoming expr
-        ; return $ mkCoreUnfolding src True expr guidance }
+          -- See Note [Tying the 'CoreUnfolding' knot]
+        ; return $ mkCoreUnfolding src True expr (Just cache) guidance }
   where
     -- Strictness should occur before unfolding!
     is_top_bottoming = isTopLevel toplvl && isDeadEndSig (dmdSigInfo info)
@@ -1795,6 +1796,49 @@ tcUnfolding _toplvl name dfun_ty _ (IfDFunUnfold bs ops)
     doc = text "Class ops for dfun" <+> ppr name
     (_, _, cls, _) = tcSplitDFunTy dfun_ty
 
+{- Note [Tying the 'CoreUnfolding' knot]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The unfolding of recursive definitions can contain references to the
+Id being defined. Consider the following example:
+
+    foo :: ()
+    foo = foo
+
+The unfolding template of 'foo' is, of course, 'foo'; so the interface
+file for this module contains:
+
+    foo :: ();  Unfolding = foo
+
+When rehydrating the interface file we are going to make an Id for
+'foo' (in GHC.IfaceToCore), with an 'Unfolding'. We used to make this
+'Unfolding' by calling 'mkFinalUnfolding', but that needs to populate,
+among other fields, the 'uf_is_value' field, by computing
+'exprIsValue' of the template (in this case, 'foo').
+
+'exprIsValue e' looks at the unfoldings of variables in 'e' to see if
+they are evaluated; so it consults the `uf_is_value` field of
+variables in `e`. Now we can see the problem: to set the `uf_is_value`
+field of `foo`'s unfolding, we look at its unfolding (in this case
+just `foo` itself!). Loop. This is the root cause of ticket #22272.
+
+The simple solution we chose is to serialise the various auxiliary
+fields of `CoreUnfolding` so that we don't need to recreate them when
+rehydrating. Specifically, the following fields are moved to the
+'UnfoldingCache', which is persisted in the interface file:
+
+* 'uf_is_conlike'
+* 'uf_is_value'
+* 'uf_is_work_free'
+* 'uf_expandable'
+
+These four bits make the interface files only one byte larger per
+unfolding; on the other hand, this does save calls to 'exprIsValue',
+'exprIsExpandable' etc for every imported Id.
+
+We could choose to do this only for loop breakers. But that's a bit
+more complicated and it seems good all round.
+-}
+
 {- Note [Lazily checking Unfoldings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 For unfoldings, we try to do the job lazily, so that we never typecheck
diff --git a/testsuite/tests/deSugar/should_compile/T13208.stdout b/testsuite/tests/deSugar/should_compile/T13208.stdout
index b7ba07cdf4..f018ac1a2c 100644
--- a/testsuite/tests/deSugar/should_compile/T13208.stdout
+++ b/testsuite/tests/deSugar/should_compile/T13208.stdout
@@ -1,6 +1,6 @@
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
 f = \ (@p) _ [Occ=Dead] -> GHC.Types.True
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 80 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
diff --git a/testsuite/tests/numeric/should_compile/T14170.stdout b/testsuite/tests/numeric/should_compile/T14170.stdout
index 286d60bc0a..197cccc422 100644
--- a/testsuite/tests/numeric/should_compile/T14170.stdout
+++ b/testsuite/tests/numeric/should_compile/T14170.stdout
@@ -6,44 +6,50 @@ Result size of Tidy Core
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 NatVal.$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}]
 NatVal.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 NatVal.$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}]
 NatVal.$trModule3 = GHC.Types.TrNameS NatVal.$trModule4
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 NatVal.$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}]
 NatVal.$trModule2 = "NatVal"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 NatVal.$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}]
 NatVal.$trModule1 = GHC.Types.TrNameS NatVal.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 NatVal.$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}]
 NatVal.$trModule
   = GHC.Types.Module NatVal.$trModule3 NatVal.$trModule1
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 foo :: Integer
 [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}]
 foo = GHC.Num.Integer.IS 0#
 
 
diff --git a/testsuite/tests/numeric/should_compile/T14465.stdout b/testsuite/tests/numeric/should_compile/T14465.stdout
index 7ce467bc60..afac0e2c94 100644
--- a/testsuite/tests/numeric/should_compile/T14465.stdout
+++ b/testsuite/tests/numeric/should_compile/T14465.stdout
@@ -6,43 +6,49 @@ Result size of Tidy Core
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 ten :: Natural
 [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}]
 ten = GHC.Num.Natural.NS 10##
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 M.$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}]
 M.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 M.$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}]
 M.$trModule3 = GHC.Types.TrNameS M.$trModule4
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 M.$trModule2 :: 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}]
 M.$trModule2 = "M"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 M.$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}]
 M.$trModule1 = GHC.Types.TrNameS M.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 M.$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}]
 M.$trModule = GHC.Types.Module M.$trModule3 M.$trModule1
 
 -- RHS size: {terms: 1, types: 1, coercions: 0, joins: 0/0}
@@ -50,23 +56,25 @@ minusOne :: Natural
 [GblId,
  Str=b,
  Cpr=b,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=False, ConLike=False, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
 minusOne = GHC.Prim.Exception.raiseUnderflow @Natural
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 twoTimesTwo :: Natural
 [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}]
 twoTimesTwo = GHC.Num.Natural.NS 4##
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 M.one1 :: Natural
 [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}]
 M.one1 = GHC.Num.Natural.NS 1##
 
 -- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0}
@@ -74,15 +82,16 @@ plusOne :: Natural -> Natural
 [GblId,
  Arity=1,
  Str=<1L>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 30 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [0] 30 0}]
 plusOne = \ (n :: Natural) -> naturalAdd n M.one1
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 one :: Natural
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
 one = M.one1
 
diff --git a/testsuite/tests/numeric/should_compile/T7116.stdout b/testsuite/tests/numeric/should_compile/T7116.stdout
index 407a057855..afcf45932e 100644
--- a/testsuite/tests/numeric/should_compile/T7116.stdout
+++ b/testsuite/tests/numeric/should_compile/T7116.stdout
@@ -6,36 +6,41 @@ Result size of Tidy Core
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T7116.$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}]
 T7116.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T7116.$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}]
 T7116.$trModule3 = GHC.Types.TrNameS T7116.$trModule4
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T7116.$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}]
 T7116.$trModule2 = "T7116"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T7116.$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}]
 T7116.$trModule1 = GHC.Types.TrNameS T7116.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T7116.$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}]
 T7116.$trModule
   = GHC.Types.Module T7116.$trModule3 T7116.$trModule1
 
@@ -45,8 +50,8 @@ dr :: Double -> Double
  Arity=1,
  Str=<1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=StableSystem, 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=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (x [Occ=Once1!] :: Double) ->
                  case x of { GHC.Types.D# x1 ->
@@ -62,8 +67,8 @@ dl :: Double -> Double
  Arity=1,
  Str=<1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
 dl = dr
 
@@ -73,8 +78,8 @@ fr :: Float -> Float
  Arity=1,
  Str=<1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=StableSystem, 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=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (x [Occ=Once1!] :: Float) ->
                  case x of { GHC.Types.F# x1 ->
@@ -92,8 +97,8 @@ fl :: Float -> Float
  Arity=1,
  Str=<1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
 fl = fr
 
diff --git a/testsuite/tests/simplCore/should_compile/T22272.hs b/testsuite/tests/simplCore/should_compile/T22272.hs
new file mode 100644
index 0000000000..dfcc5a0567
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22272.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module T22272 where
+
+import T22272_A
+
+bar :: ()
+bar = foo
diff --git a/testsuite/tests/simplCore/should_compile/T22272.stderr b/testsuite/tests/simplCore/should_compile/T22272.stderr
new file mode 100644
index 0000000000..80ba25439d
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22272.stderr
@@ -0,0 +1,2 @@
+[1 of 2] Compiling T22272_A         ( T22272_A.hs, T22272_A.o )
+[2 of 2] Compiling T22272           ( T22272.hs, T22272.o )
diff --git a/testsuite/tests/simplCore/should_compile/T22272_A.hs b/testsuite/tests/simplCore/should_compile/T22272_A.hs
new file mode 100644
index 0000000000..d84750d2f6
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22272_A.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module T22272_A where
+
+foo :: ()
+foo = foo
diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout
index 6faaab181a..43847f89e5 100644
--- a/testsuite/tests/simplCore/should_compile/T3772.stdout
+++ b/testsuite/tests/simplCore/should_compile/T3772.stdout
@@ -6,36 +6,41 @@ Result size of Tidy Core
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T3772.$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}]
 T3772.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T3772.$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}]
 T3772.$trModule3 = GHC.Types.TrNameS T3772.$trModule4
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T3772.$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}]
 T3772.$trModule2 = "T3772"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T3772.$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}]
 T3772.$trModule1 = GHC.Types.TrNameS T3772.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T3772.$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}]
 T3772.$trModule
   = GHC.Types.Module T3772.$trModule3 T3772.$trModule1
 
@@ -67,8 +72,8 @@ foo [InlPrag=NOINLINE[final]] :: Int -> ()
  Arity=1,
  Str=<1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=StableSystem, 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=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (n [Occ=Once1!] :: Int) ->
                  case n of { GHC.Types.I# ww [Occ=Once1] ->
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 46bf60e1ae..5209c0c7cb 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -457,3 +457,4 @@ test('T22317', [grep_errmsg(r'ANSWER = YES') ], compile, ['-O -dinline-check m -
 test('T22494', [grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
 test('T22491', normal, compile, ['-O2'])
 test('T21476', normal, compile, [''])
+test('T22272', normal, multimod_compile, ['T22272', '-O -fexpose-all-unfoldings -fno-omit-interface-pragmas -fno-ignore-interface-pragmas'])