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