lintRhs bndr rhs

     | JoinPoint arity <- idJoinPointHood bndr

     = lintJoinLams arity (Just bndr) rhs

     = lintJoinLams arity Nothing rhs

 -- Allow applications of the data constructor @StaticPtr@ at the top

 occAnal env (Tick tickish body)

   = WUD usage' (Tick tickish body')

   where

     usage'

       | tickishCanScopeJoin tickish

     in WUD (markAllNonTail (fun_uds `andUDs` args_uds)) app_out

   where

     !(WUD args_uds app') = occAnalArgs env fun' args []

     !(WUD fun_uds fun')  = occAnal (addAppCtxt env args) fun

         -- The addAppCtxt is a bit cunning.  One iteration of the simplifier

 data OccEnv

   = OccEnv { occ_encl       :: !OccEncl      -- Enclosing context information

            , occ_one_shots  :: !OneShots     -- See Note [OneShots]

            , occ_unf_act    :: Id -> Bool    -- Which Id unfoldings are active

            , occ_rule_act   :: ActivationGhc -> Bool  -- Which rules are active

 initOccEnv :: OccEnv

 initOccEnv

   = OccEnv { occ_encl      = OccVanilla

            , occ_one_shots = []

                  -- To be conservative, we say that all

     -- Preserve occ_one_shots, occ_join points

     -- Do not use OccRhs for the RHS of a join point (which is a tail ctxt):

 mkRhsOccEnv :: OccEnv -> RecFlag -> OccEncl -> JoinPointHood -> Id -> CoreExpr -> OccEnv

 -- See Note [The OccEnv for a right hand side]

 -- For a join point:

   where

     occ = OneOccL { lo_n_br = 1

                   , lo_int_cxt = int_cxt

 -- Add several occurrences, assumed not to be tail calls

 add_many_occ :: Var -> OccInfoEnv -> OccInfoEnv

        , ud_z_tail    = z_tail   `delVarEnvList` bndrs }

 markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail

 markAllMany      ud@(UD { ud_env = env }) = ud { ud_z_many   = env }

 markAllInsideLam ud@(UD { ud_env = env }) = ud { ud_z_in_lam = env }

 markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo

 markAllInsideLamIf  True  ud = markAllInsideLam ud

 markAllInsideLamIf  False ud = ud

   where

     exact_join = mb_join_arity == JoinPoint rhs_ja

                 -> CoreExpr    -- Rhs usage, AFTER occAnalLamTail

                 -> UsageDetails

                 -> UsageDetails

   where

     one_shot   = isOneShotFun rhs

 adjustTailArity mb_rhs_ja (TUD ja usage)

   = markAllNonTailIf (mb_rhs_ja /= JoinPoint ja) usage

 -- Precondition: OccInfo is not IAmDead

 tagNonRecBinder lvl occ bndr

   | okForJoinPoint lvl bndr tail_call_info

   = (setBinderOcc occ bndr,        JoinPoint ar)

   | otherwise

   = (setBinderOcc zapped_occ bndr, NotJoinPoint)

   = False

   where

     valid_join | NotTopLevel <- lvl

                , -- Invariant 1 as applied to LHSes of rules

                  all (ok_rule arity) (idCoreRules bndr)

     lost_join | JoinPoint ja <- idJoinPointHood bndr

               = not valid_join ||

                 (case tail_call_info of  -- Valid join but arity differs

               | otherwise = False

     ok_rule _ BuiltinRule{} = False -- only possible with plugin shenanigans

              , text "tc:" <+> ppr tail_call_info

              , text "rules:" <+> ppr (idCoreRules bndr)

              , case tail_call_info of

                     vcat [ text "ok_unf:" <+> ppr (ok_unfolding arity (realIdUnfolding bndr))

                          , text "ok_type:" <+> ppr (isValidJoinPointType arity (idType bndr)) ]

                  _ -> empty ]

 orLocalOcc occ1 occ2 = andLocalOcc occ1 occ2

 andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo

 andTailCallInfo _ _  = NoTailCallInfo

       , seCaseDepth   :: !Int  -- Depth of multi-branch case alternatives

       , seInlineDepth :: !Int  -- 0 initially, 1 when we inline an already-simplified

                                -- unfolding, and simplify again; and so on

                                -- See Note [Inline depth]

              , seIdSubst     = emptyVarEnv

              , seRecIds      = emptyUnVarSet

              , seCaseDepth   = 0

              , seInlineDepth = 0 }

         -- The top level "enclosing CC" is "SUBSUMED".

                           , pushCoTyArg, pushCoValArg, exprIsDeadEnd

                           , typeArity, arityTypeArity, etaExpandAT )

 import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe )

 import GHC.Core.Rules   ( lookupRule, getRules )

 import GHC.Core.Multiplicity

 import GHC.Types.Basic

 import GHC.Types.Tickish

 import GHC.Types.Var    ( isTyCoVar )

 import GHC.Builtin.Types.Prim( realWorldStatePrimTy )

 import GHC.Builtin.Names( runRWKey, seqHashKey )

 import GHC.Data.FastString

 import GHC.Unit.Module ( moduleName )

 import GHC.Utils.Outputable

   no_floating_past_tick =

     do { let (inc,outc) = splitCont cont

        ; let expr2    = wrapFloats floats expr1

              tickish' = simplTickish env tickish

        ; rebuild env (mkTick tickish' expr2) outc

                      -> InExpr -> SimplCont

                      -> SimplM (SimplFloats, OutExpr)

 simplNonRecJoinPoint env bndr rhs body cont

      do { -- We push join_cont into the join RHS and the body;

           -- and wrap wrap_cont around the whole thing

         ; let mult   = contHoleScaling cont

         ; (floats1, env3)  <- simplJoinBind NonRecursive cont (bndr,env) (bndr2,env2) (rhs,env)

         ; (floats2, body') <- simplExprF env3 body cont

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

 simplRecJoinPoint :: SimplEnv -> [(InId, InExpr)]

                   -> InExpr -> SimplCont

                   -> SimplM (SimplFloats, OutExpr)

 simplRecJoinPoint env pairs body cont

     do { let bndrs  = map fst pairs

              mult   = contHoleScaling cont

              res_ty = contResultType cont

        ; (floats1, env2)  <- simplRecBind env1 (BC_Join Recursive cont) pairs

        ; (floats2, body') <- simplExprF env2 body cont

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

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

              -> (SimplEnv -> SimplCont -> SimplM (SimplFloats, OutExpr))

              -> SimplM (SimplFloats, OutExpr)

 -- Deal with making the continuation duplicable if necessary,

 -- and with the no-case-of-case situation.

   | contIsStop cont        -- Common case; no need for fancy footwork

   = thing_inside env cont

   = do { (floats1, cont')  <- mkDupableCont env cont

        ; (floats2, result) <- thing_inside (env `setInScopeFromF` floats1) cont'

        ; return (floats1 `addFloats` floats2, result) }

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

 trimJoinCont :: Id         -- Used only in error message

 As is evident from the example, there are two components to this behavior:

 We need to be very careful here to remain consistent---neither part is

 optional!

 with mkDupableCont.

 This would be OK in the language of the paper, but not in GHC: j is no longer

 a join point.  We can only do the "push continuation into the RHS of the

 join point j" if we also push the continuation right down to the /jumps/ to

     join x = case <j-rhs> of <outer-alts> in

     case y of

   | isJoinId bndr

   = Just (bndr, rhs)

   , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs

   , let str_sig   = idDmdSig bndr

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

 -- Takes the function we are applying as argument.

 etaExpansionTick :: Id -> GenTickish pass -> Bool

 etaExpansionTick id t

     ( tickishFloatable t || isProfTick t )

 {- Note [exprOkForSpeculation and type classes]

                  hd = getIdFromTrivialExpr_maybe e2

                  -- Determine number of required arguments. See Note [Ticks and mandatory eta expansion]

                  min_arity = case hd of

                    Nothing -> Nothing

           --  ; pprTraceM "cpe_app:stricts:" (ppr v <+> ppr args $$ ppr stricts $$ ppr (idCbvMarks_maybe v))

            ; (app, floats, unsat_ticks) <- rebuild_app env args e2 emptyFloats stricts min_arity

         BranchCount, oneBranch,

         InterestingCxt(..),

         TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,

         EP(..),

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

 data TailCallInfo

   | NoTailCallInfo

   deriving (Eq)

   = case tailCallInfo occ of AlwaysTailCalled{} -> True

                              NoTailCallInfo     -> False

 instance Outputable TailCallInfo where

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

 strongLoopBreaker, weakLoopBreaker :: OccInfo

           pp_tail                = pprShortTailCallInfo tail_info

 pprShortTailCallInfo :: TailCallInfo -> SDoc

 pprShortTailCallInfo NoTailCallInfo        = empty

 {-