--  ; when block_joins

        ; pure r}

   where

       -- TODO Consider whether this is the correct rule. It is consistent with

       -- the simplifier's behaviour - cost-centre-scoped ticks become part of

       -- the continuation, and thus they behave like part of an evaluation

        ; return app_pair}

   where

       --

       --

 lintCoreExpr (Lam var expr)

   = markAllJoinsBad $

              let rhs   = mkLams abs_vars e

                  avoid = in_scope `extendInScopeSetList` captured

              -- Remember this binding under a suitable name

              -- And jump to it from here

            ; return $ mkVarApps (Var v) abs_vars }

 --  * the free variables of the whole joinrec

 --  * any bound variables (captured)

 --  * any exit join points created so far.

 mkExitJoinId in_scope ty join_ty join_arity = do

     fs <- get

     let avoid = in_scope `extendInScopeSetList` (map fst fs)

       asJoinId (mkSysLocal (fsLit "exit") initExitJoinUnique ManyTy ty)

         join_ty join_arity

     -- Pick a suitable name

     let ty = exprType rhs

     fs <- get

     put ((v,rhs):fs)

     return v

     -- returned by of occAnalLamTail. It's totally OK for them to mismatch;

     -- hence adjust the UDs from the RHS

                                 occAnalLamTail rhs_env rhs

     final_bndr_with_rules

       | noBinderSwaps env = bndr -- See Note [Unfoldings and rules]

     -- See Note [Join points and unfoldings/rules]

     unf = idUnfolding bndr

     WTUD unf_tuds unf1 = occAnalUnfolding rhs_env unf

     --------- Rules ---------

     -- See Note [Rules are extra RHSs] and Note [Rule dependency info]

     adj_rule_uds :: [UsageDetails]

     adj_rule_uds = imp_rule_uds ++

                    | (_,l,r) <- rules_w_uds ]

 mkNonRecRhsCtxt :: TopLevelFlag -> Id -> Unfolding -> OccEncl

   = WUD body_uds binds

   | otherwise

   = let (bndr', mb_join) = tagNonRecBinder lvl occ bndr

     in WUD (body_uds `andUDs` rhs_uds')

            (NonRec bndr' rhs' : binds)

   where

     unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness

                                -- here because that is what we are setting!

     WTUD unf_tuds unf' = occAnalUnfolding rhs_env unf

       -- `rhs_ja` is `joinRhsArity rhs` and is the prediction for source MAr

       -- of Note [Join arity prediction based on joinRhsArity]

     -- `rhs_ja` is `joinRhsArity rhs'` and is the prediction for source MAr

     -- of Note [Join arity prediction based on joinRhsArity]

     rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)]

                   | rule <- idCoreRules bndr

                   , let (r,l,rhs_wuds) = occAnalRule rhs_env rule ]

     rules'      = map fstOf3 rules_w_uds

                     _ -> usage1

          -- usage3: see Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration.

     in WUD usage3 (Cast expr' co)

     usage_lam = markAllNonTail (markAllInsideLam usage)

 occAnal env (Cast expr co)

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

         usage1 = addManyOccs usage (coVarsOfCo co)

             -- usage1: see Note [Gather occurrences of coercion variables]

             -- usage2: see Note [Quasi join points]

     in WUD usage2 (Cast expr' co)

   = occAnalApp env (collectArgsTicks tickishFloatable app)

 occAnal env expr@(Lam {})

     occAnalLamTail env expr

 occAnal env (Case scrut bndr ty alts)

   --     This caused #18296

   | fun `hasKey` runRWKey

   , [t1, t2, arg]  <- args

   = let app_out = mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']

     in WUD usage app_out

         , lo_tail =

             AlwaysTailCalled

               { tailCallArity = arity

                  -- Updated by occurrence analysis.

                  --

                  -- See Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration.

     Just MarkNonTail -> NoTailCallInfo

     -- See Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration.

     Nothing -> tail_info0

 -------------------

 -- See Note [Adjusting right-hand sides]

                 -> WithTailUsageDetails CoreExpr

                 -> WithUsageDetails CoreExpr

 -- ^ This function concentrates shared logic between occAnalNonRecBind and the

   where

     exact_join =

       case mb_join_arity of

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

                 -> CoreExpr    -- Rhs usage, AFTER occAnalLamTail

   where

     one_shot   = isOneShotFun rhs

 adjustTailArity mb_rhs_ja (TUD ja usage) = markAllNonTailIf not_same_arity usage

   where

     not_same_arity = case mb_rhs_ja of

 type IdWithOccInfo = Id

 -- Precondition: OccInfo is not IAmDead

 tagNonRecBinder lvl occ bndr

   | okForJoinPoint lvl bndr tail_call_info

   | otherwise

   = (setBinderOcc zapped_occ bndr, NotJoinPoint)

  where

 andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo

 andTailCallInfo (AlwaysTailCalled arity1 true1) (AlwaysTailCalled arity2 true2)

 andTailCallInfo _ _  = NoTailCallInfo

     dest_is_top = isTopLvl dest_lvl

     transfer_join_info bndr new_bndr

       | JoinPoint

         , joinPointArity = join_arity }

           <- idJoinPointHood bndr

       , not dest_is_top

       = asJoinId new_bndr

           join_ty

           ( join_arity + length abs_vars )

     where

       pp_mj = case mj of

                 NotJoinPoint -> empty

   ppr (ContEx _tv _cv _id e) = vcat [text "ContEx" <+> ppr e {-,

                                 ppr (filter_env tv), ppr (filter_env id) -}]

         ; return (floats1 `addFloats` floats2, body') }

   where

     do_case_case

       = seCaseCase env

       | otherwise

       = False

        ; return (floats1 `addFloats` floats2, body') }

   where

     do_case_case =

       then seCaseCase env

       else False

 trimJoinCont _ NotJoinPoint cont

   = cont -- Not a jump

   where

     trim 0 cont@(Stop {})

       = cont

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

   1. under casts (see #26422)

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

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

      'simplNonRecJoinPoint' or 'simplRecJoinPoint'), we retrieve the information

      of whether this is a true join point or a quasi join point using

      If we are dealing with a quasi join point, we switch off the case-of-case

      transformation.

 import GHC.Types.Var       ( Var, isId, mkLocalVar )

 import GHC.Types.Name      ( mkSystemVarName )

 import GHC.Types.Id        ( Id, mkSysLocalOrCoVarM )

 import GHC.Core.Type       ( Type, Mult )

 import GHC.Core.Opt.Stats

 import GHC.Core.Rules

 import GHC.Types.Error (DiagnosticReason(..))

 import GHC.Types.Literal ( litIsLifted )

 import GHC.Types.Id

 import GHC.Types.Id.Make ( voidArgId, voidPrimId )

 import GHC.Types.Var.Env

 import GHC.Types.Var.Set

               spec_id_ty = mkLamTypes spec_lam_args spec_body_ty

               spec_arity = count isId spec_lam_args

               spec_join_arity

                 | otherwise

                 = NotJoinPoint

               spec_id    = setCbvCandidate $

       -- inl_rule:   it does not make sense for workers to be constructorlike.

     work_join_arity

       -- worker is join point iff wrapper is join point

       -- (see Note [Don't w/w join points for CPR])

     sep [hang (keyword bind <+> char '{') 2 (ppr_bind noAnn bind <+> text "} in"),

          pprCoreExpr expr]

   where

 ppr_expr add_par (Tick tickish expr)

   = sdocOption sdocSuppressTicks $ \case

 import GHC.Types.Literal

 import GHC.Types.Id

 import GHC.Types.InlinePragma ( isAlwaysActive )

 import GHC.Types.Var      ( isNonCoVarId )

 import GHC.Types.Var.Set

   | AlwaysTailCalled

     { tailCallArity = join_arity

       <- tailCallInfo (idOccInfo bndr)

   , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs

   , let str_sig   = idDmdSig bndr

         str_arity = count isId bndrs  -- Strictness demands are for Ids only

         join_bndr =

           (asJoinId bndr join_ty join_arity)

             `setIdDmdSig` etaConvertDmdSig str_arity str_sig

         exprIsTickedString, exprIsTickedString_maybe,

         exprIsTopLevelBindable,

         exprIsUnaryClassFun, isUnaryClassId,

         cantEtaReduceFun,

         -- * Equality

       -- we behave conservatively here -- I don't think it's important

       -- enough to deserve special treatment

 --

 -- See Note [Ticks and mandatory eta expansion]

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

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

             -- floating the tick which isn't optimal for perf. But this only makes

             -- a difference if we have a non-floatable tick which is somewhat rare.

             | Var vh <- head

             = (head,as')

             where

               (head,as') = go fun (AITick tickish : as)

         ConTag, ConTagZ, fIRST_TAG,

         Arity, VisArity, RepArity, JoinArity, FullArgCount,

         Alignment, mkAlignment, alignmentOf, alignmentBytes,

         BranchCount, oneBranch,

         InterestingCxt(..),

         TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,

         EP(..),

 -----------------

 -- | See Note [TailCallInfo]

 data TailCallInfo

   = AlwaysTailCalled

      }

   | NoTailCallInfo

   deriving (Eq)

 -- If so, is it a true join point or a quasi join point?

 --

 -- See Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration.

   case tailCallInfo occ of

     NoTailCallInfo -> Nothing

 instance Outputable TailCallInfo where

   ppr NoTailCallInfo = text "NoTailCallInfo"

 -----------------

           pp_tail                = pprShortTailCallInfo tail_info

 pprShortTailCallInfo :: TailCallInfo -> SDoc

              <> brackets (int ar)

 pprShortTailCallInfo NoTailCallInfo        = empty

 isJoinId :: Var -> Bool

 isJoinId = isJust . joinId_maybe

 -- It is convenient in GHC.Core.Opt.SetLevels.lvlMFE to apply isJoinId

 -- to the free vars of an expression, so it's convenient

 -- if it returns False for type variables

 idJoinPointHood id

  | isId id

  = case Var.idDetails id of

  | otherwise = NotJoinPoint

 idDataCon :: Id -> DataCon

     JoinPoint { joinPointArity = ar } -> ar

     NotJoinPoint -> pprPanic "idJoinArity" (ppr id)

 asJoinId id ty arity

   = warnPprTrace (not (isLocalId id))

       "global id being marked as join var"  (ppr id) $

 asJoinId_maybe :: Id -> JoinPointHood -> Id

 asJoinId_maybe id = \case

   NotJoinPoint -> zapJoinId id

 {-

 ************************************************************************

         TailCallInfo(..),

         tailCallInfo, isAlwaysTailCalled,

         -- ** The RuleInfo type

         RuleInfo(..),

                -- This only covers /un-lifted/ coercions, of type

                -- (t1 ~# t2) or (t1 ~R# t2), not their lifted variants

   | JoinId

       , joinIdArity :: JoinArity

       , joinIdCbvMarks :: Maybe [CbvMark]

       }

         -- The [CbvMark] is always empty (and ignored) until after Tidy for ids from the current

         -- module.

 data RecSelInfo

   = RSI { rsi_def   :: [ConLike]   -- Record selector defined for these

         , rsi_undef :: [ConLike]   -- Record selector not defined for these

 isCoVarDetails CoVarId = True

 isCoVarDetails _       = False

 isJoinIdDetails_maybe (JoinId ty join_arity marks) = Just (ty, join_arity, marks)

 isJoinIdDetails_maybe _                            = Nothing

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

 tickishCanScopeJoin :: GenTickish pass -> Bool

 tickishCanScopeJoin tick = case tick of

   HpcTick{} -> False

   Breakpoint{} -> False

   SourceNote{} -> True

 import GHC.Types.SrcLoc

 import GHC.Types.Unique

 import qualified GHC.Data.Strict as Strict

 import GHCi.FFI

 import GHCi.Message

     get bh = do r <- get bh

                 return $ fromRational r

 instance Binary JoinPointHood where

     put_ bh NotJoinPoint = putByte bh 0

     put_ bh (JoinPoint t ar) = do

 module GHC.Utils.Outputable (

         -- * Type classes

         Outputable(..), OutputableBndr(..), OutputableP(..),

         IsOutput(..), IsLine(..), IsDoc(..),

         HLine, HDoc,

 import Data.List (intersperse)

 import Data.List.NonEmpty (NonEmpty (..))

 import Data.Semigroup (Arg(..))

 import qualified Data.List.NonEmpty as NEL

 import Data.Time ( UTCTime )

 import Data.Time.Format.ISO8601

     | LetBind     -- ^ The x in   (let x = rhs in e)

     deriving Eq

 data JoinPointHood

   = JoinPoint

         -- ^ The JoinArity (but an Int here because synonym JoinArity is defined in Types.Basic)

       }

   | NotJoinPoint

 isJoinPoint NotJoinPoint   = False

 instance Outputable JoinPointHood where

 instance NFData JoinPointHood where

   rnf x = x `seq` ()