compiler/simplCore/SimplEnv.lhs

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