Note [Join arity prediction based on joinRhsArity]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

   ==> { Contify for join arity 1 }

   join f x = \y -> x + y

   in if b then jump f 1 else jump f 2

   ==> { Contify for join arity 1, eta-expand f }

   join f x = id x

   in if b then jump f 12 else jump f 13

   letrec f x y = if ... then f x else True

   in f 42

 would not happen in a tail context! Contification is invalid here.

 points paper nor GHC does this at the moment.)

 We can capitalise on this observation and conclude that *if* f could become a

 It is also the join arity inside the 'TailUsageDetails' returned by

 'occAnalLamTail', so we can predict join arity without doing any fixed-point

 iteration or really doing any deep traversal of let body or RHS at all.

 All this is quite apparent if you look at the contification transformation in

 Fig. 5 of "Compiling without Continuations" (which does not account for

 eta-expansion at all, mind you). The letrec case looks like this

   letrec f = /\as.\xs. L[us] in L'[es]

     ... and a bunch of conditions establishing that f only occurs

         in app heads of join arity (len as + len xs) inside us and es ...

 for non-recursive functions, this is the definition of contification from the

 paper:

   let f = /\as.\xs.u in L[es]     ... conditions ...

 Note [Join points and unfoldings/rules]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

         -- Now analyse the body, adding the join point

         -- into the environment with addJoinPoint

                                       thing_inside (addJoinPoint env bndr' rhs_uds)

     in

     if isDeadOcc occ     -- Drop dead code; see Note [Dead code]

   -- The normal case, including newly-discovered join points

   -- Analyse the body and /then/ the RHS

   = if isDeadOcc occ   -- Drop dead code; see Note [Dead code]

     then WUD body_uds body

     else let

     rhs_ctxt = mkNonRecRhsCtxt lvl bndr unf

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

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

     -- hence adjust the UDs from the RHS

                                -- here because that is what we are setting!

     WTUD unf_tuds unf' = occAnalUnfolding rhs_env unf

     adj_unf_uds = adjustTailArity (JoinPoint rhs_ja) unf_tuds

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

     --------- IMP-RULES --------

     --------- All rules --------

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

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

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

     rules_w_uds = [ (r,l,adjustTailArity (JoinPoint rhs_ja) rhs_wuds)

 -- See Note [Adjusting right-hand sides]

 occAnalLamTail env expr

   = let !(WUD usage expr') = occ_anal_lam_tail env expr

 occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr

 -- Does not markInsideLam etc for the outmost batch of lambdas

                    -- Combining (AlwaysTailCalled 2) and (AlwaysTailCalled 3)

                    -- gives NoTailCallInfo

               , lo_int_cxt :: !InterestingCxt }

     | ManyOccL !TailCallInfo

 instance Outputable LocalOcc where

   ppr (OneOccL { lo_n_br = n, lo_tail = tci })

 -- | TailUsageDetails captures the result of applying 'occAnalLamTail'

 --   to a function `\xyz.body`. The TailUsageDetails pairs together

 --   * the number of lambdas (including type lambdas: a JoinArity)

 -- If the binding turns out to be a join point with the indicated join

 -- arity, this unadjusted usage details is just what we need; otherwise we

 -- need to discard tail calls. That's what `adjustTailUsage` does.

         | uniq `elemVarEnvByKey` z_tail = NoTailCallInfo

         | otherwise                     = ti

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

 -- See Note [Adjusting right-hand sides]

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

 -- AcyclicSCC case of occAnalRec.

 -- It returns the adjusted rhs UsageDetails combined with the body usage

                 -> UsageDetails

   = -- c.f. occAnal (Lam {})

     markAllInsideLamIf (not one_shot) $

     markAllNonTailIf (not exact_join) $

     uds

   where

     one_shot   = isOneShotFun rhs

 adjustTailArity :: JoinPointHood -> TailUsageDetails -> UsageDetails

 adjustTailArity mb_rhs_ja (TUD ja usage)

 tagRecBinders :: TopLevelFlag           -- At top level?

               -> UsageDetails           -- Of body of let ONLY

               -> [NodeDetails]

                   [IdWithOccInfo]       -- Tagged binders

 -- Substantially more complicated than non-recursive case. Need to adjust RHS

 -- details *before* tagging binders (because the tags depend on the RHSes).

      -- 1. See Note [Join arity prediction based on joinRhsArity]

      --    Determine possible join-point-hood of whole group, by testing for

      unadj_uds = foldr (andUDs . test_manifest_arity) body_uds details_s

      will_be_joins = decideRecJoinPointHood lvl unadj_uds bndrs

      -- 2. Adjust usage details of each RHS, taking into account the

      --    join-point-hood decision

                      -- Matching occAnalLamTail in makeNode

      -- 3. Compute final usage details from adjusted RHS details

      adj_uds = foldr andUDs body_uds rhs_udss'

   | otherwise                  = setIdOccInfo bndr occ_info

 -- | Decide whether some bindings should be made into join points or not, based

 -- Returns `False` if they can't be join points. Note that it's an

 -- assumed to be mutually recursive.

 --

 -- It must, however, be a final decision. If we say `True` for 'f',

                -> InId -> Bool    -- True <=> this is a join point

                -> OutExpr -> SimplM Unfolding

 mkLetUnfolding env top_lvl src id is_join new_rhs

   | otherwise

   = return (mkCoreUnfolding src is_top_lvl new_rhs Nothing guidance)