DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208)

In #23208 we observed that the demand signature of a binder occuring in a RULE
wasn't unleashed, leading to a transitively used binder being discarded as
absent. The solution was to use the same code path that we already use for
handling exported bindings.

See the changes to `Note [Absence analysis for stable unfoldings and RULES]`
for more details.

I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a
`VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our
existing framework. As a result, I had to touch quite a few places in the code.

This refactoring exposed a few small bugs around correct handling of bottoming
demand environments. As a result, some strictness signatures now mention uniques
that weren't there before which caused test output changes to T13143, T19969 and
T22112. But these tests compared whole -ddump-simpl listings which is a very
fragile thing to begin with. I changed what exactly they test for based on the
symptoms in the corresponding issues.

There is a single regression in T18894 because we are more conservative around
stable unfoldings now. Unfortunately it is not easily fixed; let's wait until
there is a concrete motivation before invest more time.

Fixes #23208.

14 files changed, 469 insertions, 356 deletions

diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs
index ece13d894b..0b74a9e1d2 100644
--- a/compiler/GHC/Core/Opt/DmdAnal.hs
+++ b/compiler/GHC/Core/Opt/DmdAnal.hs
@@ -97,28 +97,35 @@ dmdAnalProgram opts fam_envs rules binds
       where
         anal_body env'
           | WithDmdType body_ty bs' <- go env' bs
-          = WithDmdType (add_exported_uses env' body_ty (bindersOf b)) bs'
+          = WithDmdType (body_ty `plusDmdType` keep_alive_roots env' (bindersOf b)) bs'
 
     cons_up :: WithDmdType (DmdResult b [b]) -> WithDmdType [b]
     cons_up (WithDmdType dmd_ty (R b' bs')) = WithDmdType dmd_ty (b' : bs')
 
-    add_exported_uses :: AnalEnv -> DmdType -> [Id] -> DmdType
-    add_exported_uses env = foldl' (add_exported_use env)
-
-    -- If @e@ is denoted by @dmd_ty@, then @add_exported_use _ dmd_ty id@
-    -- corresponds to the demand type of @(id, e)@, but is a lot more direct.
-    -- See Note [Analysing top-level bindings].
-    add_exported_use :: AnalEnv -> DmdType -> Id -> DmdType
-    add_exported_use env dmd_ty id
-      | isExportedId id || elemVarSet id rule_fvs
-      -- See Note [Absence analysis for stable unfoldings and RULES]
-      = dmd_ty `plusDmdType` fst (dmdAnalStar env topDmd (Var id))
-      | otherwise
-      = dmd_ty
+    keep_alive_roots :: AnalEnv -> [Id] -> DmdEnv
+    -- See Note [Absence analysis for stable unfoldings and RULES]
+    -- Here we keep alive "roots", e.g., exported ids and stuff mentioned in
+    -- orphan RULES
+    keep_alive_roots env ids = plusDmdEnvs (map (demandRoot env) (filter is_root ids))
+
+    is_root :: Id -> Bool
+    is_root id = isExportedId id || elemVarSet id rule_fvs
 
     rule_fvs :: IdSet
     rule_fvs = rulesRhsFreeIds rules
 
+demandRoot :: AnalEnv -> Id -> DmdEnv
+-- See Note [Absence analysis for stable unfoldings and RULES]
+demandRoot env id = fst (dmdAnalStar env topDmd (Var id))
+
+demandRoots :: AnalEnv -> [Id] -> DmdEnv
+-- See Note [Absence analysis for stable unfoldings and RULES]
+demandRoots env roots = plusDmdEnvs (map (demandRoot env) roots)
+
+demandRootSet :: AnalEnv -> IdSet -> DmdEnv
+demandRootSet env ids = demandRoots env (nonDetEltsUniqSet ids)
+  -- It's OK to use nonDetEltsUniqSet here because plusDmdType is commutative
+
 -- | We attach useful (e.g. not 'topDmd') 'idDemandInfo' to top-level bindings
 -- that satisfy this function.
 --
@@ -343,7 +350,7 @@ dmdAnalBindLetUp top_lvl env id rhs anal_body = WithDmdType final_ty (R (NonRec
 
     -- See Note [Absence analysis for stable unfoldings and RULES]
     rule_fvs           = bndrRuleAndUnfoldingIds id
-    final_ty           = body_ty' `plusDmdType` rhs_ty `keepAliveDmdType` rule_fvs
+    final_ty           = body_ty' `plusDmdType` rhs_ty `plusDmdType` demandRootSet env rule_fvs
 
 -- | Let bindings can be processed in two ways:
 -- Down (RHS before body) or Up (body before RHS).
@@ -360,18 +367,18 @@ dmdAnalBindLetUp top_lvl env id rhs anal_body = WithDmdType final_ty (R (NonRec
 dmdAnalBindLetDown :: TopLevelFlag -> AnalEnv -> SubDemand -> CoreBind -> (AnalEnv -> WithDmdType a) -> WithDmdType (DmdResult CoreBind a)
 dmdAnalBindLetDown top_lvl env dmd bind anal_body = case bind of
   NonRec id rhs
-    | (env', lazy_fv, id1, rhs1) <-
+    | (env', weak_fv, id1, rhs1) <-
         dmdAnalRhsSig top_lvl NonRecursive env dmd id rhs
-    -> do_rest env' lazy_fv [(id1, rhs1)] (uncurry NonRec . only)
+    -> do_rest env' weak_fv [(id1, rhs1)] (uncurry NonRec . only)
   Rec pairs
-    | (env', lazy_fv, pairs') <- dmdFix top_lvl env dmd pairs
-    -> do_rest env' lazy_fv pairs' Rec
+    | (env', weak_fv, pairs') <- dmdFix top_lvl env dmd pairs
+    -> do_rest env' weak_fv pairs' Rec
   where
-    do_rest env' lazy_fv pairs1 build_bind = WithDmdType final_ty (R (build_bind pairs2) body')
+    do_rest env' weak_fv pairs1 build_bind = WithDmdType final_ty (R (build_bind pairs2) body')
       where
         WithDmdType body_ty body'        = anal_body env'
         -- see Note [Lazy and unleashable free variables]
-        dmd_ty                          = addLazyFVs body_ty lazy_fv
+        dmd_ty                          = addWeakFVs body_ty weak_fv
         WithDmdType final_ty id_dmds    = findBndrsDmds env' dmd_ty (strictMap fst pairs1)
         -- Important to force this as build_bind might not force it.
         !pairs2                         = strictZipWith do_one pairs1 id_dmds
@@ -408,14 +415,14 @@ anticipateANF e n
 dmdAnalStar :: AnalEnv
             -> Demand   -- This one takes a *Demand*
             -> CoreExpr
-            -> (PlusDmdArg, CoreExpr)
+            -> (DmdEnv, CoreExpr)
 dmdAnalStar env (n :* sd) e
   -- NB: (:*) expands AbsDmd and BotDmd as needed
   | WithDmdType dmd_ty e' <- dmdAnal env sd e
   , n' <- anticipateANF e n
       -- See Note [Anticipating ANF in demand analysis]
       -- and Note [Analysing with absent demand]
-  = (toPlusDmdArg $ multDmdType n' dmd_ty, e')
+  = (discardArgDmds $ multDmdType n' dmd_ty, e')
 
 -- Main Demand Analysis machinery
 dmdAnal, dmdAnal' :: AnalEnv
@@ -428,13 +435,13 @@ dmdAnal env d e = -- pprTrace "dmdAnal" (ppr d <+> ppr e) $
 dmdAnal' _ _ (Lit lit)     = WithDmdType nopDmdType (Lit lit)
 dmdAnal' _ _ (Type ty)     = WithDmdType nopDmdType (Type ty) -- Doesn't happen, in fact
 dmdAnal' _ _ (Coercion co)
-  = WithDmdType (unitDmdType (coercionDmdEnv co)) (Coercion co)
+  = WithDmdType (noArgsDmdType (coercionDmdEnv co)) (Coercion co)
 
 dmdAnal' env dmd (Var var)
   = WithDmdType (dmdTransform env var dmd) (Var var)
 
 dmdAnal' env dmd (Cast e co)
-  = WithDmdType (dmd_ty `plusDmdType` mkPlusDmdArg (coercionDmdEnv co)) (Cast e' co)
+  = WithDmdType (dmd_ty `plusDmdType` coercionDmdEnv co) (Cast e' co)
   where
     WithDmdType dmd_ty e' = dmdAnal env dmd e
 
@@ -532,7 +539,7 @@ dmdAnal' env dmd (Case scrut case_bndr ty [Alt alt_con bndrs rhs])
           = alt_ty2
 
         WithDmdType scrut_ty scrut' = dmdAnal env scrut_sd scrut
-        res_ty             = alt_ty3 `plusDmdType` toPlusDmdArg scrut_ty
+        res_ty             = alt_ty3 `plusDmdType` discardArgDmds scrut_ty
     in
 --    pprTrace "dmdAnal:Case1" (vcat [ text "scrut" <+> ppr scrut
 --                                   , text "dmd" <+> ppr dmd
@@ -569,7 +576,7 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts)
           = deferAfterPreciseException alt_ty1
           | otherwise
           = alt_ty1
-        res_ty               = alt_ty2 `plusDmdType` toPlusDmdArg scrut_ty
+        res_ty               = scrut_ty `plusDmdType` discardArgDmds alt_ty2
 
     in
 --    pprTrace "dmdAnal:Case2" (vcat [ text "scrut" <+> ppr scrut
@@ -1030,7 +1037,7 @@ dmdTransform env var sd
   --   * Case and constructor field binders
   | otherwise
   = -- pprTrace "dmdTransform:other" (vcat [ppr var, ppr boxity, ppr sd]) $
-    unitDmdType (unitVarEnv var (C_11 :* sd))
+    noArgsDmdType (addVarDmdEnv nopDmdEnv var (C_11 :* sd))
 
 {- *********************************************************************
 *                                                                      *
@@ -1038,6 +1045,10 @@ dmdTransform env var sd
 *                                                                      *
 ********************************************************************* -}
 
+-- | An environment in which all demands are weak according to 'isWeakDmd'.
+-- See Note [Lazy and unleashable free variables].
+type WeakDmds = VarEnv Demand
+
 -- | @dmdAnalRhsSig@ analyses the given RHS to compute a demand signature
 -- for the LetDown rule. It works as follows:
 --
@@ -1052,13 +1063,13 @@ dmdAnalRhsSig
   -> RecFlag
   -> AnalEnv -> SubDemand
   -> Id -> CoreExpr
-  -> (AnalEnv, DmdEnv, Id, CoreExpr)
+  -> (AnalEnv, WeakDmds, Id, CoreExpr)
 -- Process the RHS of the binding, add the strictness signature
 -- to the Id, and augment the environment with the signature as well.
 -- See Note [NOINLINE and strictness]
 dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs
-  = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr rhs_dmds $$ ppr sig $$ ppr lazy_fv) $
-    (final_env, lazy_fv, final_id, final_rhs)
+  = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr rhs_dmds $$ ppr sig $$ ppr weak_fvs) $
+    (final_env, weak_fvs, final_id, final_rhs)
   where
     threshold_arity = thresholdArity id rhs
 
@@ -1076,11 +1087,11 @@ dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs
       = unboxedWhenSmall env rec_flag (resultType_maybe id) topSubDmd
 
     WithDmdType rhs_dmd_ty rhs' = dmdAnal env rhs_dmd rhs
-    DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty
+    DmdType rhs_env rhs_dmds = rhs_dmd_ty
     (final_rhs_dmds, final_rhs) = finaliseArgBoxities env id threshold_arity
-                                                      rhs_dmds rhs_div rhs'
+                                                      rhs_dmds (de_div rhs_env) rhs'
 
-    sig = mkDmdSigForArity threshold_arity (DmdType sig_fv final_rhs_dmds rhs_div)
+    sig = mkDmdSigForArity threshold_arity (DmdType sig_env final_rhs_dmds)
 
     opts       = ae_opts env
     final_id   = setIdDmdAndBoxSig opts id sig
@@ -1098,15 +1109,19 @@ dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs
     --        we'd have to do an additional iteration. reuseEnv makes sure that
     --        we never get used-once info for FVs of recursive functions.
     --        See #14816 where we try to get rid of reuseEnv.
-    rhs_fv1 = case rec_flag of
-                Recursive    -> reuseEnv rhs_fv
-                NonRecursive -> rhs_fv
+    rhs_env1 = case rec_flag of
+                Recursive    -> reuseEnv rhs_env
+                NonRecursive -> rhs_env
 
     -- See Note [Absence analysis for stable unfoldings and RULES]
-    rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` bndrRuleAndUnfoldingIds id
+    rhs_env2 = rhs_env1 `plusDmdEnv` demandRootSet env (bndrRuleAndUnfoldingIds id)
 
     -- See Note [Lazy and unleashable free variables]
-    !(!lazy_fv, !sig_fv) = partitionVarEnv isWeakDmd rhs_fv2
+    !(!sig_env, !weak_fvs) = splitWeakDmds rhs_env2
+
+splitWeakDmds :: DmdEnv -> (DmdEnv, WeakDmds)
+splitWeakDmds (DE fvs div) = (DE sig_fvs div, weak_fvs)
+  where (!weak_fvs, !sig_fvs) = partitionVarEnv isWeakDmd fvs
 
 thresholdArity :: Id -> CoreExpr -> Arity
 -- See Note [Demand signatures are computed for a threshold arity based on idArity]
@@ -1365,8 +1380,8 @@ GHC.Core.Opt.Arity)! A small example is the test case NewtypeArity.
 
 Note [Absence analysis for stable unfoldings and RULES]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Ticket #18638 shows that it's really important to do absence analysis
-for stable unfoldings. Consider
+Among others, tickets #18638 and #23208 show that it's really important to treat
+stable unfoldings as demanded. Consider
 
    g = blah
 
@@ -1383,23 +1398,47 @@ and transform to
 
 Now if f is subsequently inlined, we'll use 'g' and ... disaster.
 
-SOLUTION: if f has a stable unfolding, adjust its DmdEnv (the demands
-on its free variables) so that no variable mentioned in its unfolding
-is Absent.  This is done by the function Demand.keepAliveDmdEnv.
-
-ALSO: do the same for Ids free in the RHS of any RULES for f.
+SOLUTION: if f has a stable unfolding, treat every free variable as a
+/demand root/, that is: Analyse it as if it was a variable occuring in a
+'topDmd' context. This is done in `demandRoot` (which we also use for exported
+top-level ids). Do the same for Ids free in the RHS of any RULES for f.
 
-PS: You may wonder how it can be that f's optimised RHS has somehow
-discarded 'g', but when f is inlined we /don't/ discard g in the same
-way. I think a simple example is
-   g = (a,b)
-   f = \x.  fst g
-   {-# INLINE f #-}
+Wrinkles:
 
-Now f's optimised RHS will be \x.a, but if we change g to (error "..")
-(since it is apparently Absent) and then inline (\x. fst g) we get
-disaster.  But regardless, #18638 was a more complicated version of
-this, that actually happened in practice.
+  (W1) You may wonder how it can be that f's optimised RHS has somehow
+    discarded 'g', but when f is inlined we /don't/ discard g in the same
+    way. I think a simple example is
+       g = (a,b)
+       f = \x.  fst g
+       {-# INLINE f #-}
+
+    Now f's optimised RHS will be \x.a, but if we change g to (error "..")
+    (since it is apparently Absent) and then inline (\x. fst g) we get
+    disaster.  But regardless, #18638 was a more complicated version of
+    this, that actually happened in practice.
+
+  (W2) You might wonder why we don't simply take the free vars of the
+    unfolding/RULE and map them to topDmd. The reason is that any of the free vars
+    might have demand signatures themselves that in turn demand transitive free
+    variables and that we hence need to unleash! This came up in #23208.
+    Consider
+
+       err :: Int -> b
+       err = error "really important message"
+
+       sg :: Int -> Int
+       sg _ = case err of {}  -- Str=<1B>b {err:->S}
+
+       g :: a -> a  -- g is exported
+       g x = x
+       {-# RULES "g" g @Int = sg #-}
+
+    Here, `err` is only demanded by `sg`'s demand signature: It doesn't occur
+    in the weak_fvs of `sg`'s RHS at all. Hence when we `demandRoots` `sg`
+    because it occurs in the RULEs of `g` (which is exported), we better unleash
+    the demand signature of `sg`, too! Before #23208 we simply added a 'topDmd'
+    for `sg`, failing to unleash the signature and hence observed an absent
+    error instead of the `really important message`.
 
 Note [DmdAnal for DataCon wrappers]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2101,8 +2140,7 @@ dmdFix :: TopLevelFlag
        -> AnalEnv                            -- Does not include bindings for this binding
        -> SubDemand
        -> [(Id,CoreExpr)]
-       -> (AnalEnv, DmdEnv, [(Id,CoreExpr)]) -- Binders annotated with strictness info
-
+       -> (AnalEnv, WeakDmds, [(Id,CoreExpr)]) -- Binders annotated with strictness info
 dmdFix top_lvl env let_dmd orig_pairs
   = loop 1 initial_pairs
   where
@@ -2113,33 +2151,33 @@ dmdFix top_lvl env let_dmd orig_pairs
 
     -- If fixed-point iteration does not yield a result we use this instead
     -- See Note [Safe abortion in the fixed-point iteration]
-    abort :: (AnalEnv, DmdEnv, [(Id,CoreExpr)])
-    abort = (env, lazy_fv', zapped_pairs)
-      where (lazy_fv, pairs') = step True (zapIdDmdSig orig_pairs)
+    abort :: (AnalEnv, WeakDmds, [(Id,CoreExpr)])
+    abort = (env, weak_fv', zapped_pairs)
+      where (weak_fv, pairs') = step True (zapIdDmdSig orig_pairs)
             -- Note [Lazy and unleashable free variables]
-            non_lazy_fvs = plusVarEnvList $ map (dmdSigDmdEnv . idDmdSig . fst) pairs'
-            lazy_fv'     = lazy_fv `plusVarEnv` mapVarEnv (const topDmd) non_lazy_fvs
+            weak_fvs = plusVarEnvList $ map (de_fvs . dmdSigDmdEnv . idDmdSig . fst) pairs'
+            weak_fv'     = plusVarEnv_C plusDmd weak_fv $ mapVarEnv (const topDmd) weak_fvs
             zapped_pairs = zapIdDmdSig pairs'
 
     -- The fixed-point varies the idDmdSig field of the binders, and terminates if that
     -- annotation does not change any more.
-    loop :: Int -> [(Id,CoreExpr)] -> (AnalEnv, DmdEnv, [(Id,CoreExpr)])
+    loop :: Int -> [(Id,CoreExpr)] -> (AnalEnv, WeakDmds, [(Id,CoreExpr)])
     loop n pairs = -- pprTrace "dmdFix" (ppr n <+> vcat [ ppr id <+> ppr (idDmdSig id)
                    --                                   | (id,_) <- pairs]) $
                    loop' n pairs
 
     loop' n pairs
-      | found_fixpoint = (final_anal_env, lazy_fv, pairs')
+      | found_fixpoint = (final_anal_env, weak_fv, pairs')
       | n == 10        = abort
       | otherwise      = loop (n+1) pairs'
       where
         found_fixpoint    = map (idDmdSig . fst) pairs' == map (idDmdSig . fst) pairs
         first_round       = n == 1
-        (lazy_fv, pairs') = step first_round pairs
+        (weak_fv, pairs') = step first_round pairs
         final_anal_env    = extendAnalEnvs top_lvl env (map fst pairs')
 
-    step :: Bool -> [(Id, CoreExpr)] -> (DmdEnv, [(Id, CoreExpr)])
-    step first_round pairs = (lazy_fv, pairs')
+    step :: Bool -> [(Id, CoreExpr)] -> (WeakDmds, [(Id, CoreExpr)])
+    step first_round pairs = (weak_fv, pairs')
       where
         -- In all but the first iteration, delete the virgin flag
         start_env | first_round = env
@@ -2147,17 +2185,17 @@ dmdFix top_lvl env let_dmd orig_pairs
 
         start = (extendAnalEnvs top_lvl start_env (map fst pairs), emptyVarEnv)
 
-        !((_,!lazy_fv), !pairs') = mapAccumL my_downRhs start pairs
+        !((_,!weak_fv), !pairs') = mapAccumL my_downRhs start pairs
                 -- mapAccumL: Use the new signature to do the next pair
                 -- The occurrence analyser has arranged them in a good order
                 -- so this can significantly reduce the number of iterations needed
 
-        my_downRhs (env, lazy_fv) (id,rhs)
+        my_downRhs (env, weak_fv) (id,rhs)
           = -- pprTrace "my_downRhs" (ppr id $$ ppr (idDmdSig id) $$ ppr sig) $
-            ((env', lazy_fv'), (id', rhs'))
+            ((env', weak_fv'), (id', rhs'))
           where
-            !(!env', !lazy_fv1, !id', !rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs
-            !lazy_fv'                    = plusVarEnv_C plusDmd lazy_fv lazy_fv1
+            !(!env', !weak_fv1, !id', !rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs
+            !weak_fv'                    = plusVarEnv_C plusDmd weak_fv weak_fv1
 
     zapIdDmdSig :: [(Id, CoreExpr)] -> [(Id, CoreExpr)]
     zapIdDmdSig pairs = [(setIdDmdSig id nopSig, rhs) | (id, rhs) <- pairs ]
@@ -2231,23 +2269,24 @@ convenient to do it there.
 *                                                                      *
 ********************************************************************* -}
 
-unitDmdType :: DmdEnv -> DmdType
-unitDmdType dmd_env = DmdType dmd_env [] topDiv
+noArgsDmdType :: DmdEnv -> DmdType
+noArgsDmdType dmd_env = DmdType dmd_env []
 
 coercionDmdEnv :: Coercion -> DmdEnv
 coercionDmdEnv co = coercionsDmdEnv [co]
 
 coercionsDmdEnv :: [Coercion] -> DmdEnv
-coercionsDmdEnv cos = mapVarEnv (const topDmd) (getUniqSet $ coVarsOfCos cos)
-                      -- The VarSet from coVarsOfCos is really a VarEnv Var
+coercionsDmdEnv cos
+  = mkTermDmdEnv $ mapVarEnv (const topDmd) $ getUniqSet $ coVarsOfCos cos
+  -- The VarSet from coVarsOfCos is really a VarEnv Var
 
 addVarDmd :: DmdType -> Var -> Demand -> DmdType
-addVarDmd (DmdType fv ds res) var dmd
-  = DmdType (extendVarEnv_C plusDmd fv var dmd) ds res
+addVarDmd (DmdType fv ds) var dmd
+  = DmdType (addVarDmdEnv fv var dmd) ds
 
-addLazyFVs :: DmdType -> DmdEnv -> DmdType
-addLazyFVs dmd_ty lazy_fvs
-  = dmd_ty `plusDmdType` mkPlusDmdArg lazy_fvs
+addWeakFVs :: DmdType -> WeakDmds -> DmdType
+addWeakFVs dmd_ty weak_fvs
+  = dmd_ty `plusDmdType` mkTermDmdEnv weak_fvs
         -- Using plusDmdType (rather than just plus'ing the envs)
         -- is vital.  Consider
         --      let f = \x -> (x,y)
@@ -2256,7 +2295,7 @@ addLazyFVs dmd_ty lazy_fvs
         -- demand with the bottom coming up from 'error'
         --
         -- I got a loop in the fixpointer without this, due to an interaction
-        -- with the lazy_fv filtering in dmdAnalRhsSig.  Roughly, it was
+        -- with the weak_fv filtering in dmdAnalRhsSig.  Roughly, it was
         --      letrec f n x
         --          = letrec g y = x `fatbar`
         --                         letrec h z = z + ...g...
@@ -2357,14 +2396,14 @@ DmdType.
 
 But now the signature lies! (Missing variables are assumed to be absent.) To
 make up for this, the code that analyses the binding keeps the demand on those
-variable separate (usually called "lazy_fv") and adds it to the demand of the
+variable separate (usually called "weak_fv") and adds it to the demand of the
 whole binding later.
 
 What if we decide _not_ to store a strictness signature for a binding at all, as
 we do when aborting a fixed-point iteration? The we risk losing the information
 that the strict variables are being used. In that case, we take all free variables
 mentioned in the (unsound) strictness signature, conservatively approximate the
-demand put on them (topDmd), and add that to the "lazy_fv" returned by "dmdFix".
+demand put on them (topDmd), and add that to the "weak_fv" returned by "dmdFix".
 
 
 ************************************************************************
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs
index 81c2816334..6b01d1fb50 100644
--- a/compiler/GHC/Core/Opt/SpecConstr.hs
+++ b/compiler/GHC/Core/Opt/SpecConstr.hs
@@ -2096,15 +2096,16 @@ calcSpecInfo :: Id           -- The original function
 calcSpecInfo fn arg_bndrs (CP { cp_qvars = qvars, cp_args = pats }) extra_bndrs
   = ( spec_lam_bndrs_w_dmds
     , spec_call_args
-    , mkClosedDmdSig [idDemandInfo b | b <- spec_lam_bndrs_w_dmds, isId b] div )
+    , zapDmdEnvSig (DmdSig (dt{dt_args = spec_fn_dmds})) )
   where
-    DmdSig (DmdType _ fn_dmds div) = idDmdSig fn
+    DmdSig dt@DmdType{dt_args=fn_dmds} = idDmdSig fn
+    spec_fn_dmds = [idDemandInfo b | b <- spec_lam_bndrs_w_dmds, isId b]
 
     val_pats   = filterOut isTypeArg pats
                  -- Value args at call sites, used to determine how many demands to drop
-                 -- from the original functions demand and for setting up dmd_env.
-    dmd_env    = go emptyVarEnv fn_dmds val_pats
-    qvar_dmds  = [ lookupVarEnv dmd_env qv `orElse` topDmd | qv <- qvars, isId qv ]
+                 -- from the original functions demand and for setting up arg_dmd_env.
+    arg_dmd_env = go emptyVarEnv fn_dmds val_pats
+    qvar_dmds  = [ lookupVarEnv arg_dmd_env qv `orElse` topDmd | qv <- qvars, isId qv ]
     extra_dmds = dropList val_pats fn_dmds
 
     -- Annotate the variables with the strictness information from
@@ -2128,12 +2129,12 @@ calcSpecInfo fn arg_bndrs (CP { cp_qvars = qvars, cp_args = pats }) extra_bndrs
     set_dmds (v:vs) ds@(d:ds') | isTyVar v = v                   : set_dmds vs ds
                                | otherwise = setIdDemandInfo v d : set_dmds vs ds'
 
-    go :: DmdEnv -> [Demand] -> [CoreExpr] -> DmdEnv
+    go :: VarEnv Demand -> [Demand] -> [CoreExpr] -> VarEnv Demand
     -- We've filtered out all the type patterns already
     go env (d:ds) (pat : pats)     = go (go_one env d pat) ds pats
     go env _      _                = env
 
-    go_one :: DmdEnv -> Demand -> CoreExpr -> DmdEnv
+    go_one :: VarEnv Demand -> Demand -> CoreExpr -> VarEnv Demand
     go_one env d          (Var v) = extendVarEnv_C plusDmd env v d
     go_one env (_n :* cd) e -- NB: _n does not have to be strict
       | (Var _, args) <- collectArgs e
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index c0b72cefed..d4f1fc52b3 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -1111,7 +1111,7 @@ cpeApp top_env expr
         where
           depth = val_args args
           stricts = case idDmdSig v of
-                            DmdSig (DmdType _ demands _)
+                            DmdSig (DmdType _ demands)
                               | listLengthCmp demands depth /= GT -> demands
                                     -- length demands <= depth
                               | otherwise                         -> []
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs
index 09b08b7f36..b7f578ab4d 100644
--- a/compiler/GHC/Types/Demand.hs
+++ b/compiler/GHC/Types/Demand.hs
@@ -43,23 +43,20 @@ module GHC.Types.Demand (
     -- ** Manipulating Boxity of a Demand
     unboxDeeplyDmd,
 
-    -- * Demand environments
-    DmdEnv, emptyDmdEnv,
-    keepAliveDmdEnv, reuseEnv,
-
     -- * Divergence
     Divergence(..), topDiv, botDiv, exnDiv, lubDivergence, isDeadEndDiv,
 
+    -- * Demand environments
+    DmdEnv(..), addVarDmdEnv, mkTermDmdEnv, nopDmdEnv, plusDmdEnv, plusDmdEnvs,
+    reuseEnv,
+
     -- * Demand types
     DmdType(..), dmdTypeDepth,
     -- ** Algebra
     nopDmdType, botDmdType,
-    lubDmdType, plusDmdType, multDmdType,
-    -- *** PlusDmdArg
-    PlusDmdArg, mkPlusDmdArg, toPlusDmdArg,
+    lubDmdType, plusDmdType, multDmdType, discardArgDmds,
     -- ** Other operations
     peelFV, findIdDemand, addDemand, splitDmdTy, deferAfterPreciseException,
-    keepAliveDmdType,
 
     -- * Demand signatures
     DmdSig(..), mkDmdSigForArity, mkClosedDmdSig, mkVanillaDmdSig,
@@ -85,9 +82,8 @@ module GHC.Types.Demand (
 
 import GHC.Prelude
 
-import GHC.Types.Var ( Var, Id )
+import GHC.Types.Var
 import GHC.Types.Var.Env
-import GHC.Types.Var.Set
 import GHC.Types.Unique.FM
 import GHC.Types.Basic
 import GHC.Data.Maybe   ( orElse )
@@ -1054,7 +1050,7 @@ mkWorkerDemand n = C_01 :* go n
 
 argsOneShots :: DmdSig -> Arity -> [[OneShotInfo]]
 -- ^ See Note [Computing one-shot info]
-argsOneShots (DmdSig (DmdType _ arg_ds _)) n_val_args
+argsOneShots (DmdSig (DmdType _ arg_ds)) n_val_args
   | unsaturated_call = []
   | otherwise = go arg_ds
   where
@@ -1466,7 +1462,7 @@ lubDivergence _        _        = Dunno
 -- defaultFvDmd (r1 `lubDivergence` r2) = defaultFvDmd r1 `lubDmd` defaultFvDmd r2
 -- (See Note [Default demand on free variables and arguments] for why)
 
--- | See Note [Asymmetry of 'plus*'], which concludes that 'plusDivergence'
+-- | See Note [Asymmetry of plusDmdType], which concludes that 'plusDivergence'
 -- needs to be symmetric.
 -- Strictly speaking, we should have @plusDivergence Dunno Diverges = ExnOrDiv@.
 -- But that regresses in too many places (every infinite loop, basically) to be
@@ -1737,112 +1733,131 @@ a consequence of fixed-point iteration, it's not important that they agree.
 -}
 
 -- Subject to Note [Default demand on free variables and arguments]
-type DmdEnv = VarEnv Demand
+-- | Captures the result of an evaluation of an expression, by
+--
+--   * Listing how the free variables of that expression have been evaluted
+--     ('de_fvs')
+--   * Saying whether or not evaluation would surely diverge ('de_div')
+--
+-- See Note [Demand env Equality].
+data DmdEnv = DE { de_fvs :: !(VarEnv Demand), de_div :: !Divergence }
+
+instance Eq DmdEnv where
+  DE fv1 div1 == DE fv2 div2
+    = div1 == div2 && canonicalise div1 fv1 == canonicalise div2 fv2
+    where
+      canonicalise div fv = filterUFM (/= defaultFvDmd div) fv
+
+mkEmptyDmdEnv :: Divergence -> DmdEnv
+mkEmptyDmdEnv div = DE emptyVarEnv div
+
+-- | Build a potentially terminating 'DmdEnv' from a finite map that says what
+-- has been evaluated so far
+mkTermDmdEnv :: VarEnv Demand -> DmdEnv
+mkTermDmdEnv fvs = DE fvs topDiv
+
+nopDmdEnv :: DmdEnv
+nopDmdEnv = mkEmptyDmdEnv topDiv
 
-emptyDmdEnv :: DmdEnv
-emptyDmdEnv = emptyVarEnv
+botDmdEnv :: DmdEnv
+botDmdEnv = mkEmptyDmdEnv botDiv
+
+exnDmdEnv :: DmdEnv
+exnDmdEnv = mkEmptyDmdEnv exnDiv
+
+lubDmdEnv :: DmdEnv -> DmdEnv -> DmdEnv
+lubDmdEnv (DE fv1 d1) (DE fv2 d2) = DE lub_fv lub_div
+  where
+    -- See Note [Demand env Equality]
+    lub_fv  = plusVarEnv_CD lubDmd fv1 (defaultFvDmd d1) fv2 (defaultFvDmd d2)
+    lub_div = lubDivergence d1 d2
+
+addVarDmdEnv :: DmdEnv -> Id -> Demand -> DmdEnv
+addVarDmdEnv env@(DE fvs div) id dmd
+  = DE (extendVarEnv fvs id (dmd `plusDmd` lookupDmdEnv env id)) div
+
+plusDmdEnv :: DmdEnv -> DmdEnv -> DmdEnv
+plusDmdEnv (DE fv1 d1) (DE fv2 d2)
+  -- In contrast to Note [Asymmetry of plusDmdType], this function is symmetric.
+  | isEmptyVarEnv fv2, defaultFvDmd d2 == absDmd
+  = DE fv1 (d1 `plusDivergence` d2) -- a very common case that is much more efficient
+  | isEmptyVarEnv fv1, defaultFvDmd d1 == absDmd
+  = DE fv2 (d1 `plusDivergence` d2) -- another very common case that is much more efficient
+  | otherwise
+  = DE (plusVarEnv_CD plusDmd fv1 (defaultFvDmd d1) fv2 (defaultFvDmd d2))
+       (d1 `plusDivergence` d2)
+
+-- | 'DmdEnv' is a monoid via 'plusDmdEnv' and 'nopDmdEnv'; this is its 'msum'
+plusDmdEnvs :: [DmdEnv] -> DmdEnv
+plusDmdEnvs []   = nopDmdEnv
+plusDmdEnvs pdas = foldl1' plusDmdEnv pdas
 
 multDmdEnv :: Card -> DmdEnv -> DmdEnv
-multDmdEnv C_11 env = env
-multDmdEnv C_00 _   = emptyDmdEnv
-multDmdEnv n    env = mapVarEnv (multDmd n) env
+multDmdEnv C_11 env          = env
+multDmdEnv C_00 _            = nopDmdEnv
+multDmdEnv n    (DE fvs div) = DE (mapVarEnv (multDmd n) fvs) (multDivergence n div)
 
 reuseEnv :: DmdEnv -> DmdEnv
 reuseEnv = multDmdEnv C_1N
 
--- | @keepAliveDmdType dt vs@ makes sure that the Ids in @vs@ have
--- /some/ usage in the returned demand types -- they are not Absent.
--- See Note [Absence analysis for stable unfoldings and RULES]
---     in "GHC.Core.Opt.DmdAnal".
-keepAliveDmdEnv :: DmdEnv -> IdSet -> DmdEnv
-keepAliveDmdEnv env vs
-  = nonDetStrictFoldVarSet add env vs
-  where
-    add :: Id -> DmdEnv -> DmdEnv
-    add v env = extendVarEnv_C add_dmd env v topDmd
+lookupDmdEnv :: DmdEnv -> Id -> Demand
+-- See Note [Default demand on free variables and arguments]
+lookupDmdEnv (DE fv div) id = lookupVarEnv fv id `orElse` defaultFvDmd div
 
-    add_dmd :: Demand -> Demand -> Demand
-    -- If the existing usage is Absent, make it used
-    -- Otherwise leave it alone
-    add_dmd dmd _ | isAbsDmd dmd = topDmd
-                  | otherwise    = dmd
+delDmdEnv :: DmdEnv -> Id -> DmdEnv
+delDmdEnv (DE fv div) id = DE (fv `delVarEnv` id) div
 
 -- | Characterises how an expression
 --
---    * Evaluates its free variables ('dt_env')
+--    * Evaluates its free variables ('dt_env') including divergence info
 --    * Evaluates its arguments ('dt_args')
---    * Diverges on every code path or not ('dt_div')
 --
--- Equality is defined modulo 'defaultFvDmd's in 'dt_env'.
--- See Note [Demand type Equality].
 data DmdType
   = DmdType
-  { dt_env  :: !DmdEnv     -- ^ Demand on explicitly-mentioned free variables
+  { dt_env  :: !DmdEnv     -- ^ Demands on free variables.
+                           -- See Note [Demand type Divergence]
   , dt_args :: ![Demand]   -- ^ Demand on arguments
-  , dt_div  :: !Divergence -- ^ Whether evaluation diverges.
-                          -- See Note [Demand type Divergence]
   }
 
--- | See Note [Demand type Equality].
+-- | See Note [Demand env Equality].
 instance Eq DmdType where
-  (==) (DmdType fv1 ds1 div1)
-       (DmdType fv2 ds2 div2) =  div1 == div2 && ds1 == ds2 -- cheap checks first
-                              && canonicalise div1 fv1 == canonicalise div2 fv2
-       where
-         canonicalise div fv = filterUFM (/= defaultFvDmd div) fv
+  DmdType env1 ds1 == DmdType env2 ds2
+    = ds1 == ds2 -- cheap checks first
+      && env1 == env2
 
 -- | Compute the least upper bound of two 'DmdType's elicited /by the same
 -- incoming demand/!
 lubDmdType :: DmdType -> DmdType -> DmdType
-lubDmdType d1 d2
-  = DmdType lub_fv lub_ds lub_div
+lubDmdType d1 d2 = DmdType lub_fv lub_ds
   where
     n = max (dmdTypeDepth d1) (dmdTypeDepth d2)
-    (DmdType fv1 ds1 r1) = etaExpandDmdType n d1
-    (DmdType fv2 ds2 r2) = etaExpandDmdType n d2
-
-    -- See Note [Demand type Equality]
-    lub_fv  = plusVarEnv_CD lubDmd fv1 (defaultFvDmd r1) fv2 (defaultFvDmd r2)
+    (DmdType fv1 ds1) = etaExpandDmdType n d1
+    (DmdType fv2 ds2) = etaExpandDmdType n d2
     lub_ds  = zipWithEqual "lubDmdType" lubDmd ds1 ds2
-    lub_div = lubDivergence r1 r2
-
-type PlusDmdArg = (DmdEnv, Divergence)
+    lub_fv = lubDmdEnv fv1 fv2
 
-mkPlusDmdArg :: DmdEnv -> PlusDmdArg
-mkPlusDmdArg env = (env, topDiv)
+discardArgDmds :: DmdType -> DmdEnv
+discardArgDmds (DmdType fv _) = fv
 
-toPlusDmdArg :: DmdType -> PlusDmdArg
-toPlusDmdArg (DmdType fv _ r) = (fv, r)
-
-plusDmdType :: DmdType -> PlusDmdArg -> DmdType
-plusDmdType (DmdType fv1 ds1 r1) (fv2, t2)
-    -- See Note [Asymmetry of 'plus*']
-    -- 'plus' takes the argument/result info from its *first* arg,
-    -- using its second arg just for its free-var info.
-  | isEmptyVarEnv fv2, defaultFvDmd t2 == absDmd
-  = DmdType fv1 ds1 (r1 `plusDivergence` t2) -- a very common case that is much more efficient
-  | otherwise
-  = DmdType (plusVarEnv_CD plusDmd fv1 (defaultFvDmd r1) fv2 (defaultFvDmd t2))
-            ds1
-            (r1 `plusDivergence` t2)
+plusDmdType :: DmdType -> DmdEnv -> DmdType
+plusDmdType (DmdType fv ds) fv'
+  -- See Note [Asymmetry of plusDmdType]
+  -- 'DmdEnv' forms a (monoidal) action on 'DmdType' via this operation.
+  = DmdType (plusDmdEnv fv fv') ds
 
 botDmdType :: DmdType
-botDmdType = DmdType emptyDmdEnv [] botDiv
+botDmdType = DmdType botDmdEnv []
 
 -- | The demand type of doing nothing (lazy, absent, no Divergence
 -- information). Note that it is ''not'' the top of the lattice (which would be
 -- "may use everything"), so it is (no longer) called topDmdType.
 nopDmdType :: DmdType
-nopDmdType = DmdType emptyDmdEnv [] topDiv
-
-isNopDmdType :: DmdType -> Bool
-isNopDmdType (DmdType env args div)
-  = div == topDiv && null args && isEmptyVarEnv env
+nopDmdType = DmdType nopDmdEnv []
 
 -- | The demand type of an unspecified expression that is guaranteed to
 -- throw a (precise or imprecise) exception or diverge.
 exnDmdType :: DmdType
-exnDmdType = DmdType emptyDmdEnv [] exnDiv
+exnDmdType = DmdType exnDmdEnv []
 
 dmdTypeDepth :: DmdType -> Arity
 dmdTypeDepth = length . dt_args
@@ -1851,7 +1866,7 @@ dmdTypeDepth = length . dt_args
 -- expansion, where n must not be lower than the demand types depth.
 -- It appends the argument list with the correct 'defaultArgDmd'.
 etaExpandDmdType :: Arity -> DmdType -> DmdType
-etaExpandDmdType n d@DmdType{dt_args = ds, dt_div = div}
+etaExpandDmdType n d@DmdType{dt_args = ds, dt_env = env}
   | n == depth = d
   | n >  depth = d{dt_args = inc_ds}
   | otherwise  = pprPanic "etaExpandDmdType: arity decrease" (ppr n $$ ppr d)
@@ -1863,7 +1878,7 @@ etaExpandDmdType n d@DmdType{dt_args = ds, dt_div = div}
         --  * Divergence is still valid:
         --    - A dead end after 2 arguments stays a dead end after 3 arguments
         --    - The remaining case is Dunno, which is already topDiv
-        inc_ds = take n (ds ++ repeat (defaultArgDmd div))
+        inc_ds = take n (ds ++ repeat (defaultArgDmd (de_div env)))
 
 -- | A conservative approximation for a given 'DmdType' in case of an arity
 -- decrease. Currently, it's just nopDmdType.
@@ -1875,30 +1890,27 @@ splitDmdTy :: DmdType -> (Demand, DmdType)
 -- We already have a suitable demand on all
 -- free vars, so no need to add more!
 splitDmdTy ty@DmdType{dt_args=dmd:args} = (dmd, ty{dt_args=args})
-splitDmdTy ty@DmdType{dt_div=div}       = (defaultArgDmd div, ty)
+splitDmdTy ty@DmdType{dt_env=env}       = (defaultArgDmd (de_div env), ty)
 
 multDmdType :: Card -> DmdType -> DmdType
-multDmdType n (DmdType fv args res_ty)
+multDmdType n (DmdType fv args)
   = -- pprTrace "multDmdType" (ppr n $$ ppr fv $$ ppr (multDmdEnv n fv)) $
     DmdType (multDmdEnv n fv)
             (map (multDmd n) args)
-            (multDivergence n res_ty)
 
 peelFV :: DmdType -> Var -> (DmdType, Demand)
-peelFV (DmdType fv ds res) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)
-                               (DmdType fv' ds res, dmd)
+peelFV (DmdType fv ds) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)
+                            (DmdType fv' ds, dmd)
   where
   -- Force these arguments so that old `Env` is not retained.
-  !fv' = fv `delVarEnv` id
-  -- See Note [Default demand on free variables and arguments]
-  !dmd  = lookupVarEnv fv id `orElse` defaultFvDmd res
+  !fv' = fv `delDmdEnv` id
+  !dmd = lookupDmdEnv fv id
 
 addDemand :: Demand -> DmdType -> DmdType
-addDemand dmd (DmdType fv ds res) = DmdType fv (dmd:ds) res
+addDemand dmd (DmdType fv ds) = DmdType fv (dmd:ds)
 
 findIdDemand :: DmdType -> Var -> Demand
-findIdDemand (DmdType fv _ res) id
-  = lookupVarEnv fv id `orElse` defaultFvDmd res
+findIdDemand (DmdType fv _) id = lookupDmdEnv fv id
 
 -- | When e is evaluated after executing an IO action that may throw a precise
 -- exception, we act as if there is an additional control flow path that is
@@ -1914,11 +1926,6 @@ findIdDemand (DmdType fv _ res) id
 deferAfterPreciseException :: DmdType -> DmdType
 deferAfterPreciseException = lubDmdType exnDmdType
 
--- | See 'keepAliveDmdEnv'.
-keepAliveDmdType :: DmdType -> VarSet -> DmdType
-keepAliveDmdType (DmdType fvs ds res) vars =
-  DmdType (fvs `keepAliveDmdEnv` vars) ds res
-
 {- Note [deferAfterPreciseException]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The big picture is in Note [Precise exceptions and strictness analysis]
@@ -1974,32 +1981,25 @@ on err via the App rule. In contrast to weaker head strictness, this demand is
 strong enough to unleash err's signature and hence we see that the whole
 expression diverges!
 
-Note [Demand type Equality]
+Note [Demand env Equality]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-What is the difference between the DmdType <L>{x->A} and <L>?
+What is the difference between the Demand env {x->A} and {}?
 Answer: There is none! They have the exact same semantics, because any var that
-is not mentioned in 'dt_env' implicitly has demand 'defaultFvDmd', based on
-the divergence of the demand type 'dt_div'.
-Similarly, <B>b{x->B, y->A} is the same as <B>b{y->A}, because the default FV
-demand of BotDiv is B. But neither is equal to <B>b, because y has demand B in
+is not mentioned in 'de_fvs' implicitly has demand 'defaultFvDmd', based on
+the divergence of the demand env 'de_div'.
+Similarly, b{x->B, y->A} is the same as b{y->A}, because the default FV
+demand of BotDiv is B. But neither is equal to b{}, because y has demand B in
 the latter, not A as before.
 
-NB: 'dt_env' technically can't stand for its own, because it doesn't tell us the
-demand on FVs that don't appear in the DmdEnv. Hence 'PlusDmdArg' carries along
-a 'Divergence', for example.
-
-The Eq instance of DmdType must reflect that, otherwise we can get into monotonicity
-issues during fixed-point iteration (<L>{x->A} /= <L> /= <L>{x->A} /= ...).
-It does so by filtering out any default FV demands prior to comparing 'dt_env'.
-An alternative would be to maintain an invariant that there are no default FV demands
-in 'dt_env' to begin with, but that seems more involved to maintain in the current
-implementation.
+The Eq instance of DmdEnv must reflect that, otherwise we can get into monotonicity
+issues during fixed-point iteration ({x->A} /= {} /= {x->A} /= ...).
+It does so by filtering out any default FV demands prior to comparing 'de_fvs'.
 
-Note that 'lubDmdType' maintains this kind of equality by using 'plusVarEnv_CD',
-involving 'defaultFvDmd' for any entries present in one 'dt_env' but not the
+Note that 'lubDmdEnv' maintains this kind of equality by using 'plusVarEnv_CD',
+involving 'defaultFvDmd' for any entries present in one 'de_fvs' but not the
 other.
 
-Note [Asymmetry of 'plus*']
+Note [Asymmetry of plusDmdType]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 'plus' for DmdTypes is *asymmetrical*, because there can only one
 be one type contributing argument demands!  For example, given (e1 e2), we get
@@ -2155,24 +2155,24 @@ newtype DmdSig
 -- | Turns a 'DmdType' computed for the particular 'Arity' into a 'DmdSig'
 -- unleashable at that arity. See Note [Understanding DmdType and DmdSig].
 mkDmdSigForArity :: Arity -> DmdType -> DmdSig
-mkDmdSigForArity arity dmd_ty@(DmdType fvs args div)
-  | arity < dmdTypeDepth dmd_ty = DmdSig $ DmdType fvs (take arity args) div
+mkDmdSigForArity arity dmd_ty@(DmdType fvs args)
+  | arity < dmdTypeDepth dmd_ty = DmdSig $ DmdType fvs (take arity args)
   | otherwise                   = DmdSig (etaExpandDmdType arity dmd_ty)
 
 mkClosedDmdSig :: [Demand] -> Divergence -> DmdSig
-mkClosedDmdSig ds res = mkDmdSigForArity (length ds) (DmdType emptyDmdEnv ds res)
+mkClosedDmdSig ds div = mkDmdSigForArity (length ds) (DmdType (mkEmptyDmdEnv div) ds)
 
 mkVanillaDmdSig :: Arity -> Divergence -> DmdSig
 mkVanillaDmdSig ar div = mkClosedDmdSig (replicate ar topDmd) div
 
 splitDmdSig :: DmdSig -> ([Demand], Divergence)
-splitDmdSig (DmdSig (DmdType _ dmds res)) = (dmds, res)
+splitDmdSig (DmdSig (DmdType env dmds)) = (dmds, de_div env)
 
 dmdSigDmdEnv :: DmdSig -> DmdEnv
-dmdSigDmdEnv (DmdSig (DmdType env _ _)) = env
+dmdSigDmdEnv (DmdSig (DmdType env _)) = env
 
 hasDemandEnvSig :: DmdSig -> Bool
-hasDemandEnvSig = not . isEmptyVarEnv . dmdSigDmdEnv
+hasDemandEnvSig = not . isEmptyVarEnv . de_fvs . dmdSigDmdEnv
 
 botSig :: DmdSig
 botSig = DmdSig botDmdType
@@ -2181,23 +2181,23 @@ nopSig :: DmdSig
 nopSig = DmdSig nopDmdType
 
 isNopSig :: DmdSig -> Bool
-isNopSig (DmdSig ty) = isNopDmdType ty
+isNopSig (DmdSig ty) = ty == nopDmdType
 
 -- | True if the signature diverges or throws an exception in a saturated call.
 -- See Note [Dead ends].
 isDeadEndSig :: DmdSig -> Bool
-isDeadEndSig (DmdSig (DmdType _ _ res)) = isDeadEndDiv res
+isDeadEndSig (DmdSig (DmdType env _)) = isDeadEndDiv (de_div env)
 
 -- | True if the signature diverges or throws an imprecise exception in a saturated call.
 -- NB: In constrast to 'isDeadEndSig' this returns False for 'exnDiv'.
 -- See Note [Dead ends]
 -- and Note [Precise vs imprecise exceptions].
 isBottomingSig :: DmdSig -> Bool
-isBottomingSig (DmdSig (DmdType _ _ res)) = res == botDiv
+isBottomingSig (DmdSig (DmdType env _)) = de_div env == botDiv
 
 -- | True when the signature indicates all arguments are boxed
 onlyBoxedArguments :: DmdSig -> Bool
-onlyBoxedArguments (DmdSig (DmdType _ dmds _)) = all demandIsBoxed dmds
+onlyBoxedArguments (DmdSig (DmdType _ dmds)) = all demandIsBoxed dmds
  where
    demandIsBoxed BotDmd    = True
    demandIsBoxed AbsDmd    = True
@@ -2217,12 +2217,15 @@ onlyBoxedArguments (DmdSig (DmdType _ dmds _)) = all demandIsBoxed dmds
 -- Hence this function conservatively returns False in that case.
 -- See Note [Dead ends].
 isDeadEndAppSig :: DmdSig -> Int -> Bool
-isDeadEndAppSig (DmdSig (DmdType _ ds res)) n
-  = isDeadEndDiv res && not (lengthExceeds ds n)
+isDeadEndAppSig (DmdSig (DmdType env ds)) n
+  = isDeadEndDiv (de_div env) && not (lengthExceeds ds n)
+
+trimBoxityDmdEnv :: DmdEnv -> DmdEnv
+trimBoxityDmdEnv (DE fvs div) = DE (mapVarEnv trimBoxity fvs) div
 
 trimBoxityDmdType :: DmdType -> DmdType
-trimBoxityDmdType (DmdType fvs ds res) =
-  DmdType (mapVarEnv trimBoxity fvs) (map trimBoxity ds) res
+trimBoxityDmdType (DmdType env ds) =
+  DmdType (trimBoxityDmdEnv env) (map trimBoxity ds)
 
 trimBoxityDmdSig :: DmdSig -> DmdSig
 trimBoxityDmdSig = coerce trimBoxityDmdType
@@ -2247,12 +2250,11 @@ transferBoxity from to = go_dmd from to
           _ -> trimBoxity to_dmd
 
 transferArgBoxityDmdType :: DmdType -> DmdType -> DmdType
-transferArgBoxityDmdType _from@(DmdType _ from_ds _) to@(DmdType to_fvs to_ds to_res)
+transferArgBoxityDmdType _from@(DmdType _ from_ds) to@(DmdType to_env to_ds)
   | equalLength from_ds to_ds
   = -- pprTraceWith "transfer" (\r -> ppr _from $$ ppr to $$ ppr r) $
-    DmdType to_fvs -- Only arg boxity! See Note [Don't change boxity without worker/wrapper]
+    DmdType to_env -- Only arg boxity! See Note [Don't change boxity without worker/wrapper]
             (zipWith transferBoxity from_ds to_ds)
-            to_res
   | otherwise
   = trimBoxityDmdType to
 
@@ -2263,10 +2265,10 @@ prependArgsDmdSig :: Int -> DmdSig -> DmdSig
 -- ^ Add extra ('topDmd') arguments to a strictness signature.
 -- In contrast to 'etaConvertDmdSig', this /prepends/ additional argument
 -- demands. This is used by FloatOut.
-prependArgsDmdSig new_args sig@(DmdSig dmd_ty@(DmdType env dmds res))
-  | new_args == 0       = sig
-  | isNopDmdType dmd_ty = sig
-  | otherwise           = DmdSig (DmdType env dmds' res)
+prependArgsDmdSig new_args sig@(DmdSig dmd_ty@(DmdType env dmds))
+  | new_args == 0        = sig
+  | dmd_ty == nopDmdType = sig
+  | otherwise            = DmdSig (DmdType env dmds')
   where
     dmds' = assertPpr (new_args > 0) (ppr new_args) $
             replicate new_args topDmd ++ dmds
@@ -2308,7 +2310,7 @@ type DmdTransformer = SubDemand -> DmdType
 -- Given a function's 'DmdSig' and a 'SubDemand' for the evaluation context,
 -- return how the function evaluates its free variables and arguments.
 dmdTransformSig :: DmdSig -> DmdTransformer
-dmdTransformSig (DmdSig dmd_ty@(DmdType _ arg_ds _)) sd
+dmdTransformSig (DmdSig dmd_ty@(DmdType _ arg_ds)) sd
   = multDmdType (fst $ peelManyCalls (length arg_ds) sd) dmd_ty
     -- see Note [Demands from unsaturated function calls]
     -- and Note [What are demand signatures?]
@@ -2323,7 +2325,7 @@ dmdTransformDataConSig str_marks sd = case viewProd arity body_sd of
   where
     arity = length str_marks
     (n, body_sd) = peelManyCalls arity sd
-    mk_body_ty n dmds = DmdType emptyDmdEnv (zipWith (bump n) str_marks dmds) topDiv
+    mk_body_ty n dmds = DmdType nopDmdEnv (zipWith (bump n) str_marks dmds)
     bump n str dmd | isMarkedStrict str = multDmd n (plusDmd str_field_dmd dmd)
                    | otherwise          = multDmd n dmd
     str_field_dmd = C_01 :* seqSubDmd -- Why not C_11? See Note [Data-con worker strictness]
@@ -2334,11 +2336,11 @@ dmdTransformDataConSig str_marks sd = case viewProd arity body_sd of
 dmdTransformDictSelSig :: DmdSig -> DmdTransformer
 -- NB: This currently doesn't handle newtype dictionaries.
 -- It should simply apply call_sd directly to the dictionary, I suppose.
-dmdTransformDictSelSig (DmdSig (DmdType _ [_ :* prod] _)) call_sd
+dmdTransformDictSelSig (DmdSig (DmdType _ [_ :* prod])) call_sd
    | (n, sd') <- peelCallDmd call_sd
    , Prod _ sig_ds <- prod
    = multDmdType n $
-     DmdType emptyDmdEnv [C_11 :* mkProd Unboxed (map (enhance sd') sig_ds)] topDiv
+     DmdType nopDmdEnv [C_11 :* mkProd Unboxed (map (enhance sd') sig_ds)]
    | otherwise
    = nopDmdType -- See Note [Demand transformer for a dictionary selector]
   where
@@ -2460,9 +2462,12 @@ This is weird, so I'm not worried about whether this optimises brilliantly; but
 it should not fall over.
 -}
 
+zapDmdEnv :: DmdEnv -> DmdEnv
+zapDmdEnv (DE _ div) = mkEmptyDmdEnv div
+
 -- | Remove the demand environment from the signature.
 zapDmdEnvSig :: DmdSig -> DmdSig
-zapDmdEnvSig (DmdSig (DmdType _ ds r)) = mkClosedDmdSig ds r
+zapDmdEnvSig (DmdSig (DmdType env ds)) = DmdSig (DmdType (zapDmdEnv env) ds)
 
 zapUsageDemand :: Demand -> Demand
 -- Remove the usage info, but not the strictness info, from the demand
@@ -2483,8 +2488,8 @@ zapUsedOnceDemand = kill_usage $ KillFlags
 -- | Remove all `C_01 :*` info (but not `CM` sub-demands) from the strictness
 --   signature
 zapUsedOnceSig :: DmdSig -> DmdSig
-zapUsedOnceSig (DmdSig (DmdType env ds r))
-    = DmdSig (DmdType env (map zapUsedOnceDemand ds) r)
+zapUsedOnceSig (DmdSig (DmdType env ds))
+    = DmdSig (DmdType env (map zapUsedOnceDemand ds))
 
 data KillFlags = KillFlags
     { kf_abs         :: Bool
@@ -2569,11 +2574,11 @@ seqDemandList :: [Demand] -> ()
 seqDemandList = foldr (seq . seqDemand) ()
 
 seqDmdType :: DmdType -> ()
-seqDmdType (DmdType env ds res) =
-  seqDmdEnv env `seq` seqDemandList ds `seq` res `seq` ()
+seqDmdType (DmdType env ds) =
+  seqDmdEnv env `seq` seqDemandList ds `seq` ()
 
 seqDmdEnv :: DmdEnv -> ()
-seqDmdEnv env = seqEltsUFM seqDemand env
+seqDmdEnv (DE fvs _) = seqEltsUFM seqDemand fvs
 
 seqDmdSig :: DmdSig -> ()
 seqDmdSig (DmdSig ty) = seqDmdType ty
@@ -2682,17 +2687,20 @@ instance Outputable Divergence where
   ppr ExnOrDiv = char 'x' -- for e(x)ception
   ppr Dunno    = empty
 
-instance Outputable DmdType where
-  ppr (DmdType fv ds res)
-    = hsep [hcat (map (angleBrackets . ppr) ds) <> ppr res,
-            if null fv_elts then empty
-            else braces (fsep (map pp_elt fv_elts))]
+instance Outputable DmdEnv where
+  ppr (DE fvs div)
+    = ppr div <> if null fv_elts then empty
+                 else braces (fsep (map pp_elt fv_elts))
     where
       pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd
-      fv_elts = nonDetUFMToList fv
+      fv_elts = nonDetUFMToList fvs
         -- It's OK to use nonDetUFMToList here because we only do it for
         -- pretty printing
 
+instance Outputable DmdType where
+  ppr (DmdType fv ds)
+    = hcat (map (angleBrackets . ppr) ds) <> ppr fv
+
 instance Outputable DmdSig where
    ppr (DmdSig ty) = ppr ty
 
@@ -2741,15 +2749,6 @@ instance Binary SubDemand where
       2 -> Prod <$> get bh <*> get bh
       _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int))
 
-instance Binary DmdSig where
-  put_ bh (DmdSig aa) = put_ bh aa
-  get bh = DmdSig <$> get bh
-
-instance Binary DmdType where
-  -- Ignore DmdEnv when spitting out the DmdType
-  put_ bh (DmdType _ ds dr) = put_ bh ds *> put_ bh dr
-  get bh = DmdType emptyDmdEnv <$> get bh <*> get bh
-
 instance Binary Divergence where
   put_ bh Dunno    = putByte bh 0
   put_ bh ExnOrDiv = putByte bh 1
@@ -2761,3 +2760,16 @@ instance Binary Divergence where
       1 -> return ExnOrDiv
       2 -> return Diverges
       _ -> pprPanic "Binary:Divergence" (ppr (fromIntegral h :: Int))
+
+instance Binary DmdEnv where
+  -- Ignore VarEnv when spitting out the DmdType
+  put_ bh (DE _ d) = put_ bh d
+  get bh = DE emptyVarEnv <$> get bh
+
+instance Binary DmdType where
+  put_ bh (DmdType fv ds) = put_ bh fv *> put_ bh ds
+  get bh = DmdType <$> get bh <*> get bh
+
+instance Binary DmdSig where
+  put_ bh (DmdSig aa) = put_ bh aa
+  get bh = DmdSig <$> get bh
diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T
index 43ef2d495e..5d32f43b5f 100644
--- a/testsuite/tests/deSugar/should_compile/all.T
+++ b/testsuite/tests/deSugar/should_compile/all.T
@@ -110,6 +110,6 @@ test('T14815', [], makefile_test, ['T14815'])
 test('T13208', [], makefile_test, ['T13208'])
 test('T16615', normal, compile, ['-ddump-ds -dsuppress-uniques'])
 test('T18112', [grep_errmsg('cast')], compile, ['-ddump-ds'])
-test('T19969', normal, compile, ['-ddump-simpl -dsuppress-uniques'])
+test('T19969', [grep_errmsg('LoopBreaker')], compile, ['-ddump-simpl -dsuppress-uniques']) # f should become loopbreaker
 test('T19883', normal, compile, [''])
 test('T22719', normal, compile, ['-ddump-simpl -dsuppress-uniques -dno-typeable-binds'])
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 80381ba45c..90e67d81fe 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -228,7 +228,6 @@ test('T13027', normal, compile, [''])
 test('T13025',
      normal,
      makefile_test, ['T13025'])
-test('T13143', only_ways(['optasm']), compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-ticks'])
 test('T13156', normal, makefile_test, ['T13156'])
 test('T11444', normal, compile, [''])
 test('str-rules',
@@ -414,7 +413,8 @@ test('T17966',  [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-spec'])
 # We expect to see a SPEC rule for $cm
 test('T19644',  [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-spec'])
 test('T21391', normal, compile, ['-O -dcore-lint'])
-test('T22112', normal, compile, ['-O -dsuppress-uniques -dno-typeable-binds -ddump-simpl'])
+# T22112: Simply test that dumping the Core doesn't loop becuse of the unfolding and ignore the dump output
+test('T22112', [ grep_errmsg('never matches') ], compile, ['-O -dsuppress-uniques -dno-typeable-binds -fexpose-all-unfoldings -ddump-simpl'])
 test('T21391a', normal, compile, ['-O -dcore-lint'])
 # We don't want to see a thunk allocation for the insertBy expression after CorePrep.
 test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]'), expect_broken(21392) ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques'])
diff --git a/testsuite/tests/simplCore/should_compile/T13143.hs b/testsuite/tests/stranal/should_compile/T13143.hs
index c711bdecbe..c711bdecbe 100644
--- a/testsuite/tests/simplCore/should_compile/T13143.hs
+++ b/testsuite/tests/stranal/should_compile/T13143.hs
diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/stranal/should_compile/T13143.stderr
index d614ab1f7a..3bb9885a83 100644
--- a/testsuite/tests/simplCore/should_compile/T13143.stderr
+++ b/testsuite/tests/stranal/should_compile/T13143.stderr
@@ -7,21 +7,22 @@ Rec {
 -- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
 T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker]
   :: forall {a}. (# #) -> a
-[GblId, Arity=1, Str=<B>b, Cpr=b, Unf=OtherCon []]
-T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##)
+[GblId, Arity=1, Str=<B>b{sBp->S}, Cpr=b, Unf=OtherCon []]
+T13143.$wf
+  = \ (@a_sBm) _ [Occ=Dead] -> T13143.$wf @a_sBm GHC.Prim.(##)
 end Rec }
 
 -- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
 f [InlPrag=NOINLINE[final]] :: forall a. Int -> a
 [GblId,
  Arity=1,
- Str=<B>b,
+ Str=<B>b{sBp->S},
  Cpr=b,
  Unf=Unf{Src=StableSystem, TopLvl=True,
          Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)
-         Tmpl= \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##)}]
-f = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##)
+         Tmpl= \ (@a_sBm) _ [Occ=Dead] -> T13143.$wf @a_sBm GHC.Prim.(##)}]
+f = \ (@a_sBm) _ [Occ=Dead] -> T13143.$wf @a_sBm GHC.Prim.(##)
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T13143.$trModule4 :: GHC.Prim.Addr#
@@ -65,9 +66,9 @@ T13143.$trModule
   = GHC.Types.Module T13143.$trModule3 T13143.$trModule1
 
 -- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
-lvl :: Int
-[GblId, Str=b, Cpr=b]
-lvl = T13143.$wf @Int GHC.Prim.(##)
+lvl_rBN :: Int
+[GblId, Str=b{sBp->S}, Cpr=b]
+lvl_rBN = T13143.$wf @Int GHC.Prim.(##)
 
 Rec {
 -- RHS size: {terms: 28, types: 7, coercions: 0, joins: 0/0}
@@ -78,17 +79,17 @@ T13143.$wg [InlPrag=[2], Occ=LoopBreaker]
  Str=<1L><1L><L>,
  Unf=OtherCon []]
 T13143.$wg
-  = \ (ds :: Bool) (ds1 :: Bool) (ww :: GHC.Prim.Int#) ->
-      case ds of {
+  = \ (ds_sBr :: Bool) (ds1_sBs :: Bool) (ww_sBv :: GHC.Prim.Int#) ->
+      case ds_sBr of {
         False ->
-          case ds1 of {
-            False -> T13143.$wg GHC.Types.False GHC.Types.True ww;
-            True -> GHC.Prim.+# ww 1#
+          case ds1_sBs of {
+            False -> T13143.$wg GHC.Types.False GHC.Types.True ww_sBv;
+            True -> GHC.Prim.+# ww_sBv 1#
           };
         True ->
-          case ds1 of {
-            False -> T13143.$wg GHC.Types.True GHC.Types.True ww;
-            True -> case lvl of wild2 { }
+          case ds1_sBs of {
+            False -> T13143.$wg GHC.Types.True GHC.Types.True ww_sBv;
+            True -> case lvl_rBN of wild2_00 { }
           }
       }
 end Rec }
@@ -102,17 +103,20 @@ g [InlPrag=[2]] :: Bool -> Bool -> Int -> Int
  Unf=Unf{Src=StableSystem, TopLvl=True,
          Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (ds [Occ=Once1] :: Bool)
-                 (ds1 [Occ=Once1] :: Bool)
-                 (p [Occ=Once1!] :: Int) ->
-                 case p of { GHC.Types.I# ww [Occ=Once1] ->
-                 case T13143.$wg ds ds1 ww of ww1 [Occ=Once1] { __DEFAULT ->
-                 GHC.Types.I# ww1
+         Tmpl= \ (ds_sBr [Occ=Once1] :: Bool)
+                 (ds1_sBs [Occ=Once1] :: Bool)
+                 (p_sBt [Occ=Once1!] :: Int) ->
+                 case p_sBt of { GHC.Types.I# ww_sBv [Occ=Once1] ->
+                 case T13143.$wg ds_sBr ds1_sBs ww_sBv of ww1_sBA [Occ=Once1]
+                 { __DEFAULT ->
+                 GHC.Types.I# ww1_sBA
                  }
                  }}]
-g = \ (ds :: Bool) (ds1 :: Bool) (p :: Int) ->
-      case p of { GHC.Types.I# ww ->
-      case T13143.$wg ds ds1 ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 }
+g = \ (ds_sBr :: Bool) (ds1_sBs :: Bool) (p_sBt :: Int) ->
+      case p_sBt of { GHC.Types.I# ww_sBv ->
+      case T13143.$wg ds_sBr ds1_sBs ww_sBv of ww1_sBA { __DEFAULT ->
+      GHC.Types.I# ww1_sBA
+      }
       }
 
 
diff --git a/testsuite/tests/stranal/should_compile/T18894.stderr b/testsuite/tests/stranal/should_compile/T18894.stderr
index 22c6f3b32d..d5d4ecf1f9 100644
--- a/testsuite/tests/stranal/should_compile/T18894.stderr
+++ b/testsuite/tests/stranal/should_compile/T18894.stderr
@@ -1,48 +1,54 @@
 
-==================== Demand analysis ====================
-Result size of Demand analysis
+==================== Demand analysis (including Boxity) ====================
+Result size of Demand analysis (including Boxity)
   = {terms: 189, types: 95, coercions: 0, joins: 0/2}
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 $trModule :: GHC.Prim.Addr#
 [LclId,
- 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}]
 $trModule = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 $trModule :: GHC.Types.TrName
 [LclId,
- 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}]
 $trModule = GHC.Types.TrNameS $trModule
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 $trModule :: GHC.Prim.Addr#
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=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}]
 $trModule = "T18894"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 $trModule :: GHC.Types.TrName
 [LclId,
- 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}]
 $trModule = GHC.Types.TrNameS $trModule
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T18894.$trModule :: GHC.Types.Module
 [LclIdX,
- 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}]
 T18894.$trModule = GHC.Types.Module $trModule $trModule
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl :: Int
 [LclId,
- 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}]
 lvl = GHC.Types.I# 0#
 
 -- RHS size: {terms: 42, types: 15, coercions: 0, joins: 0/1}
@@ -51,8 +57,9 @@ g2 [InlPrag=NOINLINE, Dmd=LC(S,C(1,!P(M!P(L),1!P(L))))]
 [LclId,
  Arity=2,
  Str=<L><1!P(1L)>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 20] 106 20}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [20 20] 106 20}]
 g2
   = \ (m :: Int) (ds [Dmd=1!P(1L)] :: Int) ->
       case ds of { GHC.Types.I# ds [Dmd=1L] ->
@@ -64,8 +71,9 @@ g2
                let {
                  c1# :: GHC.Prim.Int#
                  [LclId,
-                  Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
-                          WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 2 0}]
+                  Unf=Unf{Src=<vanilla>, TopLvl=False,
+                          Value=False, ConLike=False, WorkFree=False, Expandable=False,
+                          Guidance=IF_ARGS [] 2 0}]
                  c1# = GHC.Prim.andI# 1# (GHC.Prim.<# wild 0#) } in
                case GHC.Prim.-# (GHC.Prim.quotInt# (GHC.Prim.-# 2# c1#) wild) c1#
                of ds2
@@ -81,22 +89,25 @@ g2
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl :: Int
 [LclId,
- 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}]
 lvl = GHC.Types.I# 2#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl :: Int
 [LclId,
- 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}]
 lvl = GHC.Types.I# 2#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl :: Int
 [LclId,
- 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}]
 lvl = GHC.Types.I# 0#
 
 -- RHS size: {terms: 36, types: 19, coercions: 0, joins: 0/0}
@@ -104,8 +115,9 @@ h2 :: Int -> Int
 [LclIdX,
  Arity=1,
  Str=<1P(SL)>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [20] 162 10}]
 h2
   = \ (ds [Dmd=1P(SL)] :: Int) ->
       case ds of wild { GHC.Types.I# ds [Dmd=SL] ->
@@ -128,22 +140,25 @@ h2
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl :: Int
 [LclId,
- 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}]
 lvl = GHC.Types.I# 15#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl :: Int
 [LclId,
- 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}]
 lvl = GHC.Types.I# 0#
 
 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
 lvl :: (Int, Int)
 [LclId,
- 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}]
 lvl = (lvl, lvl)
 
 -- RHS size: {terms: 36, types: 10, coercions: 0, joins: 0/1}
@@ -151,8 +166,9 @@ g1 [InlPrag=NOINLINE, Dmd=LC(L,!P(L,L))] :: Int -> (Int, Int)
 [LclId,
  Arity=1,
  Str=<1!P(1L)>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 86 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [20] 86 10}]
 g1
   = \ (ds [Dmd=1!P(1L)] :: Int) ->
       case ds of { GHC.Types.I# ds [Dmd=1L] ->
@@ -164,8 +180,9 @@ g1
                let {
                  c1# :: GHC.Prim.Int#
                  [LclId,
-                  Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
-                          WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 2 0}]
+                  Unf=Unf{Src=<vanilla>, TopLvl=False,
+                          Value=False, ConLike=False, WorkFree=False, Expandable=False,
+                          Guidance=IF_ARGS [] 2 0}]
                  c1# = GHC.Prim.andI# 1# (GHC.Prim.<# wild 0#) } in
                case GHC.Prim.-# (GHC.Prim.quotInt# (GHC.Prim.-# 2# c1#) wild) c1#
                of ds2
@@ -181,15 +198,17 @@ g1
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl :: Int
 [LclId,
- 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}]
 lvl = GHC.Types.I# 0#
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 lvl :: (Int, Int)
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
-         WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=False, ConLike=False, WorkFree=False, Expandable=False,
+         Guidance=IF_ARGS [] 30 0}]
 lvl = g1 (GHC.Types.I# 2#)
 
 -- RHS size: {terms: 28, types: 18, coercions: 0, joins: 0/0}
@@ -197,8 +216,9 @@ h1 :: Int -> Int
 [LclIdX,
  Arity=1,
  Str=<1!P(SL)>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [20] 111 10}]
 h1
   = \ (ds [Dmd=1!P(SL)] :: Int) ->
       case ds of wild [Dmd=M!P(1L)] { GHC.Types.I# ds [Dmd=SL] ->
@@ -224,43 +244,49 @@ Result size of Demand analysis
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 $trModule :: GHC.Prim.Addr#
 [LclId,
- 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}]
 $trModule = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 $trModule :: GHC.Types.TrName
 [LclId,
- 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}]
 $trModule = GHC.Types.TrNameS $trModule
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 $trModule :: GHC.Prim.Addr#
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=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}]
 $trModule = "T18894"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 $trModule :: GHC.Types.TrName
 [LclId,
- 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}]
 $trModule = GHC.Types.TrNameS $trModule
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T18894.$trModule :: GHC.Types.Module
 [LclIdX,
- 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}]
 T18894.$trModule = GHC.Types.Module $trModule $trModule
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl :: Int
 [LclId,
- 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}]
 lvl = GHC.Types.I# 0#
 
 -- RHS size: {terms: 39, types: 17, coercions: 0, joins: 0/1}
@@ -269,8 +295,9 @@ $wg2 [InlPrag=NOINLINE, Dmd=LC(S,C(1,!P(M!P(L),1!P(L))))]
 [LclId[StrictWorker([])],
  Arity=2,
  Str=<L><1L>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 76 20}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [20 30] 76 20}]
 $wg2
   = \ (m :: Int) (ww [Dmd=1L] :: GHC.Prim.Int#) ->
       case ww of ds [Dmd=ML] {
@@ -281,8 +308,9 @@ $wg2
                  let {
                    c1# :: GHC.Prim.Int#
                    [LclId,
-                    Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
-                            WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 2 0}]
+                    Unf=Unf{Src=<vanilla>, TopLvl=False,
+                            Value=False, ConLike=False, WorkFree=False, Expandable=False,
+                            Guidance=IF_ARGS [] 2 0}]
                    c1# = GHC.Prim.andI# 1# (GHC.Prim.<# wild 0#) } in
                  case GHC.Prim.-# (GHC.Prim.quotInt# (GHC.Prim.-# 2# c1#) wild) c1#
                  of ds2
@@ -297,8 +325,9 @@ $wg2
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl :: Int
 [LclId,
- 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}]
 lvl = GHC.Types.I# 2#
 
 -- RHS size: {terms: 36, types: 23, coercions: 0, joins: 0/0}
@@ -306,8 +335,9 @@ h2 :: Int -> Int
 [LclIdX,
  Arity=1,
  Str=<1P(SL)>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [20] 162 10}]
 h2
   = \ (ds [Dmd=1P(SL)] :: Int) ->
       case ds of wild { GHC.Types.I# ds [Dmd=SL] ->
@@ -333,8 +363,9 @@ $wg1 [InlPrag=NOINLINE, Dmd=LC(L,!P(L,L))]
 [LclId[StrictWorker([])],
  Arity=1,
  Str=<1L>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 56 20}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [30] 56 20}]
 $wg1
   = \ (ww [Dmd=1L] :: GHC.Prim.Int#) ->
       case ww of ds {
@@ -345,8 +376,9 @@ $wg1
                  let {
                    c1# :: GHC.Prim.Int#
                    [LclId,
-                    Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
-                            WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 2 0}]
+                    Unf=Unf{Src=<vanilla>, TopLvl=False,
+                            Value=False, ConLike=False, WorkFree=False, Expandable=False,
+                            Guidance=IF_ARGS [] 2 0}]
                    c1# = GHC.Prim.andI# 1# (GHC.Prim.<# wild 0#) } in
                  case GHC.Prim.-# (GHC.Prim.quotInt# (GHC.Prim.-# 2# c1#) wild) c1#
                  of ds2
@@ -361,17 +393,19 @@ $wg1
 -- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0}
 lvl :: (Int, Int)
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
-         WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 50 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=False, ConLike=False, WorkFree=False, Expandable=False,
+         Guidance=IF_ARGS [] 50 10}]
 lvl = case $wg1 2# of { (# ww, ww #) -> (GHC.Types.I# ww, ww) }
 
 -- RHS size: {terms: 22, types: 16, coercions: 0, joins: 0/0}
-$wh1 [InlPrag=[2], Dmd=LC(S,!P(L))] :: GHC.Prim.Int# -> Int
+$wh1 [InlPrag=[2]] :: GHC.Prim.Int# -> Int
 [LclId[StrictWorker([])],
  Arity=1,
  Str=<1L>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 91 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [50] 91 10}]
 $wh1
   = \ (ww [Dmd=1L] :: GHC.Prim.Int#) ->
       case ww of ds [Dmd=ML] {
@@ -388,8 +422,8 @@ h1 [InlPrag=[2]] :: Int -> Int
 [LclIdX,
  Arity=1,
  Str=<1!P(1L)>,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (ds [Occ=Once1!, Dmd=S!P(SL)] :: Int) ->
                  case ds of { GHC.Types.I# ww [Occ=Once1, Dmd=SL] -> $wh1 ww }}]
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index 0355def88e..4dbe61a300 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -42,6 +42,9 @@ test('T13031', normal, makefile_test, [])
 test('T13077', normal, compile, [''])
 test('T13077a', normal, compile, [''])
 
+# T13143: WW for NOINLINE function f
+test('T13143', [ grep_errmsg(r'^T13143\.\$wf') ], compile, ['-ddump-simpl'])
+
 # T15627
 #   Absent bindings of unlifted types should be WW'ed away.
 #   The idea is to check that both $wmutVar and $warray
diff --git a/testsuite/tests/stranal/should_run/T23208.hs b/testsuite/tests/stranal/should_run/T23208.hs
new file mode 100644
index 0000000000..8125539fc9
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T23208.hs
@@ -0,0 +1,4 @@
+import T23208_Lib
+
+main = print $ g (15 :: Int)
+
diff --git a/testsuite/tests/stranal/should_run/T23208.stderr b/testsuite/tests/stranal/should_run/T23208.stderr
new file mode 100644
index 0000000000..3d71f0be64
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T23208.stderr
@@ -0,0 +1,3 @@
+T23208: really important message
+CallStack (from HasCallStack):
+  error, called at T23208_Lib.hs:4:7 in main:T23208_Lib
diff --git a/testsuite/tests/stranal/should_run/T23208_Lib.hs b/testsuite/tests/stranal/should_run/T23208_Lib.hs
new file mode 100644
index 0000000000..e4952d098d
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T23208_Lib.hs
@@ -0,0 +1,12 @@
+module T23208_Lib (g) where
+
+err :: Int -> b
+err = error "really important message"
+
+sg :: Int -> Int
+sg n = err n
+{-# NOINLINE sg #-}
+g :: a -> a
+g x = x
+{-# NOINLINE g #-}
+{-# RULES "g" g @Int = sg #-}
diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T
index 9da7863314..42edda5f74 100644
--- a/testsuite/tests/stranal/should_run/all.T
+++ b/testsuite/tests/stranal/should_run/all.T
@@ -32,3 +32,4 @@ test('T22475', normal, compile_and_run, [''])
 test('T22475b', normal, compile_and_run, [''])
 # T22549: Do not strictify DFuns, otherwise we will <<loop>>
 test('T22549', normal, compile_and_run, ['-fdicts-strict -fno-specialise'])
+test('T23208', exit_code(1), multimod_compile_and_run, ['T23208_Lib', 'T23208'])