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