diff --git a/compiler/Bytecodes.h b/compiler/Bytecodes.h
--- a/compiler/Bytecodes.h
+++ b/compiler/Bytecodes.h
@@ -34,7 +34,6 @@
 #define bci_PUSH16_W                    9
 #define bci_PUSH32_W                    10
 #define bci_PUSH_G                      11
-#define bci_PUSH_ALTS                   12
 #define bci_PUSH_ALTS_P                 13
 #define bci_PUSH_ALTS_N                 14
 #define bci_PUSH_ALTS_F                 15
@@ -81,7 +80,6 @@
 #define bci_CCALL                       56
 #define bci_SWIZZLE                     57
 #define bci_ENTER                       58
-#define bci_RETURN                      59
 #define bci_RETURN_P                    60
 #define bci_RETURN_N                    61
 #define bci_RETURN_F                    62
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -1301,16 +1301,19 @@
         df_args  :: [CoreExpr]  -- Args of the data con: types, superclasses and methods,
     }                           -- in positional order
 
-  | CoreUnfolding {             -- An unfolding for an Id with no pragma,
-                                -- or perhaps a NOINLINE pragma
-                                -- (For NOINLINE, the phase, if any, is in the
-                                -- InlinePragInfo for this Id.)
-        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_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.
+  | CoreUnfolding { -- An unfolding for an Id with no pragma,
+                    -- or perhaps a NOINLINE pragma
+                    -- (For NOINLINE, the phase, if any, is in the
+                    -- InlinePragInfo for this Id.)
+        uf_tmpl     :: CoreExpr,         -- The unfolding itself (aka "template")
+                                         -- Always occ-analysed;
+                                         -- See Note [OccInfo in unfoldings and rules]
+
+        uf_src      :: UnfoldingSource,  -- Where the unfolding came from
+        uf_is_top   :: Bool,             -- True <=> top level binding
+        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:
   --
@@ -1638,14 +1641,37 @@
 
 Note [OccInfo in unfoldings and rules]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In unfoldings and rules, we guarantee that the template is occ-analysed,
-so that the occurrence info on the binders is correct.  This is important,
-because the Simplifier does not re-analyse the template when using it. If
-the occurrence info is wrong
-  - We may get more simplifier iterations than necessary, because
-    once-occ info isn't there
-  - More seriously, we may get an infinite loop if there's a Rec
-    without a loop breaker marked
+In unfoldings and rules, we guarantee that the template is occ-analysed, so
+that the occurrence info on the binders is correct. That way, when the
+Simplifier inlines an unfolding, it doesn't need to occ-analysis it first.
+(The Simplifier is designed to simplify occ-analysed expressions.)
+
+Given this decision it's vital that we do *always* do it.
+
+* If we don't, we may get more simplifier iterations than necessary,
+  because once-occ info isn't there
+
+* More seriously, we may get an infinite loop if there's a Rec without a
+  loop breaker marked.
+
+* Or we may get code that mentions variables not in scope: #22761
+  e.g. Suppose we have a stable unfolding : \y. let z = p+1 in 3
+  Then the pre-simplifier occ-anal will occ-anal the unfolding
+  (redundantly perhaps, but we need its free vars); this will not report
+  the use of `p`; so p's binding will be discarded, and yet `p` is still
+  mentioned.
+
+  Better to occ-anal the unfolding at birth, which will drop the
+  z-binding as dead code.  (Remember, it's the occurrence analyser that
+  drops dead code.)
+
+* Another example is #8892:
+    \x -> letrec { f = ...g...; g* = f } in body
+  where g* is (for some strange reason) the loop breaker.  If we don't
+  occ-anal it when reading it in, we won't mark g as a loop breaker, and we
+  may inline g entirely in body, dropping its binding, and leaving the
+  occurrence in f out of scope. This happened in #8892, where the unfolding
+  in question was a DFun unfolding.
 
 
 ************************************************************************
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -1355,7 +1355,7 @@
 -- | Converts a coercion to be nominal, if possible.
 -- See Note [Role twiddling functions]
 setNominalRole_maybe :: Role -- of input coercion
-                     -> Coercion -> Maybe Coercion
+                     -> Coercion -> Maybe CoercionN
 setNominalRole_maybe r co
   | r == Nominal = Just co
   | otherwise = setNominalRole_maybe_helper co
@@ -1380,10 +1380,19 @@
       = AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2
     setNominalRole_maybe_helper (ForAllCo tv kind_co co)
       = ForAllCo tv kind_co <$> setNominalRole_maybe_helper co
-    setNominalRole_maybe_helper (SelCo n co)
+    setNominalRole_maybe_helper (SelCo cs co) =
       -- NB, this case recurses via setNominalRole_maybe, not
       -- setNominalRole_maybe_helper!
-      = SelCo n <$> setNominalRole_maybe (coercionRole co) co
+      case cs of
+        SelTyCon n _r ->
+          -- Remember to update the role in SelTyCon to nominal;
+          -- not doing this caused #23362.
+          -- See the typing rule in Note [SelCo] in GHC.Core.TyCo.Rep.
+          SelCo (SelTyCon n Nominal) <$> setNominalRole_maybe (coercionRole co) co
+        SelFun fs ->
+          SelCo (SelFun fs) <$> setNominalRole_maybe (coercionRole co) co
+        SelForAll ->
+          pprPanic "setNominalRole_maybe: the coercion should already be nominal" (ppr co)
     setNominalRole_maybe_helper (InstCo co arg)
       = InstCo <$> setNominalRole_maybe_helper co <*> pure arg
     setNominalRole_maybe_helper (UnivCo prov _ co1 co2)
diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs
--- a/compiler/GHC/Core/Opt/Arity.hs
+++ b/compiler/GHC/Core/Opt/Arity.hs
@@ -3085,8 +3085,15 @@
   | need_args < 0
   = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule)
   | otherwise
-  = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args
-         , ru_rhs = new_rhs }
+  = rule { ru_bndrs = bndrs ++ new_bndrs
+         , ru_args  = args ++ new_args
+         , ru_rhs   = new_rhs }
+  -- new_rhs really ought to be occ-analysed (see GHC.Core Note
+  -- [OccInfo in unfoldings and rules]), but it makes a module loop to
+  -- do so; it doesn't happen often; and it doesn't really matter if
+  -- the outer binders have bogus occurrence info; and new_rhs won't
+  -- have dead code if rhs didn't.
+
   where
     need_args = join_arity - length args
     (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs
diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs
--- a/compiler/GHC/Core/Opt/OccurAnal.hs
+++ b/compiler/GHC/Core/Opt/OccurAnal.hs
@@ -2046,6 +2046,17 @@
 empty.   This just saves a bit of allocation and reconstruction; not
 a big deal.
 
+This fast path exposes a tricky cornder, though (#22761). Supose we have
+    Unfolding = \x. let y = foo in x+1
+which includes a dead binding for `y`. In occAnalUnfolding we occ-anal
+the unfolding and produce /no/ occurrences of `foo` (since `y` is
+dead).  But if we discard the occ-analysed syntax tree (which we do on
+our fast path), and use the old one, we still /have/ an occurrence of
+`foo` -- and that can lead to out-of-scope variables (#22761).
+
+Solution: always keep occ-analysed trees in unfoldings and rules, so they
+have no dead code.  See Note [OccInfo in unfoldings and rules] in GHC.Core.
+
 Note [Cascading inlines]
 ~~~~~~~~~~~~~~~~~~~~~~~~
 By default we use an rhsCtxt for the RHS of a binding.  This tells the
diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs
--- a/compiler/GHC/Core/Opt/Simplify/Env.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Env.hs
@@ -1065,7 +1065,7 @@
     -- See Note [Bangs in the Simplifier]
     !id1  = uniqAway in_scope old_id
     !id2  = substIdType env id1
-    !id3  = zapFragileIdInfo id2       -- Zaps rules, worker-info, unfolding
+    !id3  = zapFragileIdInfo id2      -- Zaps rules, worker-info, unfolding
                                       -- and fragile OccInfo
     !new_id = adjust_type id3
 
diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
--- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
@@ -318,14 +318,14 @@
               -> TopLevelFlag -> RecFlag
               -> InId -> OutId          -- Binder, both pre-and post simpl
                                         -- Not a JoinId
-                                        -- The OutId has IdInfo, except arity, unfolding
+                                        -- The OutId has IdInfo (notably RULES),
+                                        -- except arity, unfolding
                                         -- Ids only, no TyVars
               -> InExpr -> SimplEnv     -- The RHS and its environment
               -> SimplM (SimplFloats, SimplEnv)
 -- Precondition: the OutId is already in the InScopeSet of the incoming 'env'
 -- Precondition: not a JoinId
 -- Precondition: rhs obeys the let-can-float invariant
--- NOT used for JoinIds
 simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se
   = assert (isId bndr )
     assertPpr (not (isJoinId bndr)) (ppr bndr) $
@@ -397,48 +397,45 @@
         ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' }
 
 --------------------------
-simplNonRecX :: SimplEnv
+simplAuxBind :: SimplEnv
              -> InId            -- Old binder; not a JoinId
              -> OutExpr         -- Simplified RHS
              -> SimplM (SimplFloats, SimplEnv)
--- A specialised variant of simplNonRec used when the RHS is already
--- simplified, notably in knownCon.  It uses case-binding where necessary.
+-- A specialised variant of completeBindX used to construct non-recursive
+-- auxiliary bindings, notably in knownCon.
 --
+-- The binder comes from a case expression (case binder or alternative)
+-- and so does not have rules, inline pragmas etc.
+--
 -- Precondition: rhs satisfies the let-can-float invariant
 
-simplNonRecX env bndr new_rhs
-  | assertPpr (not (isJoinId bndr)) (ppr bndr) $
+simplAuxBind env bndr new_rhs
+  | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $
     isDeadBinder bndr   -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p }
   = return (emptyFloats env, env)    --  Here c is dead, and we avoid
-                                         --  creating the binding c = (a,b)
-
-  | Coercion co <- new_rhs
-  = return (emptyFloats env, extendCvSubst env bndr co)
+                                     --  creating the binding c = (a,b)
 
+  -- The cases would be inlined unconditionally by completeBind:
+  -- but it seems not uncommon, and avoids faff to do it here
+  -- This is safe because it's only used for auxiliary bindings, which
+  -- have no NOLINE pragmas, nor RULEs
   | exprIsTrivial new_rhs  -- Short-cut for let x = y in ...
-    -- This case would ultimately land in postInlineUnconditionally
-    -- but it seems not uncommon, and avoids a lot of faff to do it here
-  = return (emptyFloats env
-           , extendIdSubst env bndr (DoneEx new_rhs Nothing))
+  = return ( emptyFloats env
+           , case new_rhs of
+                Coercion co -> extendCvSubst env bndr co
+                _           -> extendIdSubst env bndr (DoneEx new_rhs Nothing) )
 
   | otherwise
-  = do  { (env1, new_bndr)   <- simplBinder env bndr
-        ; let is_strict = isStrictId new_bndr
-              -- isStrictId: use new_bndr because the InId bndr might not have
-              -- a fixed runtime representation, which isStrictId doesn't expect
-              -- c.f. Note [Dark corner with representation polymorphism]
-
-        ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict
-                                               new_bndr (emptyFloats env) new_rhs
-              -- NB: it makes a surprisingly big difference (5% in compiler allocation
-              -- in T9630) to pass 'env' rather than 'env1'.  It's fine to pass 'env',
-              -- because this is simplNonRecX, so bndr is not in scope in the RHS.
+  = do  { -- ANF-ise the RHS
+          let !occ_fs = getOccFS bndr
+        ; (anf_floats, rhs1) <- prepareRhs env NotTopLevel occ_fs new_rhs
+        ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet)
+        ; let rhs_floats = emptyFloats env `addLetFloats` anf_floats
 
-        ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats)
-                                             (BC_Let NotTopLevel NonRecursive)
+          -- Simplify the binder and complete the binding
+        ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr
+        ; (bind_float, env2) <- completeBind env1 (BC_Let NotTopLevel NonRecursive)
                                              bndr new_bndr rhs1
-              -- Must pass env1 to completeBind in case simplBinder had to clone,
-              -- and extended the substitution with [bndr :-> new_bndr]
 
         ; return (rhs_floats `addFloats` bind_float, env2) }
 
@@ -760,49 +757,54 @@
 --            x = Just a
 -- See Note [prepareRhs]
 prepareRhs env top_lvl occ rhs0
-  = do  { (_is_exp, floats, rhs1) <- go 0 rhs0
-        ; return (floats, rhs1) }
+  | is_expandable = anfise rhs0
+  | otherwise     = return (emptyLetFloats, rhs0)
   where
-    go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr)
-    go n_val_args (Cast rhs co)
-        = do { (is_exp, floats, rhs') <- go n_val_args rhs
-             ; return (is_exp, floats, Cast rhs' co) }
-    go n_val_args (App fun (Type ty))
-        = do { (is_exp, floats, rhs') <- go n_val_args fun
-             ; return (is_exp, floats, App rhs' (Type ty)) }
-    go n_val_args (App fun arg)
-        = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun
-             ; if is_exp
-               then do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg
-                       ; return (True, floats1 `addLetFlts` floats2, App fun' arg') }
-               else return (False, emptyLetFloats, App fun arg)
-             }
-    go n_val_args (Var fun)
-        = return (is_exp, emptyLetFloats, Var fun)
-        where
-          is_exp = isExpandableApp fun n_val_args   -- The fun a constructor or PAP
-                        -- See Note [CONLIKE pragma] in GHC.Types.Basic
-                        -- The definition of is_exp should match that in
-                        -- 'GHC.Core.Opt.OccurAnal.occAnalApp'
+    -- We can' use exprIsExpandable because the WHOLE POINT is that
+    -- we want to treat (K <big>) as expandable, because we are just
+    -- about "anfise" the <big> expression.  exprIsExpandable would
+    -- just say no!
+    is_expandable = go rhs0 0
+       where
+         go (Var fun) n_val_args       = isExpandableApp fun n_val_args
+         go (App fun arg) n_val_args
+           | isTypeArg arg             = go fun n_val_args
+           | otherwise                 = go fun (n_val_args + 1)
+         go (Cast rhs _)  n_val_args   = go rhs n_val_args
+         go (Tick _ rhs)  n_val_args   = go rhs n_val_args
+         go _             _            = False
 
-    go n_val_args (Tick t rhs)
+    anfise :: OutExpr -> SimplM (LetFloats, OutExpr)
+    anfise (Cast rhs co)
+        = do { (floats, rhs') <- anfise rhs
+             ; return (floats, Cast rhs' co) }
+    anfise (App fun (Type ty))
+        = do { (floats, rhs') <- anfise fun
+             ; return (floats, App rhs' (Type ty)) }
+    anfise (App fun arg)
+        = do { (floats1, fun') <- anfise fun
+             ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg
+             ; return (floats1 `addLetFlts` floats2, App fun' arg') }
+    anfise (Var fun)
+        = return (emptyLetFloats, Var fun)
+
+    anfise (Tick t rhs)
         -- We want to be able to float bindings past this
         -- tick. Non-scoping ticks don't care.
         | tickishScoped t == NoScope
-        = do { (is_exp, floats, rhs') <- go n_val_args rhs
-             ; return (is_exp, floats, Tick t rhs') }
+        = do { (floats, rhs') <- anfise rhs
+             ; return (floats, Tick t rhs') }
 
         -- On the other hand, for scoping ticks we need to be able to
         -- copy them on the floats, which in turn is only allowed if
         -- we can obtain non-counting ticks.
         | (not (tickishCounts t) || tickishCanSplit t)
-        = do { (is_exp, floats, rhs') <- go n_val_args rhs
+        = do { (floats, rhs') <- anfise rhs
              ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr)
                    floats' = mapLetFloats floats tickIt
-             ; return (is_exp, floats', Tick t rhs') }
+             ; return (floats', Tick t rhs') }
 
-    go _ other
-        = return (False, emptyLetFloats, other)
+    anfise other = return (emptyLetFloats, other)
 
 makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec)
 makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd })
@@ -1243,7 +1245,7 @@
 
   | otherwise
   = {-#SCC "simplNonRecE" #-}
-    simplNonRecE env False bndr (rhs, env) body cont
+    simplNonRecE env FromLet bndr (rhs, env) body cont
 
 {- Note [Avoiding space leaks in OutType]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1504,8 +1506,9 @@
       StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty }
         -> rebuildCall env (addValArgTo fun expr fun_ty ) cont
 
-      StrictBind { sc_bndr = b, sc_body = body, sc_env = se, sc_cont = cont }
-        -> completeBindX (se `setInScopeFromE` env) b expr body cont
+      StrictBind { sc_bndr = b, sc_body = body, sc_env = se
+                 , sc_cont = cont, sc_from = from_what }
+        -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont
 
       ApplyToTy  { sc_arg_ty = ty, sc_cont = cont}
         -> rebuild env (App expr (Type ty)) cont
@@ -1517,26 +1520,49 @@
               ; rebuild env (App expr arg') cont }
 
 completeBindX :: SimplEnv
+              -> FromWhat
               -> InId -> OutExpr   -- Bind this Id to this (simplified) expression
                                    -- (the let-can-float invariant may not be satisfied)
-              -> InExpr  -- In this lambda
+              -> InExpr            -- In this body
               -> SimplCont         -- Consumed by this continuation
               -> SimplM (SimplFloats, OutExpr)
-completeBindX env bndr rhs body cont
-  | needsCaseBinding (idType bndr) rhs -- Enforcing the let-can-float-invariant
-  = do { (env1, bndr1) <- simplNonRecBndr env bndr
-       ; (floats, expr') <- simplLam env1 body cont
+completeBindX env from_what bndr rhs body cont
+  | FromBeta arg_ty <- from_what
+  , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant
+  = do { (env1, bndr1)   <- simplNonRecBndr env bndr  -- Lambda binders don't have rules
+       ; (floats, expr') <- simplNonRecBody env1 from_what body cont
        -- Do not float floats past the Case binder below
        ; let expr'' = wrapFloats floats expr'
-       ; let case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr'']
+             case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr'']
        ; return (emptyFloats env, case_expr) }
 
-  | otherwise
-  = do  { (floats1, env') <- simplNonRecX env bndr rhs
-        ; (floats2, expr') <- simplLam env' body cont
-        ; return (floats1 `addFloats` floats2, expr') }
+  | otherwise -- Make a let-binding
+  = do  { (env1, bndr1) <- simplNonRecBndr env bndr
+        ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive)
 
+        ; let is_strict = isStrictId bndr2
+              -- isStrictId: use simplified binder because the InId bndr might not have
+              -- a fixed runtime representation, which isStrictId doesn't expect
+              -- c.f. Note [Dark corner with representation polymorphism]
 
+        ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict
+                                               bndr2 (emptyFloats env) rhs
+              -- NB: it makes a surprisingly big difference (5% in compiler allocation
+              -- in T9630) to pass 'env' rather than 'env1'.  It's fine to pass 'env',
+              -- because this is simplNonRecX, so bndr is not in scope in the RHS.
+
+        ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats)
+                                             (BC_Let NotTopLevel NonRecursive)
+                                             bndr bndr2 rhs1
+              -- Must pass env1 to completeBind in case simplBinder had to clone,
+              -- and extended the substitution with [bndr :-> new_bndr]
+
+        -- Simplify the body
+        ; (body_floats, body') <- simplNonRecBody env2 from_what body cont
+
+        ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats
+        ; return ( all_floats, body' ) }
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1673,6 +1699,14 @@
 ************************************************************************
 -}
 
+simplNonRecBody :: SimplEnv -> FromWhat
+                -> InExpr -> SimplCont
+                -> SimplM (SimplFloats, OutExpr)
+simplNonRecBody env from_what body cont
+  = case from_what of
+      FromLet     -> simplExprF env body cont
+      FromBeta {} -> simplLam   env body cont
+
 simplLam :: SimplEnv -> InExpr -> SimplCont
          -> SimplM (SimplFloats, OutExpr)
 
@@ -1689,16 +1723,25 @@
 
 -- Value beta-reduction
 simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se
-                                    , sc_cont = cont, sc_dup = dup })
-  | isSimplified dup  -- Don't re-simplify if we've simplified it once
-                      -- See Note [Avoiding exponential behaviour]
+                                    , sc_cont = cont, sc_dup = dup
+                                    , sc_hole_ty = fun_ty})
   = do { tick (BetaReduction bndr)
-       ; completeBindX env bndr arg body cont }
+       ; let arg_ty = funArgTy fun_ty
+       ; if | isSimplified dup  -- Don't re-simplify if we've simplified it once
+                                -- Including don't preInlineUnconditionally
+                                -- See Note [Avoiding exponential behaviour]
+            -> completeBindX env (FromBeta arg_ty) bndr arg body cont
 
-  | otherwise         -- See Note [Avoiding exponential behaviour]
-  = do { tick (BetaReduction bndr)
-       ; simplNonRecE env True bndr (arg, arg_se) body cont }
+            | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se
+            , not (needsCaseBinding arg_ty arg)
+              -- Ok to test arg::InExpr in needsCaseBinding because
+              -- exprOkForSpeculation is stable under simplification
+            -> do { tick (PreInlineUnconditionally bndr)
+                  ; simplLam env' body cont }
 
+            | otherwise
+            -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont }
+
 -- Discard a non-counting tick on a lambda.  This may change the
 -- cost attribution slightly (moving the allocation of the
 -- lambda elsewhere), but we don't care: optimisation changes
@@ -1729,8 +1772,7 @@
 
 ------------------
 simplNonRecE :: SimplEnv
-             -> Bool                    -- True  <=> from a lambda
-                                        -- False <=> from a let
+             -> FromWhat
              -> InId                    -- The binder, always an Id
                                         -- Never a join point
              -> (InExpr, SimplEnv)      -- Rhs of binding (or arg of lambda)
@@ -1739,57 +1781,49 @@
              -> SimplM (SimplFloats, OutExpr)
 
 -- simplNonRecE is used for
---  * non-top-level non-recursive non-join-point lets in expressions
---  * beta reduction
+--  * from=FromLet:  a non-top-level non-recursive non-join-point let-expression
+--  * from=FromBeta: a binding arising from a beta reduction
 --
--- simplNonRec env b (rhs, rhs_se) body k
+-- simplNonRecE env b (rhs, rhs_se) body k
 --   = let env in
 --     cont< let b = rhs_se(rhs) in body >
 --
 -- It deals with strict bindings, via the StrictBind continuation,
 -- which may abort the whole process.
 --
--- from_lam=False => the RHS satisfies the let-can-float invariant
+-- from_what=FromLet => the RHS satisfies the let-can-float invariant
 -- Otherwise it may or may not satisfy it.
 
-simplNonRecE env from_lam bndr (rhs, rhs_se) body cont
-  = assert (isId bndr && not (isJoinId bndr) ) $
-    do { (env1, bndr1) <- simplNonRecBndr env bndr
-       ; let needs_case_binding = needsCaseBinding (idType bndr1) rhs
-         -- See Note [Dark corner with representation polymorphism]
-         -- If from_lam=False then needs_case_binding is False,
-         -- because the binding started as a let, which must
-         -- satisfy let-can-float
+simplNonRecE env from_what bndr (rhs, rhs_se) body cont
+  | assert (isId bndr && not (isJoinId bndr) ) $
+    is_strict_bind
+  = -- Evaluate RHS strictly
+    simplExprF (rhs_se `setInScopeFromE` env) rhs
+               (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what
+                           , sc_env = env, sc_cont = cont, sc_dup = NoDup })
 
-       ; if | from_lam && not needs_case_binding
-              -- If not from_lam we are coming from a (NonRec bndr rhs) binding
-              -- and preInlineUnconditionally has been done already;
-              -- no need to repeat it.  But for lambdas we must be careful about
-              -- preInlineUndonditionally: consider (\(x:Int#). 3) (error "urk")
-              -- We must not drop the (error "urk").
-            , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se
-            -> do { tick (PreInlineUnconditionally bndr)
-                  ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $
-                    simplLam env' body cont }
+  | otherwise  -- Evaluate RHS lazily
+  = do { (env1, bndr1)    <- simplNonRecBndr env bndr
+       ; (env2, bndr2)    <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive)
+       ; (floats1, env3)  <- simplLazyBind env2 NotTopLevel NonRecursive
+                                           bndr bndr2 rhs rhs_se
+       ; (floats2, expr') <- simplNonRecBody env3 from_what body cont
+       ; return (floats1 `addFloats` floats2, expr') }
 
-             -- Deal with strict bindings
-            |  isStrictId bndr1 && seCaseCase env
-            || from_lam && needs_case_binding
-               -- The important bit here is needs_case_binds; but no need to
-               -- test it if from_lam is False because then needs_case_binding is False too
-               -- NB: either way, the RHS may or may not satisfy let-can-float
-               --     but that's ok for StrictBind.
-            -> simplExprF (rhs_se `setInScopeFromE` env) rhs
-                          (StrictBind { sc_bndr = bndr, sc_body = body
-                                      , sc_env = env, sc_cont = cont, sc_dup = NoDup })
+  where
+    is_strict_bind = case from_what of
+       FromBeta arg_ty | isUnliftedType arg_ty -> True
+         -- If we are coming from a beta-reduction (FromBeta) we must
+         -- establish the let-can-float invariant, so go via StrictBind
+         -- If not, the invariant holds already, and it's optional.
+         -- Using arg_ty: see Note [Dark corner with representation polymorphism]
+         -- e.g  (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg
+         --      When we come to `x=arg` we myst choose lazy/strict correctly
+         --      It's wrong to err in either directly
 
-            -- Deal with lazy bindings
-            | otherwise
-            -> do { (env2, bndr2)    <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive)
-                  ; (floats1, env3)  <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se
-                  ; (floats2, expr') <- simplLam env3 body cont
-                  ; return (floats1 `addFloats` floats2, expr') } }
+       _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr)
 
+
 ------------------
 simplRecE :: SimplEnv
           -> [(InId, InExpr)]
@@ -1834,7 +1868,7 @@
 One way in which we can get exponential behaviour is if we simplify a
 big expression, and then re-simplify it -- and then this happens in a
 deeply-nested way.  So we must be jolly careful about re-simplifying
-an expression.  That is why simplNonRecX does not try
+an expression (#13379).  That is why simplNonRecX does not try
 preInlineUnconditionally (unlike simplNonRecE).
 
 Example:
@@ -2617,15 +2651,10 @@
 of the rule firing to simplify it, so occurrence analysis is at most
 a constant factor.
 
-Possible improvement: occ-anal the rules when putting them in the
-database; and in the simplifier just occ-anal the OutExpr arguments.
-But that's more complicated and the rule RHS is usually tiny; so I'm
-just doing the simple thing.
-
-Historical note: previously we did occ-anal the rules in Rule.hs,
-but failed to occ-anal the OutExpr arguments, which led to the
-nasty performance problem described above.
-
+Note, however, that the rule RHS is /already/ occ-analysed; see
+Note [OccInfo in unfoldings and rules] in GHC.Core.  There is something
+unsatisfactory about doing it twice; but the rule RHS is usually very
+small, and this is simple.
 
 Note [Optimising tagToEnum#]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2929,7 +2958,7 @@
   where
     simple_rhs env wfloats case_bndr_rhs bs rhs =
       assert (null bs) $
-      do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs
+      do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs
              -- scrut is a constructor application,
              -- hence satisfies let-can-float invariant
          ; (floats2, expr') <- simplExprF env' rhs cont
@@ -2996,7 +3025,7 @@
   | all_dead_bndrs
   , doCaseToLet scrut case_bndr
   = do { tick (CaseElim case_bndr)
-       ; (floats1, env') <- simplNonRecX env case_bndr scrut
+       ; (floats1, env')  <- simplAuxBind env case_bndr scrut
        ; (floats2, expr') <- simplExprF env' rhs cont
        ; return (floats1 `addFloats` floats2, expr') }
 
@@ -3484,12 +3513,11 @@
     bind_args env' (b:bs') (arg : args)
       = assert (isId b) $
         do { let b' = zap_occ b
-             -- Note that the binder might be "dead", because it doesn't
-             -- occur in the RHS; and simplNonRecX may therefore discard
-             -- it via postInlineUnconditionally.
+             -- zap_occ: the binder might be "dead", because it doesn't
+             -- occur in the RHS; and simplAuxBind may therefore discard it.
              -- Nevertheless we must keep it if the case-binder is alive,
              -- because it may be used in the con_app.  See Note [knownCon occ info]
-           ; (floats1, env2) <- simplNonRecX env' b' arg  -- arg satisfies let-can-float invariant
+           ; (floats1, env2) <- simplAuxBind env' b' arg  -- arg satisfies let-can-float invariant
            ; (floats2, env3)  <- bind_args env2 bs' args
            ; return (floats1 `addFloats` floats2, env3) }
 
@@ -3515,7 +3543,7 @@
                                  ; let con_app = Var (dataConWorkId dc)
                                                  `mkTyApps` dc_ty_args
                                                  `mkApps`   dc_args
-                                 ; simplNonRecX env bndr con_app }
+                                 ; simplAuxBind env bndr con_app }
 
 -------------------
 missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont
@@ -3622,15 +3650,15 @@
         ; return (floats, TickIt t cont') }
 
 mkDupableContWithDmds env _
-     (StrictBind { sc_bndr = bndr, sc_body = body
+     (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what
                  , sc_env = se, sc_cont = cont})
 -- See Note [Duplicating StrictBind]
 -- K[ let x = <> in b ]  -->   join j x = K[ b ]
 --                             j <>
   = do { let sb_env = se `setInScopeFromE` env
        ; (sb_env1, bndr')      <- simplBinder sb_env bndr
-       ; (floats1, join_inner) <- simplLam sb_env1 body cont
-          -- No need to use mkDupableCont before simplLam; we
+       ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont
+          -- No need to use mkDupableCont before simplNonRecBody; we
           -- use cont once here, and then share the result if necessary
 
        ; let join_body = wrapFloats floats1 join_inner
@@ -3758,6 +3786,7 @@
            , StrictBind { sc_bndr = arg_bndr
                         , sc_body = join_rhs
                         , sc_env  = zapSubstEnv env
+                        , sc_from = FromLet
                           -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils
                         , sc_dup  = OkToDup
                         , sc_cont = mkBoringStop res_ty } )
@@ -4431,7 +4460,9 @@
            ; return (rule { ru_bndrs = bndrs'
                           , ru_fn    = fn_name'
                           , ru_args  = args'
-                          , ru_rhs   = rhs' }) }
+                          , ru_rhs   = occurAnalyseExpr rhs' }) }
+                            -- Remember to occ-analyse, to drop dead code.
+                            -- See Note [OccInfo in unfoldings and rules] in GHC.Core
 
 {- Note [Simplifying the RHS of a RULE]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -21,7 +21,7 @@
         BindContext(..), bindContextLevel,
 
         -- The continuation type
-        SimplCont(..), DupFlag(..), StaticEnv,
+        SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv,
         isSimplified, contIsStop,
         contIsDupable, contResultType, contHoleType, contHoleScaling,
         contIsTrivial, contArgs, contIsRhs,
@@ -191,6 +191,7 @@
                         --       or, equivalently,  = K[ (\x.b) e ]
       { sc_dup   :: DupFlag        -- See Note [DupFlag invariants]
       , sc_bndr  :: InId
+      , sc_from  :: FromWhat
       , sc_body  :: InExpr
       , sc_env   :: StaticEnv      -- See Note [StaticEnv invariant]
       , sc_cont  :: SimplCont }
@@ -212,6 +213,8 @@
 
 type StaticEnv = SimplEnv       -- Just the static part is relevant
 
+data FromWhat = FromLet | FromBeta OutType
+
 -- See Note [DupFlag invariants]
 data DupFlag = NoDup       -- Unsimplified, might be big
              | Simplified  -- Simplified
@@ -549,7 +552,7 @@
 
 countValArgs :: SimplCont -> Int
 -- Count value arguments only
-countValArgs (ApplyToTy  { sc_cont = cont }) = 1 + countValArgs cont
+countValArgs (ApplyToTy  { sc_cont = cont }) = countValArgs cont
 countValArgs (ApplyToVal { sc_cont = cont }) = 1 + countValArgs cont
 countValArgs (CastIt _ cont)                 = countValArgs cont
 countValArgs _                               = 0
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -62,6 +62,7 @@
 import GHC.Core.Tidy     ( tidyRules )
 import GHC.Core.Map.Expr ( eqCoreExpr )
 import GHC.Core.Opt.Arity( etaExpandToJoinPointRule )
+import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
 
 import GHC.Tc.Utils.TcType  ( tcSplitTyConApp_maybe )
 import GHC.Builtin.Types    ( anyTypeOfKind )
@@ -187,13 +188,18 @@
 -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being
 -- compiled. See also 'GHC.Core.CoreRule'
 mkRule this_mod is_auto is_local name act fn bndrs args rhs
-  = Rule { ru_name = name, ru_fn = fn, ru_act = act,
-           ru_bndrs = bndrs, ru_args = args,
-           ru_rhs = rhs,
-           ru_rough = roughTopNames args,
-           ru_origin = this_mod,
-           ru_orphan = orph,
-           ru_auto = is_auto, ru_local = is_local }
+  = Rule { ru_name   = name
+         , ru_act    = act
+         , ru_fn     = fn
+         , ru_bndrs  = bndrs
+         , ru_args   = args
+         , ru_rhs    = occurAnalyseExpr rhs
+                       -- See Note [OccInfo in unfoldings and rules]
+         , ru_rough  = roughTopNames args
+         , ru_origin = this_mod
+         , ru_orphan = orph
+         , ru_auto   = is_auto
+         , ru_local  = is_local }
   where
         -- Compute orphanhood.  See Note [Orphans] in GHC.Core.InstEnv
         -- A rule is an orphan only if none of the variables
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -1481,7 +1481,7 @@
         -- c.f. #15473
         pprPanic "piResultTys2" (ppr ty $$ ppr orig_args $$ ppr all_args)
 
-applyTysX :: [TyVar] -> Type -> [Type] -> Type
+applyTysX :: HasDebugCallStack => [TyVar] -> Type -> [Type] -> Type
 -- applyTysX beta-reduces (/\tvs. body_ty) arg_tys
 -- Assumes that (/\tvs. body_ty) is closed
 applyTysX tvs body_ty arg_tys
diff --git a/compiler/GHC/Core/Unify.hs b/compiler/GHC/Core/Unify.hs
--- a/compiler/GHC/Core/Unify.hs
+++ b/compiler/GHC/Core/Unify.hs
@@ -1,6 +1,6 @@
 -- (c) The University of Glasgow 2006
 
-{-# LANGUAGE ScopedTypeVariables, PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables, PatternSynonyms, MultiWayIf #-}
 
 {-# LANGUAGE DeriveFunctor #-}
 
@@ -47,6 +47,7 @@
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
 import GHC.Exts( oneShot )
+import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
 import GHC.Data.FastString
 
@@ -994,6 +995,59 @@
 (legitimately) have different numbers of arguments.  They
 are surelyApart, so we can report that without looking any
 further (see #15704).
+
+Note [Unifying type applications]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Unifying type applications is quite subtle, as we found
+in #23134 and #22647, when type families are involved.
+
+Suppose
+   type family F a :: Type -> Type
+   type family G k :: k = r | r -> k
+
+and consider these examples:
+
+* F Int ~ F Char, where F is injective
+  Since F is injective, we can reduce this to Int ~ Char,
+  therefore SurelyApart.
+
+* F Int ~ F Char, where F is not injective
+  Without injectivity, return MaybeApart.
+
+* G Type ~ G (Type -> Type) Int
+  Even though G is injective and the arguments to G are different,
+  we cannot deduce apartness because the RHS is oversaturated.
+  For example, G might be defined as
+    G Type = Maybe Int
+    G (Type -> Type) = Maybe
+  So we return MaybeApart.
+
+* F Int Bool ~ F Int Char       -- SurelyApart (since Bool is apart from Char)
+  F Int Bool ~ Maybe a          -- MaybeApart
+  F Int Bool ~ a b              -- MaybeApart
+  F Int Bool ~ Char -> Bool     -- MaybeApart
+  An oversaturated type family can match an application,
+  whether it's a TyConApp, AppTy or FunTy. Decompose.
+
+* F Int ~ a b
+  We cannot decompose a saturated, or under-saturated
+  type family application. We return MaybeApart.
+
+To handle all those conditions, unify_ty goes through
+the following checks in sequence, where Fn is a type family
+of arity n:
+
+* (C1) Fn x_1 ... x_n ~ Fn y_1 .. y_n
+  A saturated application.
+  Here we can unify arguments in which Fn is injective.
+* (C2) Fn x_1 ... x_n ~ anything, anything ~ Fn x_1 ... x_n
+  A saturated type family can match anything - we return MaybeApart.
+* (C3) Fn x_1 ... x_m ~ a b, a b ~ Fn x_1 ... x_m where m > n
+  An oversaturated type family can be decomposed.
+* (C4) Fn x_1 ... x_m ~ anything, anything ~ Fn x_1 ... x_m, where m > n
+  If we couldn't decompose in the previous step, we return SurelyApart.
+
+Afterwards, the rest of the code doesn't have to worry about type families.
 -}
 
 -------------- unify_ty: the main workhorse -----------
@@ -1035,32 +1089,64 @@
   = uVar (umSwapRn env) tv2 ty1 (mkSymCo kco)
 
 unify_ty env ty1 ty2 _kco
-  | Just (tc1, tys1) <- mb_tc_app1
-  , Just (tc2, tys2) <- mb_tc_app2
+
+  -- Handle non-oversaturated type families first
+  -- See Note [Unifying type applications]
+  --
+  -- (C1) If we have T x1 ... xn ~ T y1 ... yn, use injectivity information of T
+  -- Note that both sides must not be oversaturated
+  | Just (tc1, tys1) <- isSatTyFamApp mb_tc_app1
+  , Just (tc2, tys2) <- isSatTyFamApp mb_tc_app2
   , tc1 == tc2
-  = if isInjectiveTyCon tc1 Nominal
-    then unify_tys env tys1 tys2
-    else do { let inj | isTypeFamilyTyCon tc1
-                      = case tyConInjectivityInfo tc1 of
-                               NotInjective -> repeat False
-                               Injective bs -> bs
-                      | otherwise
-                      = repeat False
+  = do { let inj = case tyConInjectivityInfo tc1 of
+                          NotInjective -> repeat False
+                          Injective bs -> bs
 
-                  (inj_tys1, noninj_tys1) = partitionByList inj tys1
-                  (inj_tys2, noninj_tys2) = partitionByList inj tys2
+             (inj_tys1, noninj_tys1) = partitionByList inj tys1
+             (inj_tys2, noninj_tys2) = partitionByList inj tys2
 
-            ; unify_tys env inj_tys1 inj_tys2
-            ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification]
-              don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 }
+       ; unify_tys env inj_tys1 inj_tys2
+       ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification]
+         don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 }
 
-  | isTyFamApp mb_tc_app1     -- A (not-over-saturated) type-family application
-  = maybeApart MARTypeFamily  -- behaves like a type variable; might match
+  | Just _ <- isSatTyFamApp mb_tc_app1  -- (C2) A (not-over-saturated) type-family application
+  = maybeApart MARTypeFamily            -- behaves like a type variable; might match
 
-  | isTyFamApp mb_tc_app2     -- A (not-over-saturated) type-family application
-  , um_unif env               -- behaves like a type variable; might unify
-  = maybeApart MARTypeFamily
+  | Just _ <- isSatTyFamApp mb_tc_app2  -- (C2) A (not-over-saturated) type-family application
+                                        -- behaves like a type variable; might unify
+                                        -- but doesn't match (as in the TyVarTy case)
+  = if um_unif env then maybeApart MARTypeFamily else surelyApart
 
+  -- Handle oversaturated type families.
+  --
+  -- They can match an application (TyConApp/FunTy/AppTy), this is handled
+  -- the same way as in the AppTy case below.
+  --
+  -- If there is no application, an oversaturated type family can only
+  -- match a type variable or a saturated type family,
+  -- both of which we handled earlier. So we can say surelyApart.
+  | Just (tc1, _) <- mb_tc_app1
+  , isTypeFamilyTyCon tc1
+  = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1
+       , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2
+       -> unify_ty_app env ty1a [ty1b] ty2a [ty2b]            -- (C3)
+       | otherwise -> surelyApart                             -- (C4)
+
+  | Just (tc2, _) <- mb_tc_app2
+  , isTypeFamilyTyCon tc2
+  = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1
+       , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2
+       -> unify_ty_app env ty1a [ty1b] ty2a [ty2b]            -- (C3)
+       | otherwise -> surelyApart                             -- (C4)
+
+  -- At this point, neither tc1 nor tc2 can be a type family.
+  | Just (tc1, tys1) <- mb_tc_app1
+  , Just (tc2, tys2) <- mb_tc_app2
+  , tc1 == tc2
+  = do { massertPpr (isInjectiveTyCon tc1 Nominal) (ppr tc1)
+       ; unify_tys env tys1 tys2
+       }
+
   -- TYPE and CONSTRAINT are not Apart
   -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim
   -- NB: at this point we know that the two TyCons do not match
@@ -1160,16 +1246,16 @@
       -- Possibly different saturations of a polykinded tycon
       -- See Note [Polykinded tycon applications]
 
-isTyFamApp :: Maybe (TyCon, [Type]) -> Bool
--- True if we have a saturated or under-saturated type family application
+isSatTyFamApp :: Maybe (TyCon, [Type]) -> Maybe (TyCon, [Type])
+-- Return the argument if we have a saturated type family application
 -- If it is /over/ saturated then we return False.  E.g.
 --     unify_ty (F a b) (c d)    where F has arity 1
 -- we definitely want to decompose that type application! (#22647)
-isTyFamApp (Just (tc, tys))
-  =  not (isGenerativeTyCon tc Nominal)       -- Type family-ish
+isSatTyFamApp tapp@(Just (tc, tys))
+  |  isTypeFamilyTyCon tc
   && not (tys `lengthExceeds` tyConArity tc)  -- Not over-saturated
-isTyFamApp Nothing
-  = False
+  = tapp
+isSatTyFamApp _ = Nothing
 
 ---------------------------------
 uVar :: UMEnv
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -515,8 +515,8 @@
 -- | Tests whether we have to use a @case@ rather than @let@ binding for this
 -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant"
 needsCaseBinding :: Type -> CoreExpr -> Bool
-needsCaseBinding ty rhs =
-  mightBeUnliftedType ty && not (exprOkForSpeculation rhs)
+needsCaseBinding ty rhs
+  = mightBeUnliftedType ty && not (exprOkForSpeculation rhs)
         -- Make a case expression instead of a let
         -- These can arise either from the desugarer,
         -- or from beta reductions: (\x.e) (x +# y)
diff --git a/compiler/GHC/Platform.hs b/compiler/GHC/Platform.hs
--- a/compiler/GHC/Platform.hs
+++ b/compiler/GHC/Platform.hs
@@ -207,6 +207,7 @@
 osElfTarget OSAIX       = False
 osElfTarget OSHurd      = True
 osElfTarget OSWasi      = False
+osElfTarget OSGhcjs     = False
 osElfTarget OSUnknown   = False
  -- Defaulting to False is safe; it means don't rely on any
  -- ELF-specific functionality.  It is important to have a default for
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -2387,22 +2387,32 @@
 -}
 
 
+-- | Why was the LHS 'PatersonSize' not strictly smaller than the RHS 'PatersonSize'?
+--
+-- See Note [Paterson conditions] in GHC.Tc.Validity.
 data PatersonSizeFailure
-  = PSF_TyFam TyCon     -- Type family
-  | PSF_Size            -- Too many type constructors/variables
-  | PSF_TyVar [TyVar]   -- These type variables appear more often than in instance head;
-                        --   no duplicates in this list
+  -- | Either side contains a type family.
+  = PSF_TyFam TyCon
+  -- | The size of the LHS is not strictly less than the size of the RHS.
+  | PSF_Size
+  -- | These type variables appear more often in the LHS than in the RHS.
+  | PSF_TyVar [TyVar] -- ^  no duplicates in this list
 
 --------------------------------------
 
-data PatersonSize    -- See Note [Paterson conditions] in GHC.Tc.Validity
-  = PS_TyFam TyCon   -- Mentions a type family; infinite size
+-- | The Paterson size of a given type, in the sense of
+-- Note [Paterson conditions] in GHC.Tc.Validity
+--
+--   - after expanding synonyms,
+--   - ignoring coercions (as they are not user written).
+data PatersonSize
+  -- | The type mentions a type family, so the size could be anything.
+  = PS_TyFam TyCon
 
-  | PS_Vanilla { ps_tvs :: [TyVar]  -- Free tyvars, including repetitions;
-               , ps_size :: Int     -- Number of type constructors and variables
+  -- | The type does not mention a type family.
+  | PS_Vanilla { ps_tvs :: [TyVar]  -- ^ free tyvars, including repetitions;
+               , ps_size :: Int     -- ^ number of type constructors and variables
     }
-  -- Always after expanding synonyms
-  -- Always ignore coercions (not user written)
   -- ToDo: ignore invisible arguments?  See Note [Invisible arguments and termination]
 
 instance Outputable PatersonSize where
@@ -2415,21 +2425,26 @@
 pSizeZero = PS_Vanilla { ps_tvs = [], ps_size = 0 }
 pSizeOne  = PS_Vanilla { ps_tvs = [], ps_size = 1 }
 
-ltPatersonSize :: PatersonSize    -- Size of constraint
-               -> PatersonSize    -- Size of instance head; never PS_TyFam
+-- | @ltPatersonSize ps1 ps2@ returns:
+--
+--  - @Nothing@ iff @ps1@ is definitely strictly smaller than @ps2@,
+--  - @Just ps_fail@ otherwise; @ps_fail@ says what went wrong.
+ltPatersonSize :: PatersonSize
+               -> PatersonSize
                -> Maybe PatersonSizeFailure
--- (ps1 `ltPatersonSize` ps2) returns
---     Nothing iff ps1 is strictly smaller than p2
---     Just ps_fail says what went wrong
-ltPatersonSize (PS_TyFam tc) _ = Just (PSF_TyFam tc)
 ltPatersonSize (PS_Vanilla { ps_tvs = tvs1, ps_size = s1 })
                (PS_Vanilla { ps_tvs = tvs2, ps_size = s2 })
   | s1 >= s2                                = Just PSF_Size
   | bad_tvs@(_:_) <- noMoreTyVars tvs1 tvs2 = Just (PSF_TyVar bad_tvs)
   | otherwise                               = Nothing -- OK!
-ltPatersonSize (PS_Vanilla {}) (PS_TyFam tc)
-  = pprPanic "ltPSize" (ppr tc)
-    -- Impossible because we never have a type family in an instance head
+ltPatersonSize (PS_TyFam tc) _ = Just (PSF_TyFam tc)
+ltPatersonSize _ (PS_TyFam tc) = Just (PSF_TyFam tc)
+  -- NB: this last equation is never taken when checking instances, because
+  -- type families are disallowed in instance heads.
+  --
+  -- However, this function is also used in the logic for solving superclass
+  -- constraints (see Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance),
+  -- in which case we might well hit this case (see e.g. T23171).
 
 noMoreTyVars :: [TyVar]  -- Free vars (with repetitions) of the constraint C
              -> [TyVar]  -- Free vars (with repetitions) of the head H
diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
--- a/compiler/GHC/Types/Id.hs
+++ b/compiler/GHC/Types/Id.hs
@@ -723,12 +723,14 @@
 zapIdDmdSig :: Id -> Id
 zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id
 
--- | This predicate says whether the 'Id' has a strict demand placed on it or
--- has a type such that it can always be evaluated strictly (i.e an
--- unlifted type, as of GHC 7.6).  We need to
--- check separately whether the 'Id' has a so-called \"strict type\" because if
--- the demand for the given @id@ hasn't been computed yet but @id@ has a strict
--- type, we still want @isStrictId id@ to be @True@.
+-- | `isStrictId` says whether either
+--   (a) the 'Id' has a strict demand placed on it or
+--   (b) definitely has a \"strict type\", such that it can always be
+--       evaluated strictly (i.e an unlifted type)
+-- We need to check (b) as well as (a), because when the demand for the
+-- given `id` hasn't been computed yet but `id` has a strict
+-- type, we still want `isStrictId id` to be `True`.
+-- Returns False if the type is levity polymorphic; False is always safe.
 isStrictId :: Id -> Bool
 isStrictId id
   | assertPpr (isId id) (text "isStrictId: not an id: " <+> ppr id) $
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -1048,8 +1048,7 @@
         arg_ty' = case mb_co of
                     { Just redn -> scaledSet arg_ty (reductionReducedType redn)
                     ; Nothing   -> arg_ty }
-  , all (not . isNewTyCon . fst) (splitTyConApp_maybe $ scaledThing arg_ty')
-  , shouldUnpackTy bang_opts unpk_prag fam_envs arg_ty'
+  , shouldUnpackArgTy bang_opts unpk_prag fam_envs arg_ty'
   = if bang_opt_unbox_disable bang_opts
     then HsStrict True -- Not unpacking because of -O0
                        -- See Note [Detecting useless UNPACK pragmas] in GHC.Core.DataCon
@@ -1324,69 +1323,95 @@
 mkUbxSumAltTy [ty] = ty
 mkUbxSumAltTy tys  = mkTupleTy Unboxed tys
 
-shouldUnpackTy :: BangOpts -> SrcUnpackedness -> FamInstEnvs -> Scaled Type -> Bool
+shouldUnpackArgTy :: BangOpts -> SrcUnpackedness -> FamInstEnvs -> Scaled Type -> Bool
 -- True if we ought to unpack the UNPACK the argument type
 -- See Note [Recursive unboxing]
 -- We look "deeply" inside rather than relying on the DataCons
 -- we encounter on the way, because otherwise we might well
 -- end up relying on ourselves!
-shouldUnpackTy bang_opts prag fam_envs ty
-  | Just data_cons <- unpackable_type_datacons (scaledThing ty)
-  = all (ok_con_args emptyNameSet) data_cons && should_unpack data_cons
+shouldUnpackArgTy bang_opts prag fam_envs arg_ty
+  | Just data_cons <- unpackable_type_datacons (scaledThing arg_ty)
+  , all ok_con data_cons                -- Returns True only if we can't get a
+                                        -- loop involving these data cons
+  , should_unpack prag arg_ty data_cons -- ...hence the call to dataConArgUnpack in
+                                        --    should_unpack won't loop
+       -- See Wrinkle (W1b) of Note [Recursive unboxing] for this loopy stuff
+  = True
+
   | otherwise
   = False
   where
-    ok_con_args :: NameSet -> DataCon -> Bool
-    ok_con_args dcs con
-       | dc_name `elemNameSet` dcs
-       = False
-       | otherwise
-       = all (ok_arg dcs')
-             (dataConOrigArgTys con `zip` dataConSrcBangs con)
-          -- NB: dataConSrcBangs gives the *user* request;
-          -- We'd get a black hole if we used dataConImplBangs
+    ok_con :: DataCon -> Bool      -- True <=> OK to unpack
+    ok_con top_con                 -- False <=> not safe
+      = ok_args emptyNameSet top_con
        where
-         dc_name = getName con
-         dcs' = dcs `extendNameSet` dc_name
+         top_con_name = getName top_con
 
-    ok_arg :: NameSet -> (Scaled Type, HsSrcBang) -> Bool
-    ok_arg dcs (Scaled _ ty, bang)
-      = not (attempt_unpack bang) || ok_ty dcs norm_ty
-      where
-        norm_ty = topNormaliseType fam_envs ty
+         ok_args dcs con
+           = all (ok_arg dcs) $
+             (dataConOrigArgTys con `zip` dataConSrcBangs con)
+             -- NB: dataConSrcBangs gives the *user* request;
+             -- We'd get a black hole if we used dataConImplBangs
 
-    ok_ty :: NameSet -> Type -> Bool
-    ok_ty dcs ty
-      | Just data_cons <- unpackable_type_datacons ty
-      = all (ok_con_args dcs) data_cons
-      | otherwise
-      = True        -- NB True here, in contrast to False at top level
+         ok_arg :: NameSet -> (Scaled Type, HsSrcBang) -> Bool
+         ok_arg dcs (Scaled _ ty, HsSrcBang _ unpack_prag str_prag)
+           | strict_field str_prag
+           , Just data_cons <- unpackable_type_datacons (topNormaliseType fam_envs ty)
+           , should_unpack_conservative unpack_prag data_cons  -- Wrinkle (W3)
+           = all (ok_rec_con dcs) data_cons                    --  of Note [Recursive unboxing]
+           | otherwise
+           = True        -- NB True here, in contrast to False at top level
 
-    attempt_unpack :: HsSrcBang -> Bool
-    attempt_unpack (HsSrcBang _ SrcUnpack NoSrcStrict)
-      = bang_opt_strict_data bang_opts
-    attempt_unpack (HsSrcBang _ SrcUnpack SrcStrict)
-      = True
-    attempt_unpack (HsSrcBang _  NoSrcUnpack SrcStrict)
-      = True  -- Be conservative
-    attempt_unpack (HsSrcBang _  NoSrcUnpack NoSrcStrict)
-      = bang_opt_strict_data bang_opts -- Be conservative
-    attempt_unpack _ = False
+         -- See Note [Recursive unboxing]
+         --   * Do not look at the HsImplBangs to `con`; see Wrinkle (W1a)
+         --   * For the "at the root" comments see Wrinkle (W2)
+         ok_rec_con dcs con
+           | dc_name == top_con_name   = False  -- Recursion at the root
+           | dc_name `elemNameSet` dcs = True   -- Not at the root
+           | otherwise                 = ok_args (dcs `extendNameSet` dc_name) con
+           where
+             dc_name = getName con
 
-    -- Determine whether we ought to unpack a field based on user annotations if present and heuristics if not.
-    should_unpack data_cons =
+    strict_field :: SrcStrictness -> Bool
+    -- True <=> strict field
+    strict_field NoSrcStrict = bang_opt_strict_data bang_opts
+    strict_field SrcStrict   = True
+    strict_field SrcLazy     = False
+
+    -- Determine whether we ought to unpack a field,
+    -- based on user annotations if present.
+    -- A conservative version of should_unpack that doesn't look at how
+    -- many fields the field would unpack to... because that leads to a loop.
+    -- "Conservative" = err on the side of saying "yes".
+    should_unpack_conservative :: SrcUnpackedness -> [DataCon] -> Bool
+    should_unpack_conservative SrcNoUnpack _   = False  -- {-# NOUNPACK #-}
+    should_unpack_conservative SrcUnpack   _   = True   -- {-# NOUNPACK #-}
+    should_unpack_conservative NoSrcUnpack dcs = not (is_sum dcs)
+        -- is_sum: we never unpack sums without a pragma; otherwise be conservative
+
+    -- Determine whether we ought to unpack a field,
+    -- based on user annotations if present, and heuristics if not.
+    should_unpack :: SrcUnpackedness -> Scaled Type -> [DataCon] -> Bool
+    should_unpack prag arg_ty data_cons =
       case prag of
         SrcNoUnpack -> False -- {-# NOUNPACK #-}
         SrcUnpack   -> True  -- {-# UNPACK #-}
         NoSrcUnpack -- No explicit unpack pragma, so use heuristics
-          | (_:_:_) <- data_cons
-          -> False -- don't unpack sum types automatically, but they can be unpacked with an explicit source UNPACK.
-          | otherwise
+          | is_sum data_cons
+          -> False -- Don't unpack sum types automatically, but they can
+                   -- be unpacked with an explicit source UNPACK.
+          | otherwise   -- Wrinkle (W4) of Note [Recursive unboxing]
           -> bang_opt_unbox_strict bang_opts
              || (bang_opt_unbox_small bang_opts
                  && rep_tys `lengthAtMost` 1)  -- See Note [Unpack one-wide fields]
-      where (rep_tys, _) = dataConArgUnpack ty
+      where
+        (rep_tys, _) = dataConArgUnpack arg_ty
 
+    is_sum :: [DataCon] -> Bool
+    -- We never unpack sum types automatically
+    -- (Product types, we do. Empty types are weeded out by unpackable_type_datacons.)
+    is_sum (_:_:_) = True
+    is_sum _       = False
 
 -- Given a type already assumed to have been normalized by topNormaliseType,
 -- unpackable_type_datacons ty = Just datacons
@@ -1398,11 +1423,11 @@
 unpackable_type_datacons :: Type -> Maybe [DataCon]
 unpackable_type_datacons ty
   | Just (tc, _) <- splitTyConApp_maybe ty
-  , not (isNewTyCon tc)
-    -- Even though `ty` has been normalised, it could still
-    -- be a /recursive/ newtype, so we must check for that
+  , not (isNewTyCon tc)  -- Even though `ty` has been normalised, it could still
+                         -- be a /recursive/ newtype, so we must check for that
   , Just cons <- tyConDataCons_maybe tc
-  , not (null cons)
+  , not (null cons)      -- Don't upack nullary sums; no need.
+                         -- They already take zero bits
   , all (null . dataConExTyCoVars) cons
   = Just cons -- See Note [Unpacking GADTs and existentials]
   | otherwise
@@ -1458,20 +1483,74 @@
         data T = MkT {-# UNPACK #-} !T Int
 Because then we'd get an infinite number of arguments.
 
-Here is a more complicated case:
-        data S = MkS {-# UNPACK #-} !T Int
-        data T = MkT {-# UNPACK #-} !S Int
-Each of S and T must decide independently whether to unpack
-and they had better not both say yes. So they must both say no.
-
-Also behave conservatively when there is no UNPACK pragma
-        data T = MkS !T Int
-with -funbox-strict-fields or -funbox-small-strict-fields
-we need to behave as if there was an UNPACK pragma there.
-
-But it's the *argument* type that matters. This is fine:
+Note that it's the *argument* type that matters. This is fine:
         data S = MkS S !Int
 because Int is non-recursive.
+
+Wrinkles:
+
+(W1a) We have to be careful that the compiler doesn't go into a loop!
+      First, we must not look at the HsImplBang decisions of data constructors
+      in the same mutually recursive group.  E.g.
+         data S = MkS {-# UNPACK #-} !T Int
+         data T = MkT {-# UNPACK #-} !S Int
+      Each of S and T must decide /independently/ whether to unpack
+      and they had better not both say yes. So they must both say no.
+      (We could detect when we leave the group, and /then/ we can rely on
+      HsImplBangs; but that requires more plumbing.)
+
+(W1b) Here is another way the compiler might go into a loop (test T23307b):
+         data data T = MkT !S Int
+         data S = MkS !T
+     Suppose we call `shouldUnpackArgTy` on the !S arg of `T`.  In `should_unpack`
+     we ask if the number of fields that `MkS` unpacks to is small enough
+     (via rep_tys `lengthAtMost` 1).  But how many field /does/ `MkS` unpack
+     to?  Well it depends on the unpacking decision we make for `MkS`, which
+     in turn depends on `MkT`, which we are busy deciding. Black holes beckon.
+
+     So we /first/ call `ok_con` on `MkS` (and `ok_con` is conservative;
+     see `should_unpack_conservative`), and only /then/ call `should_unpack`.
+     Tricky!
+
+(W2) As #23307 shows,  we /do/ want to unpack the second arg of the Yes
+     data constructor in this example, despite the recursion in List:
+       data Stream a   = Cons a !(Stream a)
+       data Unconsed a = Unconsed a !(Stream a)
+       data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a)
+     When looking at
+       {-# UNPACK #-} (Unconsed a)
+     we can take Unconsed apart, but then get into a loop with Stream.
+     That's fine: we can still take Unconsed apart.  It's only if we
+     have a loop /at the root/ that we must not unpack.
+
+(W3) Moreover (W2) can apply even if there is a recursive loop:
+       data List a = Nil | Cons {-# UNPACK #-} !(Unconsed a)
+       data Unconsed a = Unconsed a !(List a)
+     Here there is mutual recursion between `Unconsed` and `List`; and yet
+     we can unpack the field of `Cons` because we will not unpack the second
+     field of `Unconsed`: we never unpack a sum type without an explicit
+     pragma (see should_unpack).
+
+(W4) Consider
+        data T = MkT !Wombat
+        data Wombat = MkW {-# UNPACK #-} !S Int
+        data S = MkS {-# NOUNPACK #-} !Wombat Int
+     Suppose we are deciding whether to unpack the first field of MkT, by
+     calling (shouldUnpackArgTy Wombat).  Then we'll try to unpack the !S field
+     of MkW, and be stopped by the {-# NOUNPACK #-}, and all is fine; we can
+     unpack MkT.
+
+     If that NOUNPACK had been a UNPACK, though, we'd get a loop, and would
+     decide not to unpack the Wombat field of MkT.
+
+     But what if there was no pragma in `data S`?  Then we /still/ decide not
+     to unpack the Wombat field of MkT (at least when auto-unpacking is on),
+     because we don't know for sure which decision will be taken for the
+     Wombat field of MkS.
+
+     TL;DR when there is no pragma, behave as if there was a UNPACK, at least
+     when auto-unpacking is on.  See `should_unpack` in `shouldUnpackArgTy`.
+
 
 ************************************************************************
 *                                                                      *
diff --git a/compiler/ghc.cabal b/compiler/ghc.cabal
--- a/compiler/ghc.cabal
+++ b/compiler/ghc.cabal
@@ -3,7 +3,7 @@
 -- ./configure.  Make sure you are editing ghc.cabal.in, not ghc.cabal.
 
 Name: ghc
-Version: 9.6.1
+Version: 9.6.2
 License: BSD-3-Clause
 License-File: LICENSE
 Author: The GHC Team
@@ -86,9 +86,9 @@
                    transformers >= 0.5 && < 0.7,
                    exceptions == 0.10.*,
                    stm,
-                   ghc-boot   == 9.6.1,
-                   ghc-heap   == 9.6.1,
-                   ghci == 9.6.1
+                   ghc-boot   == 9.6.2,
+                   ghc-heap   == 9.6.2,
+                   ghci == 9.6.2
 
     if os(windows)
         Build-Depends: Win32  >= 2.3 && < 2.14
diff --git a/ghc-lib-parser.cabal b/ghc-lib-parser.cabal
--- a/ghc-lib-parser.cabal
+++ b/ghc-lib-parser.cabal
@@ -1,7 +1,7 @@
 cabal-version: 2.0
 build-type: Simple
 name: ghc-lib-parser
-version: 9.6.1.20230312
+version: 9.6.2.20230523
 license: BSD3
 license-file: LICENSE
 category: Development
diff --git a/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs b/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs
--- a/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs
+++ b/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs
@@ -3,19 +3,19 @@
 import Prelude -- See Note [Why do we import Prelude here?]
 
 cProjectGitCommitId   :: String
-cProjectGitCommitId   = "a58c028a181106312e1a783e82a37fc657ce9cfe"
+cProjectGitCommitId   = "7e70df17aee2e39bc599b43e59a52bb30064df4d"
 
 cProjectVersion       :: String
-cProjectVersion       = "9.6.1"
+cProjectVersion       = "9.6.2"
 
 cProjectVersionInt    :: String
 cProjectVersionInt    = "906"
 
 cProjectPatchLevel    :: String
-cProjectPatchLevel    = "1"
+cProjectPatchLevel    = "2"
 
 cProjectPatchLevel1   :: String
-cProjectPatchLevel1   = "1"
+cProjectPatchLevel1   = "2"
 
 cProjectPatchLevel2   :: String
 cProjectPatchLevel2   = "0"
diff --git a/ghc-lib/stage0/rts/build/include/GhclibDerivedConstants.h b/ghc-lib/stage0/rts/build/include/GhclibDerivedConstants.h
--- a/ghc-lib/stage0/rts/build/include/GhclibDerivedConstants.h
+++ b/ghc-lib/stage0/rts/build/include/GhclibDerivedConstants.h
@@ -68,29 +68,29 @@
 #define OFFSET_stgGCEnter1 -16
 #define OFFSET_stgGCFun -8
 #define OFFSET_Capability_r 24
-#define OFFSET_Capability_lock 1216
+#define OFFSET_Capability_lock 1224
 #define OFFSET_Capability_no 944
 #define REP_Capability_no b32
 #define Capability_no(__ptr__) REP_Capability_no[__ptr__+OFFSET_Capability_no]
 #define OFFSET_Capability_mut_lists 1016
 #define REP_Capability_mut_lists b64
 #define Capability_mut_lists(__ptr__) REP_Capability_mut_lists[__ptr__+OFFSET_Capability_mut_lists]
-#define OFFSET_Capability_context_switch 1184
+#define OFFSET_Capability_context_switch 1192
 #define REP_Capability_context_switch b32
 #define Capability_context_switch(__ptr__) REP_Capability_context_switch[__ptr__+OFFSET_Capability_context_switch]
-#define OFFSET_Capability_interrupt 1188
+#define OFFSET_Capability_interrupt 1196
 #define REP_Capability_interrupt b32
 #define Capability_interrupt(__ptr__) REP_Capability_interrupt[__ptr__+OFFSET_Capability_interrupt]
-#define OFFSET_Capability_sparks 1320
+#define OFFSET_Capability_sparks 1328
 #define REP_Capability_sparks b64
 #define Capability_sparks(__ptr__) REP_Capability_sparks[__ptr__+OFFSET_Capability_sparks]
-#define OFFSET_Capability_total_allocated 1192
+#define OFFSET_Capability_total_allocated 1200
 #define REP_Capability_total_allocated b64
 #define Capability_total_allocated(__ptr__) REP_Capability_total_allocated[__ptr__+OFFSET_Capability_total_allocated]
-#define OFFSET_Capability_weak_ptr_list_hd 1168
+#define OFFSET_Capability_weak_ptr_list_hd 1176
 #define REP_Capability_weak_ptr_list_hd b64
 #define Capability_weak_ptr_list_hd(__ptr__) REP_Capability_weak_ptr_list_hd[__ptr__+OFFSET_Capability_weak_ptr_list_hd]
-#define OFFSET_Capability_weak_ptr_list_tl 1176
+#define OFFSET_Capability_weak_ptr_list_tl 1184
 #define REP_Capability_weak_ptr_list_tl b64
 #define Capability_weak_ptr_list_tl(__ptr__) REP_Capability_weak_ptr_list_tl[__ptr__+OFFSET_Capability_weak_ptr_list_tl]
 #define OFFSET_bdescr_start 0
diff --git a/ghc/ghc-bin.cabal b/ghc/ghc-bin.cabal
--- a/ghc/ghc-bin.cabal
+++ b/ghc/ghc-bin.cabal
@@ -2,7 +2,7 @@
 -- ./configure.  Make sure you are editing ghc-bin.cabal.in, not ghc-bin.cabal.
 
 Name: ghc-bin
-Version: 9.6.1
+Version: 9.6.2
 Copyright: XXX
 -- License: XXX
 -- License-File: XXX
@@ -39,8 +39,8 @@
                    filepath   >= 1   && < 1.5,
                    containers >= 0.5 && < 0.7,
                    transformers >= 0.5 && < 0.7,
-                   ghc-boot      == 9.6.1,
-                   ghc           == 9.6.1
+                   ghc-boot      == 9.6.2,
+                   ghc           == 9.6.2
 
     if os(windows)
         Build-Depends: Win32  >= 2.3 && < 2.14
@@ -58,7 +58,7 @@
         Build-depends:
             deepseq        == 1.4.*,
             ghc-prim       >= 0.5.0 && < 0.11,
-            ghci           == 9.6.1,
+            ghci           == 9.6.2,
             haskeline      == 0.8.*,
             exceptions     == 0.10.*,
             time           >= 1.8 && < 1.13
diff --git a/libraries/ghc-boot-th/ghc-boot-th.cabal b/libraries/ghc-boot-th/ghc-boot-th.cabal
--- a/libraries/ghc-boot-th/ghc-boot-th.cabal
+++ b/libraries/ghc-boot-th/ghc-boot-th.cabal
@@ -3,7 +3,7 @@
 -- ghc-boot-th.cabal.in, not ghc-boot-th.cabal.
 
 name:           ghc-boot-th
-version:        9.6.1
+version:        9.6.2
 license:        BSD3
 license-file:   LICENSE
 category:       GHC
diff --git a/libraries/ghc-boot/GHC/Platform/ArchOS.hs b/libraries/ghc-boot/GHC/Platform/ArchOS.hs
--- a/libraries/ghc-boot/GHC/Platform/ArchOS.hs
+++ b/libraries/ghc-boot/GHC/Platform/ArchOS.hs
@@ -98,6 +98,7 @@
    | OSAIX
    | OSHurd
    | OSWasi
+   | OSGhcjs
    deriving (Read, Show, Eq, Ord)
 
 
@@ -157,3 +158,4 @@
   OSAIX       -> "aix"
   OSHurd      -> "hurd"
   OSWasi      -> "wasi"
+  OSGhcjs     -> "ghcjs"
diff --git a/libraries/ghc-boot/ghc-boot.cabal b/libraries/ghc-boot/ghc-boot.cabal
--- a/libraries/ghc-boot/ghc-boot.cabal
+++ b/libraries/ghc-boot/ghc-boot.cabal
@@ -5,7 +5,7 @@
 -- ghc-boot.cabal.
 
 name:           ghc-boot
-version:        9.6.1
+version:        9.6.2
 license:        BSD-3-Clause
 license-file:   LICENSE
 category:       GHC
@@ -77,7 +77,7 @@
                    directory  >= 1.2 && < 1.4,
                    filepath   >= 1.3 && < 1.5,
                    deepseq    >= 1.4 && < 1.5,
-                   ghc-boot-th == 9.6.1
+                   ghc-boot-th == 9.6.2
     if !os(windows)
         build-depends:
                    unix       >= 2.7 && < 2.9
diff --git a/libraries/ghc-heap/ghc-heap.cabal b/libraries/ghc-heap/ghc-heap.cabal
--- a/libraries/ghc-heap/ghc-heap.cabal
+++ b/libraries/ghc-heap/ghc-heap.cabal
@@ -1,6 +1,6 @@
 cabal-version:  3.0
 name:           ghc-heap
-version:        9.6.1
+version:        9.6.2
 license:        BSD-3-Clause
 license-file:   LICENSE
 maintainer:     libraries@haskell.org
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -465,7 +465,7 @@
 #define MIN_VERSION_ghc_heap(major1,major2,minor) (\
   (major1) <  9 || \
   (major1) == 9 && (major2) <  6 || \
-  (major1) == 9 && (major2) == 6 && (minor) <= 1)
+  (major1) == 9 && (major2) == 6 && (minor) <= 2)
 #endif /* MIN_VERSION_ghc_heap */
 #if MIN_VERSION_ghc_heap(8,11,0)
 instance Binary Heap.StgTSOProfInfo
diff --git a/libraries/ghci/ghci.cabal b/libraries/ghci/ghci.cabal
--- a/libraries/ghci/ghci.cabal
+++ b/libraries/ghci/ghci.cabal
@@ -2,7 +2,7 @@
 -- ../../configure.  Make sure you are editing ghci.cabal.in, not ghci.cabal.
 
 name:           ghci
-version:        9.6.1
+version:        9.6.2
 license:        BSD3
 license-file:   LICENSE
 category:       GHC
@@ -77,8 +77,8 @@
         containers       >= 0.5 && < 0.7,
         deepseq          == 1.4.*,
         filepath         == 1.4.*,
-        ghc-boot         == 9.6.1,
-        ghc-heap         == 9.6.1,
+        ghc-boot         == 9.6.2,
+        ghc-heap         == 9.6.2,
         template-haskell == 2.20.*,
         transformers     >= 0.5 && < 0.7
 
diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal
--- a/libraries/template-haskell/template-haskell.cabal
+++ b/libraries/template-haskell/template-haskell.cabal
@@ -56,7 +56,7 @@
 
     build-depends:
         base        >= 4.11 && < 4.19,
-        ghc-boot-th == 9.6.1,
+        ghc-boot-th == 9.6.2,
         ghc-prim,
         pretty      == 1.1.*