-- 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

                           mkCastMCo, mkTicks )

 import GHC.Core.Opt.Arity   ( joinRhsArity, isOneShotBndr )

 import GHC.Core.Coercion

 import GHC.Core.Type

 import GHC.Core.TyCo.FVs    ( tyCoVarsOfMCo )

   = -- 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

     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

         let WUD rhs_usage rhs' = occAnal env rhs

             tagged_bndrs = tagLamBinders rhs_usage bndrs

         in                 -- See Note [Binders in case alternatives]

 occAnal env (Let bind body)

   = occAnalBind env NotTopLevel noImpRuleEdges bind

 occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr]

             -> [OneShots]  -- Very commonly empty, notably prior to dmd anal

   | 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

 combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc)

                         -> UsageDetails -> UsageDetails -> UsageDetails

 combineUsageDetailsWith plus_occ_info

     uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 })

     uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 })

   | isEmptyVarEnv env1 = uds2

   | isEmptyVarEnv env2 = uds1

   | otherwise

 lookupLetOccInfo :: UsageDetails -> Id -> OccInfo

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

 module GHC.Data.Graph.UnVar

     ( UnVarSet

     , emptyUnVarSet, mkUnVarSet, unionUnVarSet, unionUnVarSets

     , UnVarGraph

     , emptyUnVarGraph

     , unionUnVarGraph, unionUnVarGraphs

 elemUnVarSet :: Var -> UnVarSet -> Bool

 elemUnVarSet v (UnVarSet s) = k v `S.member` s

 isEmptyUnVarSet :: UnVarSet -> Bool

 isEmptyUnVarSet (UnVarSet s) = S.null s

 extendUnVarSet :: Var -> UnVarSet -> UnVarSet

 extendUnVarSet v (UnVarSet s) = UnVarSet $ S.insert (k v) s

 extendUnVarSetList :: [Var] -> UnVarSet -> UnVarSet

 extendUnVarSetList vs s = s `unionUnVarSet` mkUnVarSet vs

         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