+    | AlwaysTailCalled { tailCallArity = arity } <- tailCallInfo (idOccInfo bndr)

+       ; expr_l <- lintCoreExpr expr

+       ; r <- markAllJoinsBadIf block_joins $ pure expr_l

+      --  ; when block_joins

+       ; pure r}

+    block_joins = not (tickishCanScopeJoin tickish)

+of `AlwaysTailCalled { tailCallArity = n }` indicates that every occurrence of

+the variable is a tail call with `n` arguments (counting both value and type

+arguments). Otherwise 'occ_tail' will be 'NoTailCallInfo'. The tail call info

+flows bottom-up with the rest of 'OccInfo' until it goes on the binder.

+    WUD usage body' = occAnal env' body

+

+    env' = case tickish of

+      -- setInsideProfTick: join points under profiling ticks turn

+      -- into quasi-join points. See Note [Quasi join points]

+      ProfNote {} -> setInsideProfTick env

+      _           -> env

+      | tickishCanScopeJoin tickish

+               -- Similarly for cost centres. (#26157)

+

+  = let (WUD usage expr') = occAnal (setInsideCast env) expr

+          -- setInsideCast: join points inside casts turn into quasi join points

+          -- See Note [Quasi join points]

+        usage1 = addManyOccs usage (coVarsOfCo co)

+            -- usage2: see Note [Gather occurrences of coercion variables]

+        usage2 = markAllNonTail usage1

+           , occ_prof_ticks :: !Int -- ^ How many profiling ticks are we under? See Note [Quasi join points]

+           , occ_casts      :: !Int -- ^ How many casts are we under? See Note [Quasi join points]

+           , occ_prof_ticks = 0

+           , occ_casts      = 0

+setInsideProfTick :: OccEnv -> OccEnv

+setInsideProfTick !env = env { occ_prof_ticks = 1 + occ_prof_ticks env }

+

+setInsideCast :: OccEnv -> OccEnv

+setInsideCast !env = env { occ_casts = 1 + occ_casts env }

+

+                   -- NB: combining 'TailCallInfo's with different arities

+    occ =

+      OneOccL

+        { lo_n_br = 1

+        , lo_int_cxt = int_cxt

+        , lo_tail =

+            AlwaysTailCalled

+              { tailCallArity = arity

+

+                -- See Note [Quasi join points] for justification of these

+                -- two fields.

+              , tailCallUnderProfTicks = occ_prof_ticks env

+              , tailCallUnderCasts     = occ_casts env

+              }

+        }

+  :: HasDebugCallStack => UsageDetails -> UsageDetails

+markAllNonTail ud@(UD { ud_env = env }) = ud { ud_z_tail   = env }

+

+markAllInsideLamIf, markAllNonTailIf :: HasDebugCallStack => Bool -> UsageDetails -> UsageDetails

+adjustTailUsage :: HasDebugCallStack => Bool        -- True <=> Exactly-matching join point; don't do markNonTail

+adjustTailArity :: HasDebugCallStack => JoinPointHood -> TailUsageDetails -> UsageDetails

+  , AlwaysTailCalled { tailCallArity = ar } <- tail_call_info

+               , AlwaysTailCalled { tailCallArity = arity } <- tail_call_info

+                (case tail_call_info of -- Valid join but arity differs

+                   AlwaysTailCalled { tailCallArity = ja' } -> ja /= ja'

+                   _ -> False)

+                 AlwaysTailCalled { tailCallArity = arity } ->

+andTailCallInfo (AlwaysTailCalled arity1 p1 c1) (AlwaysTailCalled arity2 p2 c2)

+  | arity1 == arity2 = AlwaysTailCalled arity1 (max p1 p2) (max c1 c2)

+      , seProfTicks   :: !Int  -- Current depth of profiling ticks; see Note [Quasi join points]

+      , seCasts       :: !Int  -- Current depth of casts; see Note [Quasi join points]

+

+             , seProfTicks   = 0

+             , seCasts       = 0

+import GHC.Core.FVs     ( mkRuleInfo )

+

+             env' = case tickish of

+                  ProfNote {} -> env { seProfTicks = seProfTicks env + 1 }

+                  _ -> env

+       ; (floats, expr1) <- simplExprF env' expr inc

+-- | Number of casts we are adding around an expression as we process a 'Cast'.

+--

+-- We need the cast depth to implement the logic of Note [Quasi join points].

+type NbCastsAdded = Int

+

+        ; (cont1, nbAddedCasts) <- {-#SCC "simplCast-addCoerce" #-}

+            if isReflCo co1

+            then return (cont0, 0) -- See Note [Optimising reflexivity]

+            else addCoerce co1 True cont0

+                 -- True <=> co1 is optimised

+

+          -- Keep track of how many casts we have added, because we need this

+          -- information for Note [Quasi join points].

+        ; let env' = env { seCasts = seCasts env + nbAddedCasts }

+        ; {-#SCC "simplCast-simplExprF" #-} simplExprF env' body cont1 }

+        addCoerceM :: MOutCoercion -> Bool -> SimplCont -> SimplM (SimplCont, NbCastsAdded)

+        addCoerceM MRefl    _   cont = return (cont, 0)

+        addCoerce :: OutCoercion -> Bool -> SimplCont -> SimplM (SimplCont, NbCastsAdded)

+          = do { (cont', nbCastsAdded) <- addCoerce (mkTransCo co1 co2) False cont

+                                -- False: (mkTransCo co1 co2) is not fully optimised

+                                -- See Note [Avoid re-simplifying coercions]

+               ; return (cont', nbCastsAdded - 1)

+                  -- -1: the coercion coalesced with an existing coercion.

+               }

+            do { (tail', nbCastsAdded) <- addCoerceM m_co' co_is_opt tail

+               ; return ( ApplyToTy { sc_arg_ty  = arg_ty'

+                                    , sc_cont    = tail'

+                                    , sc_hole_ty = coercionLKind co }

+                                      -- NB!  As the cast goes past, the

+                                      -- type of the hole changes (#16312)

+                        , nbCastsAdded )

+               }

+

+            do { (tail', nbCastsAdded) <- addCoerceM m_co2 co_is_opt tail

+                   MRefl -> return

+                     ( cont { sc_cont = tail'

+                            , sc_hole_ty = coercionLKind co }

+                     , nbCastsAdded ) ;

+               ; return

+                   ( ApplyToVal { sc_arg  = mkCast arg' co1

+                                , sc_env  = arg_se'

+                                , sc_dup  = dup'

+                                , sc_cont = tail'

+                                , sc_hole_ty = coercionLKind co }

+                   , nbCastsAdded ) } } }

+          | isReflCo co = return (cont, 0 :: NbCastsAdded )

+            -- Having this at the end makes a huge

+            -- difference in T12227, for some reason

+            -- See Note [Optimising reflexivity]

+          | otherwise =

+            return

+              ( CastIt { sc_co = co, sc_opt = co_is_opt, sc_cont = cont }

+              , 1 :: NbCastsAdded )

+   = assert (isJoinId bndr) $

+     wrapJoinCont do_case_case env cont $ \ env cont ->

+  where

+    do_case_case =

+      if isTrueJoinPoint env bndr

+      then seCaseCase env

+      else False

+  = wrapJoinCont do_case_case env cont $ \ env cont ->

+  where

+    do_case_case =

+      if all (isTrueJoinPoint env . fst) pairs

+      then seCaseCase env

+      else False

+

+-- | Is this a true join point, or only a quasi join point?

+--

+-- See Note [Quasi join points]

+isTrueJoinPoint :: SimplEnv -> InId -> Bool

+isTrueJoinPoint env id

+  | Just occMaxProfTicks <- occursUnderProfTicks (idOccInfo id)

+  , occMaxProfTicks > seProfTicks env

+  -- The join point occurs under more profiling ticks that its binding.

+  = False

+  | Just occMaxCasts <- occursUnderCasts (idOccInfo id)

+  , occMaxCasts > seCasts env

+  -- The join point occurs under more casts than its binding.

+  = False

+  | otherwise

+  = True

+wrapJoinCont :: Bool

+             -> SimplEnv -> SimplCont

+wrapJoinCont do_case_case env cont thing_inside

+  | do_case_case

+    -- Normal situation: do the "case-of-case" transformation.

+    -- See Note [Join points and case-of-case].

+  | otherwise

+    -- No "case-of-case" transformation.

+    -- See Note [Join points with -fno-case-of-case].

+  = do { (floats1, expr1) <- thing_inside env (mkBoringStop (contHoleType cont))

+       ; let (floats2, expr2) = wrapJoinFloatsX floats1 expr1

+       ; (floats3, expr3) <- rebuild (env `setInScopeFromF` floats2) expr2 cont

+       ; return (floats2 `addFloats` floats3, expr3) }

+  (wrapJoinCont) When entering the RHS of a join point, copy the context inside.

+  (trimJoinCont) When a join point is invoked, discard the outer context.

+We need to make the continuation E duplicable (since we are duplicating it)

+Note that not all join points support this transformation:

+see Note [Quasi join points].

+

+j, so that it can evaporate there (trimJoinCont). Then, if we are doing

+case-of-case, we'll get to

+Note [Quasi join points]

+~~~~~~~~~~~~~~~~~~~~~~~~

+We currently classify join points into two separate categories

+

+  - true join points

+  - quasi join points

+

+Definition:

+  A join point binding defines a *quasi* join point if any of the join point

+  binders occur under profiling ticks or casts.

+

+  If a join point binding is not a quasi join point, it is a *true* join point.

+

+We can push continuations into true join points, as described in

+Note [Join points and case-of-case]:

+

+  K[ join j = rhs in body ]  -->   join j = K[ rhs ] in K[ body ]

+

+This transformation is not valid if the occurrences of 'j' in 'body' appear:

+

+  1. under casts, see #26422

+  2. under profiling ticks, see #26693 #26157 #26642

+

+For example, consider (a minimisation of) the program in #26693:

+

+  join { j :: Bool -> IO (); j _ = guts }

+  in case pass of

+    False -> scctick<foo> jump j True

+    True  ->              jump j False

+

+Let's try to push the application to an argument 'arg' into this expression.

+As per Note [Join points and case-of-case], we proceed by first applying the

+argument to both the join point RHS and the case alternatives:

+

+  join { j :: Bool -> IO (); j _ = guts arg ] }

+    in case pass of

+      False -> (scctick<foo> jump j True) arg

+      True  ->               jump j False arg

+

+Then we rely on 'trimJoinCont' to remove the argument. In this case, this fails

+for the first branch, because 'trimJoinCont' doesn't look through profiling

+ticks. Were we to address this, it's still not clear what code we would want to

+end up with, as we don't want to misattribute profiling costs.

+We could plausibly transform to the following:

+

+  join { j :: Bool -> IO (); j scc_or_null _ = (setSCC# scc_or_null guts) arg ] }

+    in case pass of

+      False -> jump j <foo> True

+      True  -> jump j null  False

+

+where `setSCC#` is a new primop that would set the current cost centre pointer

+(or no-op if the given pointer is null).

+However:

+  - this primop doesn't exist today,

+  - it requires adding an argument to the join point (hence changing its arity)

+So instead, for now, we simply disallow the case-of-case transformation for 'j'.

+

+Similarly for casts:

+

+    join { j = blah }

+      in case e of

+        False -> j True  |> co1

+        True  -> j False |> co2

+

+if we want to apply this to an argument 'arg', we would need to perform the

+following transformation:

+

+    join { j co = ( blah |> co ) arg }

+      in case e of

+        False -> j co1 True

+        True  -> j co2 False

+

+in which we add a coercion argument to the join point. Again, this is not a

+transformation we currently implement, so we instead prevent case-of-case for

+such join points.

+

+To figure out whether a join point is a true join point or a quasi join point,

+we proceed as follows:

+

+  1. In occurrence analysis, we compute how many profiling ticks/casts each

+     join point Id occurs under.

+

+     This is stored in the 'tailCallUnderProfTicks' and 'tailCallUnderCasts'

+     fields of 'TailCallInfo', and populated by keeping track of how many

+     profiling ticks and casts we are under when doing occurrence analysis

+     (see 'occ_prof_ticks' and 'occ_casts').

+

+  2. In the simplifier, we keep track of how many profiling ticks/casts we are

+     currently inside.  See 'seProfTicks' and 'seCasts', which are updated

+     in 'simplTick' and 'simplCast', respectively.

+

+  3. In the simplifier, when we come across a join point binding (in either

+     'simplNonRecJoinPoint' or 'simplRecJoinPoint'), we compare the current

+     cast depth/profiling tick depth with the cast depth/profiling tick depth

+     of the occurrences of the join point binders.

+

+     If a join point binder occurs under more profiling ticks/casts than its

+     binding site, then it is a quasi join point and we switch off the

+     case-of-case transformation.

+  | AlwaysTailCalled { tailCallArity = join_arity } <- tailCallInfo (idOccInfo bndr)

+        cantEtaReduceFun,

+  = ( cantEtaReduceFun id ) &&

+-- | Can we eta-reduce the given function?

+-- See Note [Eta reduction soundness], criteria (B), (J), and (W).

+cantEtaReduceFun :: Id -> Bool

+cantEtaReduceFun fun

+  =    hasNoBinding fun -- (B)

+       -- Don't undersaturate functions with no binding.

+

+    || isJoinId fun    -- (J)

+       -- Don't undersaturate join points.

+       -- See Note [Invariants on join points] in GHC.Core, and #20599

+

+    || isJust (idCbvMarks_maybe fun) -- (W)

+       -- Don't undersaturate StrictWorkerIds.

+       -- See Note [CBV Function Ids] in GHC.Types.Id.Info.

+

+                   Just v_hd ->

+                     if cantEtaReduceFun v_hd

+                     then Just $! idArity v_hd

+                     else Nothing

+        isAlwaysTailCalled, occursUnderProfTicks, occursUnderCasts,

+

+-- | See Note [TailCallInfo]

+  = AlwaysTailCalled

+     { tailCallArity :: {-# UNPACK #-} !JoinArity

+     , tailCallUnderProfTicks :: !Int -- See Note [Quasi join points]

+     , tailCallUnderCasts     :: !Int -- See Note [Quasi join points]

+     }

+-- | If this 'Id' is always tail called, how many profiling ticks does

+-- it occur under? See Note [Quasi join points].

+occursUnderProfTicks :: OccInfo -> Maybe Int

+occursUnderProfTicks occ =

+  case tailCallInfo occ of

+    AlwaysTailCalled { tailCallUnderProfTicks = nb } -> Just nb

+    NoTailCallInfo -> Nothing

+

+-- | If this 'Id' is always tail called, how many casts does

+-- it occur under? See Note [Quasi join points].

+occursUnderCasts :: OccInfo -> Maybe Int

+occursUnderCasts occ =

+  case tailCallInfo occ of

+    AlwaysTailCalled { tailCallUnderCasts = nb } -> Just nb

+    NoTailCallInfo -> Nothing

+

+  ppr (AlwaysTailCalled ar p c) =

+    sep [ text "Tail", brackets (int p <> comma <> int c), int ar ]

+  ppr NoTailCallInfo = text "NoTailCallInfo"

+pprShortTailCallInfo (AlwaysTailCalled ar p c)

+  = char 'T' <> (brackets (text "P" <+> int p))

+             <> (brackets (text "C" <+> int c))

+             <> brackets (int ar)

+We also store how many profiling ticks and casts the join point occurs under.

+The rationale is described in Note [Quasi join points].

+

+  tickishCanScopeJoin,

+-- | Is @join f x in <tick> jump f x@ valid?

+tickishCanScopeJoin :: GenTickish pass -> Bool

+tickishCanScopeJoin tick = case tick of

+  ProfNote{} -> True

+  HpcTick{} -> False

+  Breakpoint{} -> False

+  SourceNote{} -> True

+