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