    {-
    (c) The University of Glasgow 2006
    (c) The AQUA Project, Glasgow University, 1996-1998

    This module contains "tidying" code for *nested* expressions, bindings, rules.
    The code for *top-level* bindings is in GHC.Iface.Tidy.
    -}

    module GHC.Core.Tidy (
            tidyExpr, tidyRules, tidyCbvInfoTop, tidyBndrs
        ) where

    import GHC.Prelude

    import GHC.Core
    import GHC.Core.Type

    import GHC.Core.Seq ( seqUnfolding )
    import GHC.Types.Id
    import GHC.Types.Id.Info
    import GHC.Types.Demand ( zapDmdEnvSig, isStrUsedDmd )
    import GHC.Core.Coercion ( tidyCo )
    import GHC.Types.Var
    import GHC.Types.Var.Env
    import GHC.Types.Unique (getUnique)
    import GHC.Types.Unique.FM
    import GHC.Types.Name hiding (tidyNameOcc)
    import GHC.Types.Name.Set
    import GHC.Types.SrcLoc
    import GHC.Types.Tickish
    import GHC.Data.Maybe
    import GHC.Utils.Misc
    import Data.List (mapAccumL)
    import GHC.Utils.Outputable
    import GHC.Types.RepType (typePrimRep)
    import GHC.Utils.Panic
    import GHC.Types.Basic (isMarkedCbv, CbvMark (..))
    import GHC.Core.Utils (shouldUseCbvForId)

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Tidying expressions, rules}
    *                                                                      *
    ************************************************************************
    -}

    tidyBind :: TidyEnv
             -> CoreBind
             ->  (TidyEnv, CoreBind)

    tidyBind :: TidyEnv -> CoreBind -> (TidyEnv, CoreBind)
    tidyBind TidyEnv
    env (NonRec Id
    bndr Expr Id
    rhs)
      = -- pprTrace "tidyBindNonRec" (ppr bndr) $
        let cbv_bndr :: Id
    cbv_bndr = (HasDebugCallStack => Id -> Expr Id -> Id
    Id -> Expr Id -> Id
    tidyCbvInfoLocal Id
    bndr Expr Id
    rhs)
            (TidyEnv
    env', Id
    bndr') = TidyEnv -> TidyEnv -> Id -> (TidyEnv, Id)
    tidyLetBndr TidyEnv
    env TidyEnv
    env Id
    cbv_bndr
            tidy_rhs :: Expr Id
    tidy_rhs = (TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env' Expr Id
    rhs)
        in (TidyEnv
    env', Id -> Expr Id -> CoreBind
    forall b. b -> Expr b -> Bind b
    NonRec Id
    bndr' Expr Id
    tidy_rhs)

    tidyBind TidyEnv
    env (Rec [(Id, Expr Id)]
    prs)
      = -- pprTrace "tidyBindRec" (ppr $ map fst prs) $
        let
           cbv_bndrs :: [Id]
    cbv_bndrs = ((Id, Expr Id) -> Id) -> [(Id, Expr Id)] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map ((\(Id
    bnd,Expr Id
    rhs) -> HasDebugCallStack => Id -> Expr Id -> Id
    Id -> Expr Id -> Id
    tidyCbvInfoLocal Id
    bnd Expr Id
    rhs)) [(Id, Expr Id)]
    prs
           ([Id]
    _bndrs, [Expr Id]
    rhss)  = [(Id, Expr Id)] -> ([Id], [Expr Id])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Id, Expr Id)]
    prs
           (TidyEnv
    env', [Id]
    bndrs') = (TidyEnv -> Id -> (TidyEnv, Id))
    -> TidyEnv -> [Id] -> (TidyEnv, [Id])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL (TidyEnv -> TidyEnv -> Id -> (TidyEnv, Id)
    tidyLetBndr TidyEnv
    env') TidyEnv
    env [Id]
    cbv_bndrs
        in
        (Expr Id -> Expr Id) -> [Expr Id] -> [Expr Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env') [Expr Id]
    rhss [Expr Id]
    -> ([Expr Id] -> (TidyEnv, CoreBind)) -> (TidyEnv, CoreBind)
    forall a b. a -> (a -> b) -> b
    =: \ [Expr Id]
    rhss' ->
        (TidyEnv
    env', [(Id, Expr Id)] -> CoreBind
    forall b. [(b, Expr b)] -> Bind b
    Rec ([Id] -> [Expr Id] -> [(Id, Expr Id)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Id]
    bndrs' [Expr Id]
    rhss'))

    -- Note [Attaching CBV Marks to ids]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- See Note [CBV Function Ids] for the *why*.
    -- Before tidy, we turn all worker functions into worker like ids.
    -- This way we can later tell if we can assume the existence of a wrapper. This also applies to
    -- specialized versions of functions generated by SpecConstr for which we, in a sense,
    -- consider the unspecialized version to be the wrapper.
    -- During tidy we take the demands on the arguments for these ids and compute
    -- CBV (call-by-value) semantics for each individual argument.
    -- The marks themselves then are put onto the function id itself.
    -- This means the code generator can get the full calling convention by only looking at the function
    -- itself without having to inspect the RHS.
    --
    -- The actual logic is in computeCbvInfo and takes:
    -- * The function id
    -- * The functions rhs
    -- And gives us back the function annotated with the marks.
    -- We call it in:
    -- * tidyTopPair for top level bindings
    -- * tidyBind for local bindings.
    --
    -- Not that we *have* to look at the untidied rhs.
    -- During tidying some knot-tying occurs which can blow up
    -- if we look at the post-tidy types of the arguments here.
    -- However we only care if the types are unlifted and that doesn't change during tidy.
    -- so we can just look at the untidied types.
    --
    -- If the id is boot-exported we don't use a cbv calling convention via marks,
    -- as the boot file won't contain them. Which means code calling boot-exported
    -- ids might expect these ids to have a vanilla calling convention even if we
    -- determine a different one here.
    -- To be able to avoid this we pass a set of boot exported ids for this module around.
    -- For non top level ids we can skip this. Local ids are never boot-exported
    -- as boot files don't have unfoldings. So there this isn't a concern.
    -- See also Note [CBV Function Ids]

    -- See Note [CBV Function Ids]
    tidyCbvInfoTop :: HasDebugCallStack => NameSet -> Id -> CoreExpr -> Id
    tidyCbvInfoTop :: HasDebugCallStack => NameSet -> Id -> Expr Id -> Id
    tidyCbvInfoTop NameSet
    boot_exports Id
    id Expr Id
    rhs
      -- Can't change calling convention for boot exported things
      | Name -> NameSet -> Bool
    elemNameSet (Id -> Name
    idName Id
    id) NameSet
    boot_exports = Id
    id
      | Bool
    otherwise = HasCallStack => Id -> Expr Id -> Id
    Id -> Expr Id -> Id
    computeCbvInfo Id
    id Expr Id
    rhs

    -- See Note [CBV Function Ids]
    tidyCbvInfoLocal :: HasDebugCallStack => Id -> CoreExpr -> Id
    tidyCbvInfoLocal :: HasDebugCallStack => Id -> Expr Id -> Id
    tidyCbvInfoLocal Id
    id Expr Id
    rhs = HasCallStack => Id -> Expr Id -> Id
    Id -> Expr Id -> Id
    computeCbvInfo Id
    id Expr Id
    rhs

    -- | For a binding we:
    -- * Look at the args
    -- * Mark any argument as call-by-value if:
    --   - It's argument to a worker and demanded strictly
    --   - Unless it's an unlifted type already
    -- * Update the id
    -- See Note [CBV Function Ids]
    -- See Note [Attaching CBV Marks to ids]

    computeCbvInfo :: HasCallStack
                   => Id            -- The function
                   -> CoreExpr      -- It's RHS
                   -> Id
    -- computeCbvInfo fun_id rhs = fun_id
    computeCbvInfo :: HasCallStack => Id -> Expr Id -> Id
    computeCbvInfo Id
    fun_id Expr Id
    rhs
      | Bool
    is_wkr_like Bool -> Bool -> Bool
    || JoinPointHood -> Bool
    isJoinPoint JoinPointHood
    mb_join_id
      , [Id] -> Bool
    forall {t :: * -> *}. Foldable t => t Id -> Bool
    valid_unlifted_worker [Id]
    val_args
      = -- pprTrace "computeCbvInfo"
        --   (text "fun" <+> ppr fun_id $$
        --     text "arg_tys" <+> ppr (map idType val_args) $$

        --     text "prim_rep" <+> ppr (map typePrimRep_maybe $ map idType val_args) $$
        --     text "rrarg" <+> ppr (map isRuntimeVar val_args) $$
        --     text "cbv_marks" <+> ppr cbv_marks $$
        --     text "out_id" <+> ppr cbv_bndr $$
        --     ppr rhs)
        Id
    cbv_bndr

      | Bool
    otherwise = Id
    fun_id
      where
        mb_join_id :: JoinPointHood
    mb_join_id  = Id -> JoinPointHood
    idJoinPointHood Id
    fun_id
        is_wkr_like :: Bool
    is_wkr_like = Id -> Bool
    isWorkerLikeId Id
    fun_id

        val_args :: [Id]
    val_args = (Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Id -> Bool
    isId [Id]
    lam_bndrs
        -- When computing CbvMarks, we limit the arity of join points to
        -- the JoinArity, because that's the arity we are going to use
        -- when calling it. There may be more lambdas than that on the RHS.
        lam_bndrs :: [Id]
    lam_bndrs | JoinPoint Int
    join_arity <- JoinPointHood
    mb_join_id
                  = ([Id], Expr Id) -> [Id]
    forall a b. (a, b) -> a
    fst (([Id], Expr Id) -> [Id]) -> ([Id], Expr Id) -> [Id]
    forall a b. (a -> b) -> a -> b
    $ Int -> Expr Id -> ([Id], Expr Id)
    forall b. Int -> Expr b -> ([b], Expr b)
    collectNBinders Int
    join_arity Expr Id
    rhs
                  | Bool
    otherwise
                  = ([Id], Expr Id) -> [Id]
    forall a b. (a, b) -> a
    fst (([Id], Expr Id) -> [Id]) -> ([Id], Expr Id) -> [Id]
    forall a b. (a -> b) -> a -> b
    $ Expr Id -> ([Id], Expr Id)
    forall b. Expr b -> ([b], Expr b)
    collectBinders Expr Id
    rhs

        cbv_marks :: [CbvMark]
    cbv_marks = -- assert: CBV marks are only set during tidy so none should be present already.
                    Bool -> SDoc -> [CbvMark] -> [CbvMark]
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Bool -> ([CbvMark] -> Bool) -> Maybe [CbvMark] -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True [CbvMark] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Maybe [CbvMark] -> Bool) -> Maybe [CbvMark] -> Bool
    forall a b. (a -> b) -> a -> b
    $ Id -> Maybe [CbvMark]
    idCbvMarks_maybe Id
    fun_id)
                              (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    fun_id SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> (Maybe [CbvMark] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Maybe [CbvMark] -> SDoc) -> Maybe [CbvMark] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Id -> Maybe [CbvMark]
    idCbvMarks_maybe Id
    fun_id) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Expr Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Expr Id
    rhs) ([CbvMark] -> [CbvMark]) -> [CbvMark] -> [CbvMark]
    forall a b. (a -> b) -> a -> b
    $
                    (Id -> CbvMark) -> [Id] -> [CbvMark]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> CbvMark
    mkMark [Id]
    val_args

        cbv_bndr :: Id
    cbv_bndr | (CbvMark -> Bool) -> [CbvMark] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any CbvMark -> Bool
    isMarkedCbv [CbvMark]
    cbv_marks
                 = [CbvMark]
    cbv_marks [CbvMark] -> Id -> Id
    forall a b. [a] -> b -> b
    `seqList` Id -> [CbvMark] -> Id
    setIdCbvMarks Id
    fun_id [CbvMark]
    cbv_marks
                   -- seqList: avoid retaining the original rhs

                 | Bool
    otherwise
                 = -- pprTraceDebug "computeCbvInfo: Worker seems to take unboxed tuple/sum types!"
                   --    (ppr fun_id <+> ppr rhs)
                   Id -> Id
    asNonWorkerLikeId Id
    fun_id

        -- We don't set CBV marks on functions which take unboxed tuples or sums as
        -- arguments.  Doing so would require us to compute the result of unarise
        -- here in order to properly determine argument positions at runtime.
        --
        -- In practice this doesn't matter much. Most "interesting" functions will
        -- get a W/W split which will eliminate unboxed tuple arguments, and unboxed
        -- sums are rarely used. But we could change this in the future and support
        -- unboxed sums/tuples as well.
        valid_unlifted_worker :: t Id -> Bool
    valid_unlifted_worker t Id
    args =
          -- pprTrace "valid_unlifted" (ppr fun_id $$ ppr args) $
          (Id -> Bool) -> t Id -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Id -> Bool
    isSingleUnarisedArg t Id
    args

        isSingleUnarisedArg :: Id -> Bool
    isSingleUnarisedArg Id
    v
          | Type -> Bool
    isUnboxedSumType Type
    ty = Bool
    False
          | Type -> Bool
    isUnboxedTupleType Type
    ty = [PrimRep] -> Bool
    forall a. [a] -> Bool
    isSimplePrimRep (HasDebugCallStack => Type -> [PrimRep]
    Type -> [PrimRep]
    typePrimRep Type
    ty)
          | Bool
    otherwise = [PrimRep] -> Bool
    forall a. [a] -> Bool
    isSimplePrimRep (HasDebugCallStack => Type -> [PrimRep]
    Type -> [PrimRep]
    typePrimRep Type
    ty)
          where
            ty :: Type
    ty = Id -> Type
    idType Id
    v
            isSimplePrimRep :: [a] -> Bool
    isSimplePrimRep []  = Bool
    True
            isSimplePrimRep [a
    _] = Bool
    True
            isSimplePrimRep [a]
    _   = Bool
    False

        mkMark :: Id -> CbvMark
    mkMark Id
    arg
          | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Id -> Bool
    shouldUseCbvForId Id
    arg = CbvMark
    NotMarkedCbv
          -- We can only safely use cbv for strict arguments
          | (Demand -> Bool
    isStrUsedDmd (Id -> Demand
    idDemandInfo Id
    arg))
          , Bool -> Bool
    not (Id -> Bool
    isDeadEndId Id
    fun_id) = CbvMark
    MarkedCbv
          | Bool
    otherwise = CbvMark
    NotMarkedCbv

    ------------  Expressions  --------------
    tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
    tidyExpr :: TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env (Var Id
    v)       = Id -> Expr Id
    forall b. Id -> Expr b
    Var (TidyEnv -> Id -> Id
    tidyVarOcc TidyEnv
    env Id
    v)
    tidyExpr TidyEnv
    env (Type Type
    ty)     = Type -> Expr Id
    forall b. Type -> Expr b
    Type (TidyEnv -> Type -> Type
    tidyType TidyEnv
    env Type
    ty)
    tidyExpr TidyEnv
    env (Coercion Coercion
    co) = Coercion -> Expr Id
    forall b. Coercion -> Expr b
    Coercion (TidyEnv -> Coercion -> Coercion
    tidyCo TidyEnv
    env Coercion
    co)
    tidyExpr TidyEnv
    _   (Lit Literal
    lit)     = Literal -> Expr Id
    forall b. Literal -> Expr b
    Lit Literal
    lit
    tidyExpr TidyEnv
    env (App Expr Id
    f Expr Id
    a)     = Expr Id -> Expr Id -> Expr Id
    forall b. Expr b -> Expr b -> Expr b
    App (TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env Expr Id
    f) (TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env Expr Id
    a)
    tidyExpr TidyEnv
    env (Tick CoreTickish
    t Expr Id
    e)    = CoreTickish -> Expr Id -> Expr Id
    forall b. CoreTickish -> Expr b -> Expr b
    Tick (TidyEnv -> CoreTickish -> CoreTickish
    tidyTickish TidyEnv
    env CoreTickish
    t) (TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env Expr Id
    e)
    tidyExpr TidyEnv
    env (Cast Expr Id
    e Coercion
    co)   = Expr Id -> Coercion -> Expr Id
    forall b. Expr b -> Coercion -> Expr b
    Cast (TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env Expr Id
    e) (TidyEnv -> Coercion -> Coercion
    tidyCo TidyEnv
    env Coercion
    co)

    tidyExpr TidyEnv
    env (Let CoreBind
    b Expr Id
    e)
      = TidyEnv -> CoreBind -> (TidyEnv, CoreBind)
    tidyBind TidyEnv
    env CoreBind
    b      (TidyEnv, CoreBind) -> ((TidyEnv, CoreBind) -> Expr Id) -> Expr Id
    forall a b. a -> (a -> b) -> b
    =: \ (TidyEnv
    env', CoreBind
    b') ->
        CoreBind -> Expr Id -> Expr Id
    forall b. Bind b -> Expr b -> Expr b
    Let CoreBind
    b' (TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env' Expr Id
    e)

    tidyExpr TidyEnv
    env (Case Expr Id
    e Id
    b Type
    ty [Alt Id]
    alts)
      = TidyEnv -> Id -> (TidyEnv, Id)
    tidyBndr TidyEnv
    env Id
    b  (TidyEnv, Id) -> ((TidyEnv, Id) -> Expr Id) -> Expr Id
    forall a b. a -> (a -> b) -> b
    =: \ (TidyEnv
    env', Id
    b) ->
        Expr Id -> Id -> Type -> [Alt Id] -> Expr Id
    forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case (TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env Expr Id
    e) Id
    b (TidyEnv -> Type -> Type
    tidyType TidyEnv
    env Type
    ty)
             ((Alt Id -> Alt Id) -> [Alt Id] -> [Alt Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (TidyEnv -> Alt Id -> Alt Id
    tidyAlt TidyEnv
    env') [Alt Id]
    alts)

    tidyExpr TidyEnv
    env (Lam Id
    b Expr Id
    e)
      = TidyEnv -> Id -> (TidyEnv, Id)
    tidyBndr TidyEnv
    env Id
    b      (TidyEnv, Id) -> ((TidyEnv, Id) -> Expr Id) -> Expr Id
    forall a b. a -> (a -> b) -> b
    =: \ (TidyEnv
    env', Id
    b) ->
        Id -> Expr Id -> Expr Id
    forall b. b -> Expr b -> Expr b
    Lam Id
    b (TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env' Expr Id
    e)

    ------------  Case alternatives  --------------
    tidyAlt :: TidyEnv -> CoreAlt -> CoreAlt
    tidyAlt :: TidyEnv -> Alt Id -> Alt Id
    tidyAlt TidyEnv
    env (Alt AltCon
    con [Id]
    vs Expr Id
    rhs)
      = TidyEnv -> [Id] -> (TidyEnv, [Id])
    tidyBndrs TidyEnv
    env [Id]
    vs    (TidyEnv, [Id]) -> ((TidyEnv, [Id]) -> Alt Id) -> Alt Id
    forall a b. a -> (a -> b) -> b
    =: \ (TidyEnv
    env', [Id]
    vs) ->
        (AltCon -> [Id] -> Expr Id -> Alt Id
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con [Id]
    vs (TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env' Expr Id
    rhs))

    ------------  Tickish  --------------
    tidyTickish :: TidyEnv -> CoreTickish -> CoreTickish
    tidyTickish :: TidyEnv -> CoreTickish -> CoreTickish
    tidyTickish TidyEnv
    env (Breakpoint XBreakpoint 'TickishPassCore
    ext Int
    ix [XTickishId 'TickishPassCore]
    ids Module
    modl)
      = XBreakpoint 'TickishPassCore
    -> Int -> [XTickishId 'TickishPassCore] -> Module -> CoreTickish
    forall (pass :: TickishPass).
    XBreakpoint pass
    -> Int -> [XTickishId pass] -> Module -> GenTickish pass
    Breakpoint XBreakpoint 'TickishPassCore
    ext Int
    ix ((Id -> Id) -> [Id] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (TidyEnv -> Id -> Id
    tidyVarOcc TidyEnv
    env) [Id]
    [XTickishId 'TickishPassCore]
    ids) Module
    modl
    tidyTickish TidyEnv
    _   CoreTickish
    other_tickish       = CoreTickish
    other_tickish

    ------------  Rules  --------------
    tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
    tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
    tidyRules TidyEnv
    _   [] = []
    tidyRules TidyEnv
    env (CoreRule
    rule : [CoreRule]
    rules)
      = TidyEnv -> CoreRule -> CoreRule
    tidyRule TidyEnv
    env CoreRule
    rule           CoreRule -> (CoreRule -> [CoreRule]) -> [CoreRule]
    forall a b. a -> (a -> b) -> b
    =: \ CoreRule
    rule ->
        TidyEnv -> [CoreRule] -> [CoreRule]
    tidyRules TidyEnv
    env [CoreRule]
    rules         [CoreRule] -> ([CoreRule] -> [CoreRule]) -> [CoreRule]
    forall a b. a -> (a -> b) -> b
    =: \ [CoreRule]
    rules ->
        (CoreRule
    rule CoreRule -> [CoreRule] -> [CoreRule]
    forall a. a -> [a] -> [a]
    : [CoreRule]
    rules)

    tidyRule :: TidyEnv -> CoreRule -> CoreRule
    tidyRule :: TidyEnv -> CoreRule -> CoreRule
    tidyRule TidyEnv
    _   rule :: CoreRule
    rule@(BuiltinRule {}) = CoreRule
    rule
    tidyRule TidyEnv
    env rule :: CoreRule
    rule@(Rule { ru_bndrs :: CoreRule -> [Id]
    ru_bndrs = [Id]
    bndrs, ru_args :: CoreRule -> [Expr Id]
    ru_args = [Expr Id]
    args, ru_rhs :: CoreRule -> Expr Id
    ru_rhs = Expr Id
    rhs,
                              ru_fn :: CoreRule -> Name
    ru_fn = Name
    fn, ru_rough :: CoreRule -> [Maybe Name]
    ru_rough = [Maybe Name]
    mb_ns })
      = TidyEnv -> [Id] -> (TidyEnv, [Id])
    tidyBndrs TidyEnv
    env [Id]
    bndrs         (TidyEnv, [Id]) -> ((TidyEnv, [Id]) -> CoreRule) -> CoreRule
    forall a b. a -> (a -> b) -> b
    =: \ (TidyEnv
    env', [Id]
    bndrs) ->
        (Expr Id -> Expr Id) -> [Expr Id] -> [Expr Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (TidyEnv -> Expr Id -> Expr Id
    tidyExpr TidyEnv
    env') [Expr Id]
    args    [Expr Id] -> ([Expr Id] -> CoreRule) -> CoreRule
    forall a b. a -> (a -> b) -> b
    =: \ [Expr Id]
    args ->
        CoreRule
    rule { ru_bndrs = bndrs, ru_args = args,
               ru_rhs   = tidyExpr env' rhs,
               ru_fn    = tidyNameOcc env fn,
               ru_rough = map (fmap (tidyNameOcc env')) mb_ns }

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Tidying non-top-level binders}
    *                                                                      *
    ************************************************************************
    -}

    tidyNameOcc :: TidyEnv -> Name -> Name
    -- In rules and instances, we have Names, and we must tidy them too
    -- Fortunately, we can lookup in the VarEnv with a name
    tidyNameOcc :: TidyEnv -> Name -> Name
    tidyNameOcc (TidyOccEnv
    _, VarEnv Id
    var_env) Name
    n = case VarEnv Id -> Unique -> Maybe Id
    forall {k} (key :: k) elt. UniqFM key elt -> Unique -> Maybe elt
    lookupUFM_Directly VarEnv Id
    var_env (Name -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique Name
    n) of
                                    Maybe Id
    Nothing -> Name
    n
                                    Just Id
    v  -> Id -> Name
    idName Id
    v

    tidyVarOcc :: TidyEnv -> Var -> Var
    tidyVarOcc :: TidyEnv -> Id -> Id
    tidyVarOcc (TidyOccEnv
    _, VarEnv Id
    var_env) Id
    v = VarEnv Id -> Id -> Maybe Id
    forall a. VarEnv a -> Id -> Maybe a
    lookupVarEnv VarEnv Id
    var_env Id
    v Maybe Id -> Id -> Id
    forall a. Maybe a -> a -> a
    `orElse` Id
    v

    -- tidyBndr is used for lambda and case binders
    tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
    tidyBndr :: TidyEnv -> Id -> (TidyEnv, Id)
    tidyBndr TidyEnv
    env Id
    var
      | Id -> Bool
    isTyCoVar Id
    var = TidyEnv -> Id -> (TidyEnv, Id)
    tidyVarBndr TidyEnv
    env Id
    var
      | Bool
    otherwise     = TidyEnv -> Id -> (TidyEnv, Id)
    tidyIdBndr TidyEnv
    env Id
    var

    tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
    tidyBndrs :: TidyEnv -> [Id] -> (TidyEnv, [Id])
    tidyBndrs TidyEnv
    env [Id]
    vars = (TidyEnv -> Id -> (TidyEnv, Id))
    -> TidyEnv -> [Id] -> (TidyEnv, [Id])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL TidyEnv -> Id -> (TidyEnv, Id)
    tidyBndr TidyEnv
    env [Id]
    vars

    -- Non-top-level variables, not covars
    tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
    tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
    tidyIdBndr env :: TidyEnv
    env@(TidyOccEnv
    tidy_env, VarEnv Id
    var_env) Id
    id
      = -- Do this pattern match strictly, otherwise we end up holding on to
        -- stuff in the OccName.
        case TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
    tidyOccName TidyOccEnv
    tidy_env (Id -> OccName
    forall a. NamedThing a => a -> OccName
    getOccName Id
    id) of { (TidyOccEnv
    tidy_env', OccName
    occ') ->
        let
            -- Give the Id a fresh print-name, *and* rename its type
            -- The SrcLoc isn't important now,
            -- though we could extract it from the Id
            --
            ty' :: Type
    ty'      = TidyEnv -> Type -> Type
    tidyType TidyEnv
    env (Id -> Type
    idType Id
    id)
            mult' :: Type
    mult'    = TidyEnv -> Type -> Type
    tidyType TidyEnv
    env (Id -> Type
    idMult Id
    id)
            name' :: Name
    name'    = Unique -> OccName -> SrcSpan -> Name
    mkInternalName (Id -> Unique
    idUnique Id
    id) OccName
    occ' SrcSpan
    noSrcSpan
            id' :: Id
    id'      = HasDebugCallStack => Name -> Type -> Type -> IdInfo -> Id
    Name -> Type -> Type -> IdInfo -> Id
    mkLocalIdWithInfo Name
    name' Type
    mult' Type
    ty' IdInfo
    new_info
            var_env' :: VarEnv Id
    var_env' = VarEnv Id -> Id -> Id -> VarEnv Id
    forall a. VarEnv a -> Id -> a -> VarEnv a
    extendVarEnv VarEnv Id
    var_env Id
    id Id
    id'

            -- Note [Tidy IdInfo]
            new_info :: IdInfo
    new_info = IdInfo
    vanillaIdInfo IdInfo -> OccInfo -> IdInfo
    `setOccInfo` IdInfo -> OccInfo
    occInfo IdInfo
    old_info
                                     IdInfo -> Unfolding -> IdInfo
    `setUnfoldingInfo` Unfolding
    new_unf
                                      -- see Note [Preserve OneShotInfo]
                                     IdInfo -> OneShotInfo -> IdInfo
    `setOneShotInfo` IdInfo -> OneShotInfo
    oneShotInfo IdInfo
    old_info
            old_info :: IdInfo
    old_info = HasDebugCallStack => Id -> IdInfo
    Id -> IdInfo
    idInfo Id
    id
            old_unf :: Unfolding
    old_unf  = IdInfo -> Unfolding
    realUnfoldingInfo IdInfo
    old_info
            new_unf :: Unfolding
    new_unf  = Unfolding -> Unfolding
    trimUnfolding Unfolding
    old_unf  -- See Note [Preserve evaluatedness]
        in
        ((TidyOccEnv
    tidy_env', VarEnv Id
    var_env'), Id
    id')
       }

    tidyLetBndr :: TidyEnv         -- Knot-tied version for unfoldings
                -> TidyEnv         -- The one to extend
                -> Id -> (TidyEnv, Id)
    -- Used for local (non-top-level) let(rec)s
    -- Just like tidyIdBndr above, but with more IdInfo
    tidyLetBndr :: TidyEnv -> TidyEnv -> Id -> (TidyEnv, Id)
    tidyLetBndr TidyEnv
    rec_tidy_env env :: TidyEnv
    env@(TidyOccEnv
    tidy_env, VarEnv Id
    var_env) Id
    id
      = case TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
    tidyOccName TidyOccEnv
    tidy_env (Id -> OccName
    forall a. NamedThing a => a -> OccName
    getOccName Id
    id) of { (TidyOccEnv
    tidy_env', OccName
    occ') ->
        let
            ty' :: Type
    ty'      = TidyEnv -> Type -> Type
    tidyType TidyEnv
    env (Id -> Type
    idType Id
    id)
            mult' :: Type
    mult'    = TidyEnv -> Type -> Type
    tidyType TidyEnv
    env (Id -> Type
    idMult Id
    id)
            name' :: Name
    name'    = Unique -> OccName -> SrcSpan -> Name
    mkInternalName (Id -> Unique
    idUnique Id
    id) OccName
    occ' SrcSpan
    noSrcSpan
            details :: IdDetails
    details  = Id -> IdDetails
    idDetails Id
    id
            id' :: Id
    id'      = IdDetails -> Name -> Type -> Type -> IdInfo -> Id
    mkLocalVar IdDetails
    details Name
    name' Type
    mult' Type
    ty' IdInfo
    new_info
            var_env' :: VarEnv Id
    var_env' = VarEnv Id -> Id -> Id -> VarEnv Id
    forall a. VarEnv a -> Id -> a -> VarEnv a
    extendVarEnv VarEnv Id
    var_env Id
    id Id
    id'

            -- Note [Tidy IdInfo]
            -- We need to keep around any interesting strictness and
            -- demand info because later on we may need to use it when
            -- converting to A-normal form.
            -- eg.
            --      f (g x),  where f is strict in its argument, will be converted
            --      into  case (g x) of z -> f z  by CorePrep, but only if f still
            --      has its strictness info.
            --
            -- Similarly for the demand info - on a let binder, this tells
            -- CorePrep to turn the let into a case.
            -- But: Remove the usage demand here
            --      (See Note [Zapping DmdEnv after Demand Analyzer] in GHC.Core.Opt.WorkWrap)
            --
            -- Similarly arity info for eta expansion in CorePrep
            -- Don't attempt to recompute arity here; this is just tidying!
            -- Trying to do so led to #17294
            --
            -- Set inline-prag info so that we preserve it across
            -- separate compilation boundaries
            old_info :: IdInfo
    old_info = HasDebugCallStack => Id -> IdInfo
    Id -> IdInfo
    idInfo Id
    id
            new_info :: IdInfo
    new_info = IdInfo
    vanillaIdInfo
                        IdInfo -> OccInfo -> IdInfo
    `setOccInfo`        IdInfo -> OccInfo
    occInfo IdInfo
    old_info
                        IdInfo -> Int -> IdInfo
    `setArityInfo`      IdInfo -> Int
    arityInfo IdInfo
    old_info
                        IdInfo -> DmdSig -> IdInfo
    `setDmdSigInfo`     DmdSig -> DmdSig
    zapDmdEnvSig (IdInfo -> DmdSig
    dmdSigInfo IdInfo
    old_info)
                        IdInfo -> Demand -> IdInfo
    `setDemandInfo`     IdInfo -> Demand
    demandInfo IdInfo
    old_info
                        IdInfo -> InlinePragma -> IdInfo
    `setInlinePragInfo` IdInfo -> InlinePragma
    inlinePragInfo IdInfo
    old_info
                        IdInfo -> Unfolding -> IdInfo
    `setUnfoldingInfo`  Unfolding
    new_unf

            old_unf :: Unfolding
    old_unf = IdInfo -> Unfolding
    realUnfoldingInfo IdInfo
    old_info
            new_unf :: Unfolding
    new_unf = TidyEnv -> Unfolding -> Unfolding
    tidyNestedUnfolding TidyEnv
    rec_tidy_env Unfolding
    old_unf

        in
        ((TidyOccEnv
    tidy_env', VarEnv Id
    var_env'), Id
    id') }

    ------------ Unfolding  --------------
    tidyNestedUnfolding :: TidyEnv -> Unfolding -> Unfolding
    tidyNestedUnfolding :: TidyEnv -> Unfolding -> Unfolding
    tidyNestedUnfolding TidyEnv
    _ Unfolding
    NoUnfolding   = Unfolding
    NoUnfolding
    tidyNestedUnfolding TidyEnv
    _ Unfolding
    BootUnfolding = Unfolding
    BootUnfolding
    tidyNestedUnfolding TidyEnv
    _ (OtherCon {}) = Unfolding
    evaldUnfolding

    tidyNestedUnfolding TidyEnv
    tidy_env df :: Unfolding
    df@(DFunUnfolding { df_bndrs :: Unfolding -> [Id]
    df_bndrs = [Id]
    bndrs, df_args :: Unfolding -> [Expr Id]
    df_args = [Expr Id]
    args })
      = Unfolding
    df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args }
      where
        (TidyEnv
    tidy_env', [Id]
    bndrs') = TidyEnv -> [Id] -> (TidyEnv, [Id])
    tidyBndrs TidyEnv
    tidy_env [Id]
    bndrs

    tidyNestedUnfolding TidyEnv
    tidy_env
        unf :: Unfolding
    unf@(CoreUnfolding { uf_tmpl :: Unfolding -> Expr Id
    uf_tmpl = Expr Id
    unf_rhs, uf_src :: Unfolding -> UnfoldingSource
    uf_src = UnfoldingSource
    src, uf_cache :: Unfolding -> UnfoldingCache
    uf_cache = UnfoldingCache
    cache })
      | UnfoldingSource -> Bool
    isStableSource UnfoldingSource
    src
      = Unfolding -> Unfolding
    seqIt (Unfolding -> Unfolding) -> Unfolding -> Unfolding
    forall a b. (a -> b) -> a -> b
    $ Unfolding
    unf { uf_tmpl = tidyExpr tidy_env unf_rhs }    -- Preserves OccInfo
                -- This seqIt avoids a space leak: otherwise the uf_cache
                -- field may retain a reference to the pre-tidied
                -- expression forever (GHC.CoreToIface doesn't look at
                -- them)

      -- Discard unstable unfoldings, but see Note [Preserve evaluatedness]
      | UnfoldingCache -> Bool
    uf_is_value UnfoldingCache
    cache = Unfolding
    evaldUnfolding
      | Bool
    otherwise = Unfolding
    noUnfolding

      where
        seqIt :: Unfolding -> Unfolding
    seqIt Unfolding
    unf = Unfolding -> ()
    seqUnfolding Unfolding
    unf () -> Unfolding -> Unfolding
    forall a b. a -> b -> b
    `seq` Unfolding
    unf

    {-
    Note [Tidy IdInfo]
    ~~~~~~~~~~~~~~~~~~
    All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
    should save some space; except that we preserve occurrence info for
    two reasons:

      (a) To make printing tidy core nicer

      (b) Because we tidy RULES and unfoldings, which may then propagate
          via --make into the compilation of the next module, and we want
          the benefit of that occurrence analysis when we use the rule or
          or inline the function.  In particular, it's vital not to lose
          loop-breaker info, else we get an infinite inlining loop

    Note that tidyLetBndr puts more IdInfo back.

    Note [Preserve evaluatedness]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
      data T = MkT !Bool
      ....(case v of MkT y ->
           let z# = case y of
                      True -> 1#
                      False -> 2#
           in ...)

    The z# binding is ok because the RHS is ok-for-speculation,
    but Lint will complain unless it can *see* that.  So we
    preserve the evaluated-ness on 'y' in tidyBndr.

    (Another alternative would be to tidy unboxed lets into cases,
    but that seems more indirect and surprising.)

    Note [Preserve OneShotInfo]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We keep the OneShotInfo because we want it to propagate into the interface.
    Not all OneShotInfo is determined by a compiler analysis; some is added by a
    call of GHC.Exts.oneShot, which is then discarded before the end of the
    optimisation pipeline, leaving only the OneShotInfo on the lambda. Hence we
    must preserve this info in inlinings. See Note [oneShot magic] in GHC.Types.Id.Make.

    This applies to lambda binders only, hence it is stored in IfaceLamBndr.
    -}

    (=:) :: a -> (a -> b) -> b
    a
    m =: :: forall a b. a -> (a -> b) -> b
    =: a -> b
    k = a
    m a -> b -> b
    forall a b. a -> b -> b
    `seq` a -> b
    k a
    m