-- many /other/ arguments the function has.  Inconsistent unboxing is very

 -- bad for performance, so I increased the limit to allow it to unbox

 -- consistently.

 {-

 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998

   -> ([CoreBind] -> r -> r)          -- How to combine the scope with new binds

   -> WithUsageDetails r              -- Of the whole let(rec)

 occAnalBind env lvl ire (Rec pairs) thing_inside combine

   = addInScopeList env (map fst pairs) $ \env ->

     let WUD body_uds body'  = thing_inside env

   = -- Analyse the RHS and /then/ the body

     let -- Analyse the rhs first, generating rhs_uds

         !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env lvl ire mb_join bndr rhs

                                            -- Note [Occurrence analysis for join points]

         -- Now analyse the body, adding the join point

     -- Match join arity O from mb_join_arity with manifest join arity M as

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

     -- hence adjust the UDs from the RHS

     WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join $

                                 occAnalLamTail rhs_env rhs

     final_bndr_with_rules

    was a loop breaker last time round

 Hence the is_lb field of NodeScore

 -}

 {- *********************************************************************

     go env rev_bndrs body

       = addInScope env rev_bndrs $ \env ->

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

         in WUD (usage `addLamCoVarOccs` rev_bndrs)

                (foldl' wrap_lam body' rev_bndrs)

            let alt_env = addBndrSwap scrut' bndr $

                          setTailCtxt env  -- Kill off OccRhs

                WUD alts_usage alts' = do_alts alt_env alts

            in WUD alts_usage (tagged_bndr, alts')

       total_usage = markAllNonTail scrut_usage `andUDs` alts_usage

     do_alt !env (Alt con bndrs rhs)

       = addInScopeList env bndrs $ \ env ->

         let WUD rhs_usage rhs' = occAnal env rhs

         in                 -- See Note [Binders in case alternatives]

         WUD rhs_usage (Alt con tagged_bndrs rhs')

 occAnal env (Let bind body)

   = occAnalBind env NotTopLevel noImpRuleEdges bind

                 (\env -> occAnal env body) mkLets

   | fun `hasKey` runRWKey

   , [t1, t2, arg]  <- args

   , WUD usage arg' <- adjustNonRecRhs (JoinPoint 1) $ occAnalLamTail env arg

 occAnalApp env (Var fun_id, args, ticks)

   where

     -- Lots of banged bindings: this is a very heavily bit of code,

     -- so it pays not to make lots of thunks here, all of which

         -- See Note [Sources of one-shot information], bullet point A']

 occAnalApp env (fun, args, ticks)

   where

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

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

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

 -- UsageDetails API

 andUDs = combineUsageDetailsWith andLocalOcc

 orUDs  = combineUsageDetailsWith orLocalOcc

   | isEmptyVarEnv env1 = uds2

   | isEmptyVarEnv env2 = uds1

   | otherwise

        , ud_z_in_lam  = plusVarEnv z_in_lam1 z_in_lam2

 lookupLetOccInfo :: UsageDetails -> Id -> OccInfo

 -- Don't use locally-generated occ_info for exported (visible-elsewhere)

               -> [Id]                -- Binders

               -> [IdWithOccInfo]     -- Tagged binders

 tagLamBinders usage binders

 tagLamBinder :: UsageDetails       -- Of scope

              -> Id                 -- Binder

 -- No-op on TyVars

 -- A lambda binder never has an unfolding, so no need to look for that

 tagLamBinder usage bndr

   = setBinderOcc (markNonTail occ) bndr

       -- markNonTail: don't try to make an argument into a join point

   where

         delListFromUFM,

         delListFromUFM_Directly,

         plusUFM,

         plusUFM_C,

         plusUFM_CD,

         plusUFM_CD2,

         mergeUFM,

 delFromUFM_Directly :: UniqFM key elt -> Unique -> UniqFM key elt

 delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)

 plusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt

 plusUFM (UFM x) (UFM y) = UFM (M.union y x)

      -- Note (M.union y x), with arguments flipped

      -- M.union is left-biased, plusUFM should be right-biased.

 plusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt

 plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)

 -- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the

 -- combinding function and `d1` resp. `d2` as the default value if

 -- there is no entry in `m1` reps. `m2`. The domain is the union of

         elemVarEnv, disjointVarEnv, anyVarEnv,

         extendVarEnv, extendVarEnv_C, extendVarEnv_Acc,

         extendVarEnvList,

         plusVarEnvList, alterVarEnv,

         delVarEnvList, delVarEnv,

         minusVarEnv,

 extendVarEnv_C    :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a

 extendVarEnv_Acc  :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b

 plusVarEnv        :: VarEnv a -> VarEnv a -> VarEnv a

 plusVarEnvList    :: [VarEnv a] -> VarEnv a

 extendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a

 varEnvDomain      :: VarEnv elt -> UnVarSet

 delVarEnv         :: VarEnv a -> Var -> VarEnv a

 minusVarEnv       :: VarEnv a -> VarEnv b -> VarEnv a

 plusVarEnv_C      :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a

 plusVarEnv_CD     :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a

 plusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a

 mapVarEnv         :: (a -> b) -> VarEnv a -> VarEnv b

 extendVarEnv_Acc = addToUFM_Acc

 extendVarEnvList = addListToUFM

 plusVarEnv_C     = plusUFM_C

 plusVarEnv_CD    = plusUFM_CD

 plusMaybeVarEnv_C = plusMaybeUFM_C

 delVarEnvList    = delListFromUFM

 delVarEnv        = delFromUFM

 minusVarEnv      = minusUFM

 plusVarEnv       = plusUFM

 plusVarEnvList   = plusUFMList

 -- lookupVarEnv is very hot (in part due to being called by substTyVar),

 -- if it's not inlined than the mere allocation of the Just constructor causes