compiler/simplCore/SimplEnv.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section[SimplMonad]{The simplifier Monad}
   5
   6 \begin{code}
   7 module SimplEnv (
   8         InId, InBind, InExpr, InAlt, InArg, InType, InBndr,
   9         OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr,
  10         InCoercion, OutCoercion,
  11
  12         -- The simplifier mode
  13         setMode, getMode, updMode,
  14
  15         -- Switch checker
  16         SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
  17         isAmongSimpl, intSwitchSet, switchIsOn,
  18
  19         setEnclosingCC, getEnclosingCC,
  20
  21         -- Environments
  22         SimplEnv(..), StaticEnv, pprSimplEnv,   -- Temp not abstract
  23         mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst,
  24         zapSubstEnv, setSubstEnv,
  25         getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
  26         getSimplRules, inGentleMode,
  27
  28         SimplSR(..), mkContEx, substId, lookupRecBndr,
  29
  30         simplNonRecBndr, simplRecBndrs, simplLamBndr, simplLamBndrs,
  31         simplBinder, simplBinders, addBndrRules,
  32         substExpr, substTy, mkCoreSubst,
  33
  34         -- Floats
  35         Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
  36         wrapFloats, floatBinds, setFloats, zapFloats, addRecFloats,
  37         doFloatFromRhs, getFloats
  38     ) where
  39
  40 #include "HsVersions.h"
  41
  42 import SimplMonad
  43 import IdInfo
  44 import CoreSyn
  45 import CoreUtils
  46 import CostCentre
  47 import Var
  48 import VarEnv
  49 import VarSet
  50 import OrdList
  51 import Id
  52 import qualified CoreSubst      ( Subst, mkSubst, substExpr, substSpec, substUnfolding )
  53 import qualified Type           ( substTy, substTyVarBndr )
  54 import Type hiding              ( substTy, substTyVarBndr )
  55 import Coercion
  56 import BasicTypes
  57 import DynFlags
  58 import MonadUtils
  59 import Outputable
  60 import FastString
  61
  62 import Data.List
  63 \end{code}
  64
  65 %************************************************************************
  66 %*                                                                      *
  67 \subsection[Simplify-types]{Type declarations}
  68 %*                                                                      *
  69 %************************************************************************
  70
  71 \begin{code}
  72 type InBndr     = CoreBndr
  73 type InId       = Id                    -- Not yet cloned
  74 type InType     = Type                  -- Ditto
  75 type InBind     = CoreBind
  76 type InExpr     = CoreExpr
  77 type InAlt      = CoreAlt
  78 type InArg      = CoreArg
  79 type InCoercion = Coercion
  80
  81 type OutBndr     = CoreBndr
  82 type OutId       = Id                   -- Cloned
  83 type OutTyVar    = TyVar                -- Cloned
  84 type OutType     = Type                 -- Cloned
  85 type OutCoercion = Coercion
  86 type OutBind     = CoreBind
  87 type OutExpr     = CoreExpr
  88 type OutAlt      = CoreAlt
  89 type OutArg      = CoreArg
  90 \end{code}
  91
  92 %************************************************************************
  93 %*                                                                      *
  94 \subsubsection{The @SimplEnv@ type}
  95 %*                                                                      *
  96 %************************************************************************
  97
  98
  99 \begin{code}
 100 data SimplEnv
 101   = SimplEnv {
 102      ----------- Static part of the environment -----------
 103      -- Static in the sense of lexically scoped,
 104      -- wrt the original expression
 105
 106         seMode      :: SimplifierMode,
 107         seChkr      :: SwitchChecker,
 108         seCC        :: CostCentreStack, -- The enclosing CCS (when profiling)
 109
 110         -- The current substitution
 111         seTvSubst   :: TvSubstEnv,      -- InTyVar |--> OutType
 112         seIdSubst   :: SimplIdSubst,    -- InId    |--> OutExpr
 113
 114      ----------- Dynamic part of the environment -----------
 115      -- Dynamic in the sense of describing the setup where
 116      -- the expression finally ends up
 117
 118         -- The current set of in-scope variables
 119         -- They are all OutVars, and all bound in this module
 120         seInScope   :: InScopeSet,      -- OutVars only
 121                 -- Includes all variables bound by seFloats
 122         seFloats    :: Floats
 123                 -- See Note [Simplifier floats]
 124     }
 125
 126 type StaticEnv = SimplEnv       -- Just the static part is relevant
 127
 128 pprSimplEnv :: SimplEnv -> SDoc
 129 -- Used for debugging; selective
 130 pprSimplEnv env
 131   = vcat [ptext (sLit "TvSubst:") <+> ppr (seTvSubst env),
 132           ptext (sLit "IdSubst:") <+> ppr (seIdSubst env) ]
 133
 134 type SimplIdSubst = IdEnv SimplSR       -- IdId |--> OutExpr
 135         -- See Note [Extending the Subst] in CoreSubst
 136
 137 data SimplSR
 138   = DoneEx OutExpr              -- Completed term
 139   | DoneId OutId                -- Completed term variable
 140   | ContEx TvSubstEnv           -- A suspended substitution
 141            SimplIdSubst
 142            InExpr
 143
 144 instance Outputable SimplSR where
 145   ppr (DoneEx e) = ptext (sLit "DoneEx") <+> ppr e
 146   ppr (DoneId v) = ptext (sLit "DoneId") <+> ppr v
 147   ppr (ContEx _tv _id e) = vcat [ptext (sLit "ContEx") <+> ppr e {-,
 148                                 ppr (filter_env tv), ppr (filter_env id) -}]
 149         -- where
 150         -- fvs = exprFreeVars e
 151         -- filter_env env = filterVarEnv_Directly keep env
 152         -- keep uniq _ = uniq `elemUFM_Directly` fvs
 153 \end{code}
 154
 155
 156 seInScope:
 157         The in-scope part of Subst includes *all* in-scope TyVars and Ids
 158         The elements of the set may have better IdInfo than the
 159         occurrences of in-scope Ids, and (more important) they will
 160         have a correctly-substituted type.  So we use a lookup in this
 161         set to replace occurrences
 162
 163         The Ids in the InScopeSet are replete with their Rules,
 164         and as we gather info about the unfolding of an Id, we replace
 165         it in the in-scope set.
 166
 167         The in-scope set is actually a mapping OutVar -> OutVar, and
 168         in case expressions we sometimes bind
 169
 170 seIdSubst:
 171         The substitution is *apply-once* only, because InIds and OutIds can overlap.
 172         For example, we generally omit mappings
 173                 a77 -> a77
 174         from the substitution, when we decide not to clone a77, but it's quite
 175         legitimate to put the mapping in the substitution anyway.
 176
 177         Furthermore, consider
 178                 let x = case k of I# x77 -> ... in
 179                 let y = case k of I# x77 -> ... in ...
 180         and suppose the body is strict in both x and y.  Then the simplifier
 181         will pull the first (case k) to the top; so the second (case k) will
 182         cancel out, mapping x77 to, well, x77!  But one is an in-Id and the
 183         other is an out-Id.
 184
 185         Of course, the substitution *must* applied! Things in its domain
 186         simply aren't necessarily bound in the result.
 187
 188 * substId adds a binding (DoneId new_id) to the substitution if
 189         the Id's unique has changed
 190
 191
 192   Note, though that the substitution isn't necessarily extended
 193   if the type changes.  Why not?  Because of the next point:
 194
 195 * We *always, always* finish by looking up in the in-scope set
 196   any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
 197   Reason: so that we never finish up with a "old" Id in the result.
 198   An old Id might point to an old unfolding and so on... which gives a space leak.
 199
 200   [The DoneEx and DoneVar hits map to "new" stuff.]
 201
 202 * It follows that substExpr must not do a no-op if the substitution is empty.
 203   substType is free to do so, however.
 204
 205 * When we come to a let-binding (say) we generate new IdInfo, including an
 206   unfolding, attach it to the binder, and add this newly adorned binder to
 207   the in-scope set.  So all subsequent occurrences of the binder will get mapped
 208   to the full-adorned binder, which is also the one put in the binding site.
 209
 210 * The in-scope "set" usually maps x->x; we use it simply for its domain.
 211   But sometimes we have two in-scope Ids that are synomyms, and should
 212   map to the same target:  x->x, y->x.  Notably:
 213         case y of x { ... }
 214   That's why the "set" is actually a VarEnv Var
 215
 216
 217 \begin{code}
 218 mkSimplEnv :: SwitchChecker -> SimplifierMode -> SimplEnv
 219 mkSimplEnv switches mode
 220   = SimplEnv { seChkr = switches, seCC = subsumedCCS,
 221                seMode = mode, seInScope = emptyInScopeSet,
 222                seFloats = emptyFloats,
 223                seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
 224         -- The top level "enclosing CC" is "SUBSUMED".
 225
 226 ---------------------
 227 getSwitchChecker :: SimplEnv -> SwitchChecker
 228 getSwitchChecker env = seChkr env
 229
 230 ---------------------
 231 getMode :: SimplEnv -> SimplifierMode
 232 getMode env = seMode env
 233
 234 setMode :: SimplifierMode -> SimplEnv -> SimplEnv
 235 setMode mode env = env { seMode = mode }
 236
 237 updMode :: (SimplifierMode -> SimplifierMode) -> SimplEnv -> SimplEnv
 238 updMode upd env = env { seMode = upd (seMode env) }
 239
 240 inGentleMode :: SimplEnv -> Bool
 241 inGentleMode env = case seMode env of
 242                         SimplGently {} -> True
 243                         _other         -> False
 244
 245 ---------------------
 246 getEnclosingCC :: SimplEnv -> CostCentreStack
 247 getEnclosingCC env = seCC env
 248
 249 setEnclosingCC :: SimplEnv -> CostCentreStack -> SimplEnv
 250 setEnclosingCC env cc = env {seCC = cc}
 251
 252 ---------------------
 253 extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv
 254 extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res
 255   = env {seIdSubst = extendVarEnv subst var res}
 256
 257 extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
 258 extendTvSubst env@(SimplEnv {seTvSubst = subst}) var res
 259   = env {seTvSubst = extendVarEnv subst var res}
 260
 261 ---------------------
 262 getInScope :: SimplEnv -> InScopeSet
 263 getInScope env = seInScope env
 264
 265 setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
 266 setInScopeSet env in_scope = env {seInScope = in_scope}
 267
 268 setInScope :: SimplEnv -> SimplEnv -> SimplEnv
 269 -- Set the in-scope set, and *zap* the floats
 270 setInScope env env_with_scope
 271   = env { seInScope = seInScope env_with_scope,
 272           seFloats = emptyFloats }
 273
 274 setFloats :: SimplEnv -> SimplEnv -> SimplEnv
 275 -- Set the in-scope set *and* the floats
 276 setFloats env env_with_floats
 277   = env { seInScope = seInScope env_with_floats,
 278           seFloats  = seFloats  env_with_floats }
 279
 280 addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
 281         -- The new Ids are guaranteed to be freshly allocated
 282 addNewInScopeIds env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) vs
 283   = env { seInScope = in_scope `extendInScopeSetList` vs,
 284           seIdSubst = id_subst `delVarEnvList` vs }
 285         -- Why delete?  Consider
 286         --      let x = a*b in (x, \x -> x+3)
 287         -- We add [x |-> a*b] to the substitution, but we must
 288         -- _delete_ it from the substitution when going inside
 289         -- the (\x -> ...)!
 290
 291 modifyInScope :: SimplEnv -> CoreBndr -> SimplEnv
 292 -- The variable should already be in scope, but
 293 -- replace the existing version with this new one
 294 -- which has more information
 295 modifyInScope env@(SimplEnv {seInScope = in_scope}) v
 296   = env {seInScope = extendInScopeSet in_scope v}
 297
 298 ---------------------
 299 zapSubstEnv :: SimplEnv -> SimplEnv
 300 zapSubstEnv env = env {seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}
 301
 302 setSubstEnv :: SimplEnv -> TvSubstEnv -> SimplIdSubst -> SimplEnv
 303 setSubstEnv env tvs ids = env { seTvSubst = tvs, seIdSubst = ids }
 304
 305 mkContEx :: SimplEnv -> InExpr -> SimplSR
 306 mkContEx (SimplEnv { seTvSubst = tvs, seIdSubst = ids }) e = ContEx tvs ids e
 307 \end{code}
 308
 309
 310
 311 %************************************************************************
 312 %*                                                                      *
 313 \subsection{Floats}
 314 %*                                                                      *
 315 %************************************************************************
 316
 317 Note [Simplifier floats]
 318 ~~~~~~~~~~~~~~~~~~~~~~~~~
 319 The Floats is a bunch of bindings, classified by a FloatFlag.
 320
 321   NonRec x (y:ys)       FltLifted
 322   Rec [(x,rhs)]         FltLifted
 323
 324   NonRec x# (y +# 3)    FltOkSpec       -- Unboxed, but ok-for-spec'n
 325
 326   NonRec x# (a /# b)    FltCareful
 327   NonRec x* (f y)       FltCareful      -- Strict binding; might fail or diverge
 328   NonRec x# (f y)       FltCareful      -- Unboxed binding: might fail or diverge
 329                                         --        (where f :: Int -> Int#)
 330
 331 \begin{code}
 332 data Floats = Floats (OrdList OutBind) FloatFlag
 333         -- See Note [Simplifier floats]
 334
 335 data FloatFlag
 336   = FltLifted   -- All bindings are lifted and lazy
 337                 --  Hence ok to float to top level, or recursive
 338
 339   | FltOkSpec   -- All bindings are FltLifted *or*
 340                 --      strict (perhaps because unlifted,
 341                 --      perhaps because of a strict binder),
 342                 --        *and* ok-for-speculation
 343                 --  Hence ok to float out of the RHS
 344                 --  of a lazy non-recursive let binding
 345                 --  (but not to top level, or into a rec group)
 346
 347   | FltCareful  -- At least one binding is strict (or unlifted)
 348                 --      and not guaranteed cheap
 349                 --      Do not float these bindings out of a lazy let
 350
 351 instance Outputable Floats where
 352   ppr (Floats binds ff) = ppr ff $$ ppr (fromOL binds)
 353
 354 instance Outputable FloatFlag where
 355   ppr FltLifted = ptext (sLit "FltLifted")
 356   ppr FltOkSpec = ptext (sLit "FltOkSpec")
 357   ppr FltCareful = ptext (sLit "FltCareful")
 358
 359 andFF :: FloatFlag -> FloatFlag -> FloatFlag
 360 andFF FltCareful _          = FltCareful
 361 andFF FltOkSpec  FltCareful = FltCareful
 362 andFF FltOkSpec  _          = FltOkSpec
 363 andFF FltLifted  flt        = flt
 364
 365 classifyFF :: CoreBind -> FloatFlag
 366 classifyFF (Rec _) = FltLifted
 367 classifyFF (NonRec bndr rhs)
 368   | not (isStrictId bndr)    = FltLifted
 369   | exprOkForSpeculation rhs = FltOkSpec
 370   | otherwise                = FltCareful
 371
 372 doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> OutExpr -> SimplEnv -> Bool
 373 doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff})
 374   =  not (isNilOL fs) && want_to_float && can_float
 375   where
 376      want_to_float = isTopLevel lvl || exprIsExpandable rhs
 377      can_float = case ff of
 378                    FltLifted  -> True
 379                    FltOkSpec  -> isNotTopLevel lvl && isNonRec rec
 380                    FltCareful -> isNotTopLevel lvl && isNonRec rec && str
 381 \end{code}
 382
 383
 384 \begin{code}
 385 emptyFloats :: Floats
 386 emptyFloats = Floats nilOL FltLifted
 387
 388 unitFloat :: OutBind -> Floats
 389 -- A single-binding float
 390 unitFloat bind = Floats (unitOL bind) (classifyFF bind)
 391
 392 addNonRec :: SimplEnv -> OutId -> OutExpr -> SimplEnv
 393 -- Add a non-recursive binding and extend the in-scope set
 394 -- The latter is important; the binder may already be in the
 395 -- in-scope set (although it might also have been created with newId)
 396 -- but it may now have more IdInfo
 397 addNonRec env id rhs
 398   = env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
 399           seInScope = extendInScopeSet (seInScope env) id }
 400
 401 extendFloats :: SimplEnv -> OutBind -> SimplEnv
 402 -- Add these bindings to the floats, and extend the in-scope env too
 403 extendFloats env bind
 404   = env { seFloats  = seFloats env `addFlts` unitFloat bind,
 405           seInScope = extendInScopeSetList (seInScope env) bndrs }
 406   where
 407     bndrs = bindersOf bind
 408
 409 addFloats :: SimplEnv -> SimplEnv -> SimplEnv
 410 -- Add the floats for env2 to env1;
 411 -- *plus* the in-scope set for env2, which is bigger
 412 -- than that for env1
 413 addFloats env1 env2
 414   = env1 {seFloats = seFloats env1 `addFlts` seFloats env2,
 415           seInScope = seInScope env2 }
 416
 417 addFlts :: Floats -> Floats -> Floats
 418 addFlts (Floats bs1 l1) (Floats bs2 l2)
 419   = Floats (bs1 `appOL` bs2) (l1 `andFF` l2)
 420
 421 zapFloats :: SimplEnv -> SimplEnv
 422 zapFloats env = env { seFloats = emptyFloats }
 423
 424 addRecFloats :: SimplEnv -> SimplEnv -> SimplEnv
 425 -- Flattens the floats from env2 into a single Rec group,
 426 -- prepends the floats from env1, and puts the result back in env2
 427 -- This is all very specific to the way recursive bindings are
 428 -- handled; see Simplify.simplRecBind
 429 addRecFloats env1 env2@(SimplEnv {seFloats = Floats bs ff})
 430   = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) )
 431     env2 {seFloats = seFloats env1 `addFlts` unitFloat (Rec (flattenBinds (fromOL bs)))}
 432
 433 wrapFloats :: SimplEnv -> OutExpr -> OutExpr
 434 wrapFloats env expr = wrapFlts (seFloats env) expr
 435
 436 wrapFlts :: Floats -> OutExpr -> OutExpr
 437 -- Wrap the floats around the expression, using case-binding where necessary
 438 wrapFlts (Floats bs _) body = foldrOL wrap body bs
 439   where
 440     wrap (Rec prs)    body = Let (Rec prs) body
 441     wrap (NonRec b r) body = bindNonRec b r body
 442
 443 getFloats :: SimplEnv -> [CoreBind]
 444 getFloats (SimplEnv {seFloats = Floats bs _}) = fromOL bs
 445
 446 isEmptyFloats :: SimplEnv -> Bool
 447 isEmptyFloats env = isEmptyFlts (seFloats env)
 448
 449 isEmptyFlts :: Floats -> Bool
 450 isEmptyFlts (Floats bs _) = isNilOL bs
 451
 452 floatBinds :: Floats -> [OutBind]
 453 floatBinds (Floats bs _) = fromOL bs
 454 \end{code}
 455
 456
 457 %************************************************************************
 458 %*                                                                      *
 459                 Substitution of Vars
 460 %*                                                                      *
 461 %************************************************************************
 462
 463 Note [Global Ids in the substitution]
 464 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 465 We look up even a global (eg imported) Id in the substitution. Consider
 466    case X.g_34 of b { (a,b) ->  ... case X.g_34 of { (p,q) -> ...} ... }
 467 The binder-swap in the occurence analyser will add a binding
 468 for a LocalId version of g (with the same unique though):
 469    case X.g_34 of b { (a,b) ->  let g_34 = b in
 470                                 ... case X.g_34 of { (p,q) -> ...} ... }
 471 So we want to look up the inner X.g_34 in the substitution, where we'll
 472 find that it has been substituted by b.  (Or conceivably cloned.)
 473
 474 \begin{code}
 475 substId :: SimplEnv -> InId -> SimplSR
 476 -- Returns DoneEx only on a non-Var expression
 477 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
 478   = case lookupVarEnv ids v of          -- Note [Global Ids in the substitution]
 479         Nothing               -> DoneId (refine in_scope v)
 480         Just (DoneId v)       -> DoneId (refine in_scope v)
 481         Just (DoneEx (Var v)) -> DoneId (refine in_scope v)
 482         Just res              -> res    -- DoneEx non-var, or ContEx
 483   where
 484
 485         -- Get the most up-to-date thing from the in-scope set
 486         -- Even though it isn't in the substitution, it may be in
 487         -- the in-scope set with better IdInfo
 488 refine :: InScopeSet -> Var -> Var
 489 refine in_scope v
 490   | isLocalId v = case lookupInScope in_scope v of
 491                          Just v' -> v'
 492                          Nothing -> WARN( True, ppr v ) v       -- This is an error!
 493   | otherwise = v
 494
 495 lookupRecBndr :: SimplEnv -> InId -> OutId
 496 -- Look up an Id which has been put into the envt by simplRecBndrs,
 497 -- but where we have not yet done its RHS
 498 lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
 499   = case lookupVarEnv ids v of
 500         Just (DoneId v) -> v
 501         Just _ -> pprPanic "lookupRecBndr" (ppr v)
 502         Nothing -> refine in_scope v
 503 \end{code}
 504
 505
 506 %************************************************************************
 507 %*                                                                      *
 508 \section{Substituting an Id binder}
 509 %*                                                                      *
 510 %************************************************************************
 511
 512
 513 These functions are in the monad only so that they can be made strict via seq.
 514
 515 \begin{code}
 516 simplBinders, simplLamBndrs
 517         :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
 518 simplBinders  env bndrs = mapAccumLM simplBinder  env bndrs
 519 simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs
 520
 521 -------------
 522 simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
 523 -- Used for lambda and case-bound variables
 524 -- Clone Id if necessary, substitute type
 525 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
 526 -- The substitution is extended only if the variable is cloned, because
 527 -- we *don't* need to use it to track occurrence info.
 528 simplBinder env bndr
 529   | isTyVar bndr  = do  { let (env', tv) = substTyVarBndr env bndr
 530                         ; seqTyVar tv `seq` return (env', tv) }
 531   | otherwise     = do  { let (env', id) = substIdBndr env bndr
 532                         ; seqId id `seq` return (env', id) }
 533
 534 -------------
 535 simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
 536 -- Used for lambda binders.  These sometimes have unfoldings added by
 537 -- the worker/wrapper pass that must be preserved, because they can't
 538 -- be reconstructed from context.  For example:
 539 --      f x = case x of (a,b) -> fw a b x
 540 --      fw a b x{=(a,b)} = ...
 541 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
 542 simplLamBndr env bndr
 543   | isId bndr && hasSomeUnfolding old_unf = seqId id2 `seq` return (env2, id2)  -- Special case
 544   | otherwise                             = simplBinder env bndr                -- Normal case
 545   where
 546     old_unf = idUnfolding bndr
 547     (env1, id1) = substIdBndr env bndr
 548     id2  = id1 `setIdUnfolding` substUnfolding env old_unf
 549     env2 = modifyInScope env1 id2
 550
 551 ---------------
 552 simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
 553 -- A non-recursive let binder
 554 simplNonRecBndr env id
 555   = do  { let (env1, id1) = substIdBndr env id
 556         ; seqId id1 `seq` return (env1, id1) }
 557
 558 ---------------
 559 simplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv
 560 -- Recursive let binders
 561 simplRecBndrs env@(SimplEnv {}) ids
 562   = do  { let (env1, ids1) = mapAccumL substIdBndr env ids
 563         ; seqIds ids1 `seq` return env1 }
 564
 565 ---------------
 566 substIdBndr :: SimplEnv
 567             -> InBndr   -- Env and binder to transform
 568             -> (SimplEnv, OutBndr)
 569 -- Clone Id if necessary, substitute its type
 570 -- Return an Id with its
 571 --      * Type substituted
 572 --      * UnfoldingInfo, Rules, WorkerInfo zapped
 573 --      * Fragile OccInfo (only) zapped: Note [Robust OccInfo]
 574 --      * Robust info, retained especially arity and demand info,
 575 --         so that they are available to occurrences that occur in an
 576 --         earlier binding of a letrec
 577 --
 578 -- For the robust info, see Note [Arity robustness]
 579 --
 580 -- Augment the substitution  if the unique changed
 581 -- Extend the in-scope set with the new Id
 582 --
 583 -- Similar to CoreSubst.substIdBndr, except that
 584 --      the type of id_subst differs
 585 --      all fragile info is zapped
 586
 587 substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst })
 588                old_id
 589   = (env { seInScope = in_scope `extendInScopeSet` new_id,
 590            seIdSubst = new_subst }, new_id)
 591   where
 592     id1    = uniqAway in_scope old_id
 593     id2    = substIdType env id1
 594     new_id = zapFragileIdInfo id2       -- Zaps rules, worker-info, unfolding
 595                                         -- and fragile OccInfo
 596
 597         -- Extend the substitution if the unique has changed,
 598         -- or there's some useful occurrence information
 599         -- See the notes with substTyVarBndr for the delSubstEnv
 600     new_subst | new_id /= old_id
 601               = extendVarEnv id_subst old_id (DoneId new_id)
 602               | otherwise
 603               = delVarEnv id_subst old_id
 604 \end{code}
 605
 606 \begin{code}
 607 ------------------------------------
 608 seqTyVar :: TyVar -> ()
 609 seqTyVar b = b `seq` ()
 610
 611 seqId :: Id -> ()
 612 seqId id = seqType (idType id)  `seq`
 613            idInfo id            `seq`
 614            ()
 615
 616 seqIds :: [Id] -> ()
 617 seqIds []       = ()
 618 seqIds (id:ids) = seqId id `seq` seqIds ids
 619 \end{code}
 620
 621
 622 Note [Arity robustness]
 623 ~~~~~~~~~~~~~~~~~~~~~~~
 624 We *do* transfer the arity from from the in_id of a let binding to the
 625 out_id.  This is important, so that the arity of an Id is visible in
 626 its own RHS.  For example:
 627         f = \x. ....g (\y. f y)....
 628 We can eta-reduce the arg to g, becuase f is a value.  But that
 629 needs to be visible.
 630
 631 This interacts with the 'state hack' too:
 632         f :: Bool -> IO Int
 633         f = \x. case x of
 634                   True  -> f y
 635                   False -> \s -> ...
 636 Can we eta-expand f?  Only if we see that f has arity 1, and then we
 637 take advantage of the 'state hack' on the result of
 638 (f y) :: State# -> (State#, Int) to expand the arity one more.
 639
 640 There is a disadvantage though.  Making the arity visible in the RHS
 641 allows us to eta-reduce
 642         f = \x -> f x
 643 to
 644         f = f
 645 which technically is not sound.   This is very much a corner case, so
 646 I'm not worried about it.  Another idea is to ensure that f's arity
 647 never decreases; its arity started as 1, and we should never eta-reduce
 648 below that.
 649
 650
 651 Note [Robust OccInfo]
 652 ~~~~~~~~~~~~~~~~~~~~~
 653 It's important that we *do* retain the loop-breaker OccInfo, because
 654 that's what stops the Id getting inlined infinitely, in the body of
 655 the letrec.
 656
 657
 658 Note [Rules in a letrec]
 659 ~~~~~~~~~~~~~~~~~~~~~~~~
 660 After creating fresh binders for the binders of a letrec, we
 661 substitute the RULES and add them back onto the binders; this is done
 662 *before* processing any of the RHSs.  This is important.  Manuel found
 663 cases where he really, really wanted a RULE for a recursive function
 664 to apply in that function's own right-hand side.
 665
 666 See Note [Loop breaking and RULES] in OccAnal.
 667
 668
 669 \begin{code}
 670 addBndrRules :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr)
 671 -- Rules are added back in to to the bin
 672 addBndrRules env in_id out_id
 673   | isEmptySpecInfo old_rules = (env, out_id)
 674   | otherwise = (modifyInScope env final_id, final_id)
 675   where
 676     subst     = mkCoreSubst env
 677     old_rules = idSpecialisation in_id
 678     new_rules = CoreSubst.substSpec subst out_id old_rules
 679     final_id  = out_id `setIdSpecialisation` new_rules
 680 \end{code}
 681
 682
 683 %************************************************************************
 684 %*                                                                      *
 685                 Impedence matching to type substitution
 686 %*                                                                      *
 687 %************************************************************************
 688
 689 \begin{code}
 690 substTy :: SimplEnv -> Type -> Type
 691 substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
 692   = Type.substTy (TvSubst in_scope tv_env) ty
 693
 694 substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
 695 substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
 696   = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
 697         (TvSubst in_scope' tv_env', tv')
 698            -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')
 699
 700 -- When substituting in rules etc we can get CoreSubst to do the work
 701 -- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
 702 -- here.  I think the this will not usually result in a lot of work;
 703 -- the substitutions are typically small, and laziness will avoid work in many cases.
 704
 705 mkCoreSubst  :: SimplEnv -> CoreSubst.Subst
 706 mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
 707   = mk_subst tv_env id_env
 708   where
 709     mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
 710
 711     fiddle (DoneEx e)       = e
 712     fiddle (DoneId v)       = Var v
 713     fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
 714
 715 ------------------
 716 substIdType :: SimplEnv -> Id -> Id
 717 substIdType (SimplEnv { seInScope = in_scope,  seTvSubst = tv_env}) id
 718   | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
 719   | otherwise   = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
 720                 -- The tyVarsOfType is cheaper than it looks
 721                 -- because we cache the free tyvars of the type
 722                 -- in a Note in the id's type itself
 723   where
 724     old_ty = idType id
 725
 726 ------------------
 727 substExpr :: SimplEnv -> CoreExpr -> CoreExpr
 728 substExpr env expr = CoreSubst.substExpr (mkCoreSubst env) expr
 729   -- Do *not* short-cut in the case of an empty substitution
 730   -- See CoreSubst: Note [Extending the Subst]
 731
 732 substUnfolding :: SimplEnv -> Unfolding -> Unfolding
 733 substUnfolding env unf = CoreSubst.substUnfolding (mkCoreSubst env) unf
 734 \end{code}
 735