import GHC.Core

 import GHC.Core.FVs

                           mkCastMCo, mkTicks )

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

 import GHC.Core.Coercion

     -- Make bottoming functions interesting

     -- See Note [Bottoming function calls]

     go uds fun [] _ = WUD uds fun

     go uds fun (arg:args) one_shots

 occAnalApp env (Var fun_id, args, ticks)

   = WUD all_uds (mkTicks ticks app')

   where

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

     -- will ultimately be forced.

     !(fun', fun_id')  = lookupBndrSwap env fun_id

     !n_val_args = valArgCount args

     !n_args     = length args

     !int_cxt    = case occ_encl env of

                    _other   | n_val_args > 0 -> IsInteresting

                             | otherwise      -> NotInteresting

 data OccEncl -- See Note [OccEncl]

   = OccRhs         -- RHS of let(rec), albeit perhaps inside a type lambda

   | OccVanilla     -- Everything else

 instance Outputable OccEncl where

   ppr OccRhs     = text "occRhs"

   ppr OccVanilla = text "occVanilla"

 -- See Note [OneShots]

 type OneShots = [OneShotInfo]

 noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env

 setScrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv

   = setNonTailCtxt encl env

   where

      -- 'interesting_alts' is True if the case has at least one

      -- non-default alternative.  That in turn influences

      -- pre/postInlineUnconditionally.  Grep for "occ_int_cxt"!

 -}

 setNonTailCtxt :: OccEncl -> OccEnv -> OccEnv

         , occ_one_shots   = []

         , occ_join_points = zapJoinPointInfo (occ_join_points env) }

 setTailCtxt :: OccEnv -> OccEnv

     -- Preserve occ_one_shots, occ_join points

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

                , lo_tail  :: !TailCallInfo

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

                    -- gives NoTailCallInfo

     | ManyOccL !TailCallInfo

 instance Outputable LocalOcc where

 andUDs = combineUsageDetailsWith andLocalOcc

 orUDs  = combineUsageDetailsWith orLocalOcc

 mkOneOcc !env id int_cxt arity

   | not (isLocalId id)

   = emptyDetails

 orLocalOcc (OneOccL { lo_n_br = nbr1, lo_int_cxt = int_cxt1, lo_tail = tci1 })

            (OneOccL { lo_n_br = nbr2, lo_int_cxt = int_cxt2, lo_tail = tci2 })

   = OneOccL { lo_n_br    = nbr1 + nbr2

             , lo_tail    = tci1 `andTailCallInfo` tci2 }

 orLocalOcc occ1 occ2 = andLocalOcc occ1 occ2

        ; (floats, join_rhs) <- rebuildCall env' (addValArgTo fun (Var arg_bndr) fun_ty) cont

        ; mkDupableStrictBind env' arg_bndr (wrapFloats floats join_rhs) rhs_ty }

   where

     thumbsUpPlanA (StrictArg {})               = False

     thumbsUpPlanA (StrictBind {})              = True

     thumbsUpPlanA (Stop {})                    = True

     thumbsUpPlanA (TickIt _ k)                 = thumbsUpPlanA k

     thumbsUpPlanA (ApplyToVal { sc_cont = k }) = thumbsUpPlanA k

     thumbsUpPlanA (ApplyToTy  { sc_cont = k }) = thumbsUpPlanA k

 mkDupableContWithDmds env dmds

     (ApplyToTy { sc_cont = cont, sc_arg_ty = arg_ty, sc_hole_ty = hole_ty })

     is_demanded = isStrUsedDmd (idDemandInfo bndr)

     occ_info    = idOccInfo old_bndr

     unfolding   = idUnfolding bndr

     uf_opts     = seUnfoldingOpts env

     phase       = sePhase env

     active      = isActive phase (idInlineActivation bndr)

     check_one_occ NotInsideLam NotInteresting n_br = not is_top_lvl && code_dup_ok n_br

     check_one_occ NotInsideLam IsInteresting  n_br = code_dup_ok n_br

     check_one_occ IsInsideLam  NotInteresting _    = False

       -- IsInteresting: inlining inside a lambda only with good reason

       --    See the notes on int_cxt in preInlineUnconditionally

       -- arity>0: do not inline data strutures under lambdas, only functions

         InsideLam(..),

         BranchCount, oneBranch,

         TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,

         isAlwaysTailCalled,

   | OneOcc          { occ_in_lam  :: !InsideLam

                     , occ_n_br    :: {-# UNPACK #-} !BranchCount

                     , occ_tail    :: !TailCallInfo }

                         -- ^ Occurs exactly once (per branch), not inside a rule

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

 -- | Interesting Context

   deriving (Eq)

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

 -- | Inside Lambda

   ppr (OneOcc inside_lam one_branch int_cxt tail_info)

         = text "Once" <> pp_lam inside_lam <> ppr one_branch <> pp_args int_cxt <> pp_tail

         where

 pprShortTailCallInfo :: TailCallInfo -> SDoc

 pprShortTailCallInfo (AlwaysTailCalled ar) = char 'T' <> brackets (int ar)

 convImportLevelSpec :: ImportDeclLevel -> ImportLevel

 convImportLevelSpec ImportDeclQuote = QuoteLevel