{-
(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 TidyPgm.
-}

{-# LANGUAGE CPP #-}
module CoreTidy (
        tidyExpr, tidyRule, tidyRules, tidyUnfolding
    ) where

#include "HsVersions.h"

import GhcPrelude

import CoreSyn
import CoreSeq ( seqUnfolding )
import CoreArity
import Id
import IdInfo
import Demand ( zapUsageEnvSig )
import Type( tidyType, tidyVarBndr )
import Coercion( tidyCo )
import Var
import VarEnv
import UniqFM
import Name hiding (tidyNameOcc)
import SrcLoc
import Maybes
import Data.List

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

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

tidyBind :: TidyEnv -> CoreBind -> (TidyEnv, CoreBind)
tidyBind env :: TidyEnv
env (NonRec bndr :: CoreBndr
bndr rhs :: Expr CoreBndr
rhs)
  = TidyEnv
-> TidyEnv -> (CoreBndr, Expr CoreBndr) -> (TidyEnv, CoreBndr)
tidyLetBndr TidyEnv
env TidyEnv
env (CoreBndr
bndr,Expr CoreBndr
rhs) (TidyEnv, CoreBndr)
-> ((TidyEnv, CoreBndr) -> (TidyEnv, CoreBind))
-> (TidyEnv, CoreBind)
forall a b. a -> (a -> b) -> b
=: \ (env' :: TidyEnv
env', bndr' :: CoreBndr
bndr') ->
    (TidyEnv
env', CoreBndr -> Expr CoreBndr -> CoreBind
forall b. b -> Expr b -> Bind b
NonRec CoreBndr
bndr' (TidyEnv -> Expr CoreBndr -> Expr CoreBndr
tidyExpr TidyEnv
env' Expr CoreBndr
rhs))

tidyBind env :: TidyEnv
env (Rec prs :: [(CoreBndr, Expr CoreBndr)]
prs)
  = let
       (env' :: TidyEnv
env', bndrs' :: [CoreBndr]
bndrs') = (TidyEnv -> (CoreBndr, Expr CoreBndr) -> (TidyEnv, CoreBndr))
-> TidyEnv -> [(CoreBndr, Expr CoreBndr)] -> (TidyEnv, [CoreBndr])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (TidyEnv
-> TidyEnv -> (CoreBndr, Expr CoreBndr) -> (TidyEnv, CoreBndr)
tidyLetBndr TidyEnv
env') TidyEnv
env [(CoreBndr, Expr CoreBndr)]
prs
    in
    (Expr CoreBndr -> Expr CoreBndr)
-> [Expr CoreBndr] -> [Expr CoreBndr]
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Expr CoreBndr -> Expr CoreBndr
tidyExpr TidyEnv
env') (((CoreBndr, Expr CoreBndr) -> Expr CoreBndr)
-> [(CoreBndr, Expr CoreBndr)] -> [Expr CoreBndr]
forall a b. (a -> b) -> [a] -> [b]
map (CoreBndr, Expr CoreBndr) -> Expr CoreBndr
forall a b. (a, b) -> b
snd [(CoreBndr, Expr CoreBndr)]
prs)   [Expr CoreBndr]
-> ([Expr CoreBndr] -> (TidyEnv, CoreBind)) -> (TidyEnv, CoreBind)
forall a b. a -> (a -> b) -> b
=: \ rhss' :: [Expr CoreBndr]
rhss' ->
    (TidyEnv
env', [(CoreBndr, Expr CoreBndr)] -> CoreBind
forall b. [(b, Expr b)] -> Bind b
Rec ([CoreBndr] -> [Expr CoreBndr] -> [(CoreBndr, Expr CoreBndr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CoreBndr]
bndrs' [Expr CoreBndr]
rhss'))


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

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

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

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

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

------------  Tickish  --------------
tidyTickish :: TidyEnv -> Tickish Id -> Tickish Id
tidyTickish :: TidyEnv -> Tickish CoreBndr -> Tickish CoreBndr
tidyTickish env :: TidyEnv
env (Breakpoint ix :: Int
ix ids :: [CoreBndr]
ids) = Int -> [CoreBndr] -> Tickish CoreBndr
forall id. Int -> [id] -> Tickish id
Breakpoint Int
ix ((CoreBndr -> CoreBndr) -> [CoreBndr] -> [CoreBndr]
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> CoreBndr -> CoreBndr
tidyVarOcc TidyEnv
env) [CoreBndr]
ids)
tidyTickish _   other_tickish :: Tickish CoreBndr
other_tickish       = Tickish CoreBndr
other_tickish

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

tidyRule :: TidyEnv -> CoreRule -> CoreRule
tidyRule :: TidyEnv -> CoreRule -> CoreRule
tidyRule _   rule :: CoreRule
rule@(BuiltinRule {}) = CoreRule
rule
tidyRule env :: TidyEnv
env rule :: CoreRule
rule@(Rule { ru_bndrs :: CoreRule -> [CoreBndr]
ru_bndrs = [CoreBndr]
bndrs, ru_args :: CoreRule -> [Expr CoreBndr]
ru_args = [Expr CoreBndr]
args, ru_rhs :: CoreRule -> Expr CoreBndr
ru_rhs = Expr CoreBndr
rhs,
                          ru_fn :: CoreRule -> Name
ru_fn = Name
fn, ru_rough :: CoreRule -> [Maybe Name]
ru_rough = [Maybe Name]
mb_ns })
  = TidyEnv -> [CoreBndr] -> (TidyEnv, [CoreBndr])
tidyBndrs TidyEnv
env [CoreBndr]
bndrs         (TidyEnv, [CoreBndr])
-> ((TidyEnv, [CoreBndr]) -> CoreRule) -> CoreRule
forall a b. a -> (a -> b) -> b
=: \ (env' :: TidyEnv
env', bndrs :: [CoreBndr]
bndrs) ->
    (Expr CoreBndr -> Expr CoreBndr)
-> [Expr CoreBndr] -> [Expr CoreBndr]
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Expr CoreBndr -> Expr CoreBndr
tidyExpr TidyEnv
env') [Expr CoreBndr]
args    [Expr CoreBndr] -> ([Expr CoreBndr] -> CoreRule) -> CoreRule
forall a b. a -> (a -> b) -> b
=: \ args :: [Expr CoreBndr]
args ->
    CoreRule
rule { ru_bndrs :: [CoreBndr]
ru_bndrs = [CoreBndr]
bndrs, ru_args :: [Expr CoreBndr]
ru_args = [Expr CoreBndr]
args,
           ru_rhs :: Expr CoreBndr
ru_rhs   = TidyEnv -> Expr CoreBndr -> Expr CoreBndr
tidyExpr TidyEnv
env' Expr CoreBndr
rhs,
           ru_fn :: Name
ru_fn    = TidyEnv -> Name -> Name
tidyNameOcc TidyEnv
env Name
fn,
           ru_rough :: [Maybe Name]
ru_rough = (Maybe Name -> Maybe Name) -> [Maybe Name] -> [Maybe Name]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Name) -> Maybe Name -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TidyEnv -> Name -> Name
tidyNameOcc TidyEnv
env')) [Maybe Name]
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 (_, var_env :: VarEnv CoreBndr
var_env) n :: Name
n = case VarEnv CoreBndr -> Name -> Maybe CoreBndr
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM VarEnv CoreBndr
var_env Name
n of
                                Nothing -> Name
n
                                Just v :: CoreBndr
v  -> CoreBndr -> Name
idName CoreBndr
v

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

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

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

-- Non-top-level variables, not covars
tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
tidyIdBndr :: TidyEnv -> CoreBndr -> (TidyEnv, CoreBndr)
tidyIdBndr env :: TidyEnv
env@(tidy_env :: TidyOccEnv
tidy_env, var_env :: VarEnv CoreBndr
var_env) id :: CoreBndr
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 (CoreBndr -> OccName
forall a. NamedThing a => a -> OccName
getOccName CoreBndr
id) of { (tidy_env' :: TidyOccEnv
tidy_env', occ' :: 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 (CoreBndr -> Type
idType CoreBndr
id)
        name' :: Name
name'    = Unique -> OccName -> SrcSpan -> Name
mkInternalName (CoreBndr -> Unique
idUnique CoreBndr
id) OccName
occ' SrcSpan
noSrcSpan
        id' :: CoreBndr
id'      = Name -> Type -> IdInfo -> CoreBndr
mkLocalIdWithInfo Name
name' Type
ty' IdInfo
new_info
        var_env' :: VarEnv CoreBndr
var_env' = VarEnv CoreBndr -> CoreBndr -> CoreBndr -> VarEnv CoreBndr
forall a. VarEnv a -> CoreBndr -> a -> VarEnv a
extendVarEnv VarEnv CoreBndr
var_env CoreBndr
id CoreBndr
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 => CoreBndr -> IdInfo
CoreBndr -> IdInfo
idInfo CoreBndr
id
        old_unf :: Unfolding
old_unf  = IdInfo -> Unfolding
unfoldingInfo IdInfo
old_info
        new_unf :: Unfolding
new_unf  = Unfolding -> Unfolding
zapUnfolding Unfolding
old_unf  -- See Note [Preserve evaluatedness]
    in
    ((TidyOccEnv
tidy_env', VarEnv CoreBndr
var_env'), CoreBndr
id')
   }

tidyLetBndr :: TidyEnv         -- Knot-tied version for unfoldings
            -> TidyEnv         -- The one to extend
            -> (Id, CoreExpr) -> (TidyEnv, Var)
-- Used for local (non-top-level) let(rec)s
-- Just like tidyIdBndr above, but with more IdInfo
tidyLetBndr :: TidyEnv
-> TidyEnv -> (CoreBndr, Expr CoreBndr) -> (TidyEnv, CoreBndr)
tidyLetBndr rec_tidy_env :: TidyEnv
rec_tidy_env env :: TidyEnv
env@(tidy_env :: TidyOccEnv
tidy_env, var_env :: VarEnv CoreBndr
var_env) (id :: CoreBndr
id,rhs :: Expr CoreBndr
rhs)
  = case TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
tidyOccName TidyOccEnv
tidy_env (CoreBndr -> OccName
forall a. NamedThing a => a -> OccName
getOccName CoreBndr
id) of { (tidy_env' :: TidyOccEnv
tidy_env', occ' :: OccName
occ') ->
    let
        ty' :: Type
ty'      = TidyEnv -> Type -> Type
tidyType TidyEnv
env (CoreBndr -> Type
idType CoreBndr
id)
        name' :: Name
name'    = Unique -> OccName -> SrcSpan -> Name
mkInternalName (CoreBndr -> Unique
idUnique CoreBndr
id) OccName
occ' SrcSpan
noSrcSpan
        details :: IdDetails
details  = CoreBndr -> IdDetails
idDetails CoreBndr
id
        id' :: CoreBndr
id'      = IdDetails -> Name -> Type -> IdInfo -> CoreBndr
mkLocalVar IdDetails
details Name
name' Type
ty' IdInfo
new_info
        var_env' :: VarEnv CoreBndr
var_env' = VarEnv CoreBndr -> CoreBndr -> CoreBndr -> VarEnv CoreBndr
forall a. VarEnv a -> CoreBndr -> a -> VarEnv a
extendVarEnv VarEnv CoreBndr
var_env CoreBndr
id CoreBndr
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 WorkWrap)
        --
        -- Similarly arity info for eta expansion in CorePrep
        --
        -- Set inline-prag info so that we preseve it across
        -- separate compilation boundaries
        old_info :: IdInfo
old_info = HasDebugCallStack => CoreBndr -> IdInfo
CoreBndr -> IdInfo
idInfo CoreBndr
id
        new_info :: IdInfo
new_info = IdInfo
vanillaIdInfo
                    IdInfo -> OccInfo -> IdInfo
`setOccInfo`        IdInfo -> OccInfo
occInfo IdInfo
old_info
                    IdInfo -> Int -> IdInfo
`setArityInfo`      Expr CoreBndr -> Int
exprArity Expr CoreBndr
rhs
                    IdInfo -> StrictSig -> IdInfo
`setStrictnessInfo` StrictSig -> StrictSig
zapUsageEnvSig (IdInfo -> StrictSig
strictnessInfo 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
unfoldingInfo IdInfo
old_info
        new_unf :: Unfolding
new_unf | Unfolding -> Bool
isStableUnfolding Unfolding
old_unf = TidyEnv -> Unfolding -> Unfolding -> Unfolding
tidyUnfolding TidyEnv
rec_tidy_env Unfolding
old_unf Unfolding
old_unf
                | Bool
otherwise                 = Unfolding -> Unfolding
zapUnfolding Unfolding
old_unf
                                              -- See Note [Preserve evaluatedness]
    in
    ((TidyOccEnv
tidy_env', VarEnv CoreBndr
var_env'), CoreBndr
id') }

------------ Unfolding  --------------
tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
tidyUnfolding tidy_env :: TidyEnv
tidy_env df :: Unfolding
df@(DFunUnfolding { df_bndrs :: Unfolding -> [CoreBndr]
df_bndrs = [CoreBndr]
bndrs, df_args :: Unfolding -> [Expr CoreBndr]
df_args = [Expr CoreBndr]
args }) _
  = Unfolding
df { df_bndrs :: [CoreBndr]
df_bndrs = [CoreBndr]
bndrs', df_args :: [Expr CoreBndr]
df_args = (Expr CoreBndr -> Expr CoreBndr)
-> [Expr CoreBndr] -> [Expr CoreBndr]
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Expr CoreBndr -> Expr CoreBndr
tidyExpr TidyEnv
tidy_env') [Expr CoreBndr]
args }
  where
    (tidy_env' :: TidyEnv
tidy_env', bndrs' :: [CoreBndr]
bndrs') = TidyEnv -> [CoreBndr] -> (TidyEnv, [CoreBndr])
tidyBndrs TidyEnv
tidy_env [CoreBndr]
bndrs

tidyUnfolding tidy_env :: TidyEnv
tidy_env
              unf :: Unfolding
unf@(CoreUnfolding { uf_tmpl :: Unfolding -> Expr CoreBndr
uf_tmpl = Expr CoreBndr
unf_rhs, uf_src :: Unfolding -> UnfoldingSource
uf_src = UnfoldingSource
src })
              unf_from_rhs :: Unfolding
unf_from_rhs
  | UnfoldingSource -> Bool
isStableSource UnfoldingSource
src
  = Unfolding -> Unfolding
seqIt (Unfolding -> Unfolding) -> Unfolding -> Unfolding
forall a b. (a -> b) -> a -> b
$ Unfolding
unf { uf_tmpl :: Expr CoreBndr
uf_tmpl = TidyEnv -> Expr CoreBndr -> Expr CoreBndr
tidyExpr TidyEnv
tidy_env Expr CoreBndr
unf_rhs }    -- Preserves OccInfo
    -- This seqIt avoids a space leak: otherwise the uf_is_value,
    -- uf_is_conlike, ... fields may retain a reference to the
    -- pre-tidied expression forever (ToIface doesn't look at them)

  | Bool
otherwise
  = Unfolding
unf_from_rhs
  where seqIt :: Unfolding -> Unfolding
seqIt unf :: Unfolding
unf = Unfolding -> ()
seqUnfolding Unfolding
unf () -> Unfolding -> Unfolding
forall a b. a -> b -> b
`seq` Unfolding
unf
tidyUnfolding _ unf :: Unfolding
unf _ = Unfolding
unf     -- NoUnfolding or OtherCon

{-
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 InlineRules, 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 [The oneShot function] in MkId.

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

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