compiler/coreSyn/CoreSubst.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 Utility functions on @Core@ syntax
   7
   8 \begin{code}
   9 module CoreSubst (
  10         -- * Main data types
  11         Subst, TvSubstEnv, IdSubstEnv, InScopeSet,
  12
  13         -- ** Substituting into expressions and related types
  14         deShadowBinds,
  15         substTy, substExpr, substSpec, substUnfolding,
  16         lookupIdSubst, lookupTvSubst,
  17
  18         -- ** Operations on substitutions
  19         emptySubst, mkEmptySubst, mkSubst, substInScope, isEmptySubst,
  20         extendIdSubst, extendIdSubstList, extendTvSubst, extendTvSubstList,
  21         extendSubst, extendSubstList, zapSubstEnv,
  22         extendInScope, extendInScopeList, extendInScopeIds,
  23         isInScope,
  24
  25         -- ** Substituting and cloning binders
  26         substBndr, substBndrs, substRecBndrs,
  27         cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs,
  28
  29         -- ** Simple expression optimiser
  30         simpleOptExpr
  31     ) where
  32
  33 #include "HsVersions.h"
  34
  35 import CoreSyn
  36 import CoreFVs
  37 import CoreUtils
  38 import OccurAnal( occurAnalyseExpr )
  39
  40 import qualified Type
  41 import Type     ( Type, TvSubst(..), TvSubstEnv )
  42 import VarSet
  43 import VarEnv
  44 import Id
  45 import Var      ( Var, TyVar, setVarUnique )
  46 import IdInfo
  47 import Unique
  48 import UniqSupply
  49 import Maybes
  50 import Outputable
  51 import PprCore          ()              -- Instances
  52 import FastString
  53
  54 import Data.List
  55 \end{code}
  56
  57
  58 %************************************************************************
  59 %*                                                                      *
  60 \subsection{Substitutions}
  61 %*                                                                      *
  62 %************************************************************************
  63
  64 \begin{code}
  65 -- | A substitution environment, containing both 'Id' and 'TyVar' substitutions.
  66 --
  67 -- Some invariants apply to how you use the substitution:
  68 --
  69 -- 1. #in_scope_invariant# The in-scope set contains at least those 'Id's and 'TyVar's that will be in scope /after/
  70 -- applying the substitution to a term. Precisely, the in-scope set must be a superset of the free vars of the
  71 -- substitution range that might possibly clash with locally-bound variables in the thing being substituted in.
  72 --
  73 -- 2. #apply_once# You may apply the substitution only /once/
  74 --
  75 -- There are various ways of setting up the in-scope set such that the first of these invariants hold:
  76 --
  77 -- * Arrange that the in-scope set really is all the things in scope
  78 --
  79 -- * Arrange that it's the free vars of the range of the substitution
  80 --
  81 -- * Make it empty, if you know that all the free vars of the substitution are fresh, and hence can't possibly clash
  82 data Subst
  83   = Subst InScopeSet  -- Variables in in scope (both Ids and TyVars) /after/
  84                       -- applying the substitution
  85           IdSubstEnv  -- Substitution for Ids
  86           TvSubstEnv  -- Substitution for TyVars
  87
  88         -- INVARIANT 1: See #in_scope_invariant#
  89         -- This is what lets us deal with name capture properly
  90         -- It's a hard invariant to check...
  91         --
  92         -- INVARIANT 2: The substitution is apply-once; see Note [Apply once] with
  93         --              Types.TvSubstEnv
  94         --
  95         -- INVARIANT 3: See Note [Extending the Subst]
  96 \end{code}
  97
  98 Note [Extending the Subst]
  99 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 100 For a core Subst, which binds Ids as well, we make a different choice for Ids
 101 than we do for TyVars.
 102
 103 For TyVars, see Note [Extending the TvSubst] with Type.TvSubstEnv
 104
 105 For Ids, we have a different invariant
 106         The IdSubstEnv is extended *only* when the Unique on an Id changes
 107         Otherwise, we just extend the InScopeSet
 108
 109 In consequence:
 110
 111 * In substIdBndr, we extend the IdSubstEnv only when the unique changes
 112
 113 * If the TvSubstEnv and IdSubstEnv are both empty, substExpr does nothing
 114   (Note that the above rule for substIdBndr maintains this property.  If
 115    the incoming envts are both empty, then substituting the type and
 116    IdInfo can't change anything.)
 117
 118 * In lookupIdSubst, we *must* look up the Id in the in-scope set, because
 119   it may contain non-trivial changes.  Example:
 120         (/\a. \x:a. ...x...) Int
 121   We extend the TvSubstEnv with [a |-> Int]; but x's unique does not change
 122   so we only extend the in-scope set.  Then we must look up in the in-scope
 123   set when we find the occurrence of x.
 124
 125 * The requirement to look up the Id in the in-scope set means that we
 126   must NOT take no-op short cut in the case the substitution is empty.
 127   We must still look up every Id in the in-scope set.
 128
 129 * (However, we don't need to do so for expressions found in the IdSubst
 130   itself, whose range is assumed to be correct wrt the in-scope set.)
 131
 132 Why do we make a different choice for the IdSubstEnv than the TvSubstEnv?
 133
 134 * For Ids, we change the IdInfo all the time (e.g. deleting the
 135   unfolding), and adding it back later, so using the TyVar convention
 136   would entail extending the substitution almost all the time
 137
 138 * The simplifier wants to look up in the in-scope set anyway, in case it
 139   can see a better unfolding from an enclosing case expression
 140
 141 * For TyVars, only coercion variables can possibly change, and they are
 142   easy to spot
 143
 144 \begin{code}
 145 -- | An environment for substituting for 'Id's
 146 type IdSubstEnv = IdEnv CoreExpr
 147
 148 ----------------------------
 149 isEmptySubst :: Subst -> Bool
 150 isEmptySubst (Subst _ id_env tv_env) = isEmptyVarEnv id_env && isEmptyVarEnv tv_env
 151
 152 emptySubst :: Subst
 153 emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv
 154
 155 mkEmptySubst :: InScopeSet -> Subst
 156 mkEmptySubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv
 157
 158 mkSubst :: InScopeSet -> TvSubstEnv -> IdSubstEnv -> Subst
 159 mkSubst in_scope tvs ids = Subst in_scope ids tvs
 160
 161 -- getTvSubst :: Subst -> TvSubst
 162 -- getTvSubst (Subst in_scope _ tv_env) = TvSubst in_scope tv_env
 163
 164 -- getTvSubstEnv :: Subst -> TvSubstEnv
 165 -- getTvSubstEnv (Subst _ _ tv_env) = tv_env
 166 --
 167 -- setTvSubstEnv :: Subst -> TvSubstEnv -> Subst
 168 -- setTvSubstEnv (Subst in_scope ids _) tvs = Subst in_scope ids tvs
 169
 170 -- | Find the in-scope set: see "CoreSubst#in_scope_invariant"
 171 substInScope :: Subst -> InScopeSet
 172 substInScope (Subst in_scope _ _) = in_scope
 173
 174 -- | Remove all substitutions for 'Id's and 'Var's that might have been built up
 175 -- while preserving the in-scope set
 176 zapSubstEnv :: Subst -> Subst
 177 zapSubstEnv (Subst in_scope _ _) = Subst in_scope emptyVarEnv emptyVarEnv
 178
 179 -- | Add a substitution for an 'Id' to the 'Subst': you must ensure that the in-scope set is
 180 -- such that the "CoreSubst#in_scope_invariant" is true after extending the substitution like this
 181 extendIdSubst :: Subst -> Id -> CoreExpr -> Subst
 182 -- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set
 183 extendIdSubst (Subst in_scope ids tvs) v r = Subst in_scope (extendVarEnv ids v r) tvs
 184
 185 -- | Adds multiple 'Id' substitutions to the 'Subst': see also 'extendIdSubst'
 186 extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst
 187 extendIdSubstList (Subst in_scope ids tvs) prs = Subst in_scope (extendVarEnvList ids prs) tvs
 188
 189 -- | Add a substitution for a 'TyVar' to the 'Subst': you must ensure that the in-scope set is
 190 -- such that the "CoreSubst#in_scope_invariant" is true after extending the substitution like this
 191 extendTvSubst :: Subst -> TyVar -> Type -> Subst
 192 extendTvSubst (Subst in_scope ids tvs) v r = Subst in_scope ids (extendVarEnv tvs v r)
 193
 194 -- | Adds multiple 'TyVar' substitutions to the 'Subst': see also 'extendTvSubst'
 195 extendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst
 196 extendTvSubstList (Subst in_scope ids tvs) prs = Subst in_scope ids (extendVarEnvList tvs prs)
 197
 198 -- | Add a substitution for a 'TyVar' or 'Id' as appropriate to the 'Var' being added. See also
 199 -- 'extendIdSubst' and 'extendTvSubst'
 200 extendSubst :: Subst -> Var -> CoreArg -> Subst
 201 extendSubst (Subst in_scope ids tvs) tv (Type ty)
 202   = ASSERT( isTyVar tv ) Subst in_scope ids (extendVarEnv tvs tv ty)
 203 extendSubst (Subst in_scope ids tvs) id expr
 204   = ASSERT( isId id ) Subst in_scope (extendVarEnv ids id expr) tvs
 205
 206 -- | Add a substitution for a 'TyVar' or 'Id' as appropriate to all the 'Var's being added. See also 'extendSubst'
 207 extendSubstList :: Subst -> [(Var,CoreArg)] -> Subst
 208 extendSubstList subst []              = subst
 209 extendSubstList subst ((var,rhs):prs) = extendSubstList (extendSubst subst var rhs) prs
 210
 211 -- | Find the substitution for an 'Id' in the 'Subst'
 212 lookupIdSubst :: Subst -> Id -> CoreExpr
 213 lookupIdSubst (Subst in_scope ids _) v
 214   | not (isLocalId v) = Var v
 215   | Just e  <- lookupVarEnv ids       v = e
 216   | Just v' <- lookupInScope in_scope v = Var v'
 217         -- Vital! See Note [Extending the Subst]
 218   | otherwise = WARN( True, ptext (sLit "CoreSubst.lookupIdSubst") <+> ppr v $$ ppr in_scope )
 219                 Var v
 220
 221 -- | Find the substitution for a 'TyVar' in the 'Subst'
 222 lookupTvSubst :: Subst -> TyVar -> Type
 223 lookupTvSubst (Subst _ _ tvs) v = lookupVarEnv tvs v `orElse` Type.mkTyVarTy v
 224
 225 ------------------------------
 226 isInScope :: Var -> Subst -> Bool
 227 isInScope v (Subst in_scope _ _) = v `elemInScopeSet` in_scope
 228
 229 -- | Add the 'Var' to the in-scope set: as a side effect, removes any existing substitutions for it
 230 extendInScope :: Subst -> Var -> Subst
 231 extendInScope (Subst in_scope ids tvs) v
 232   = Subst (in_scope `extendInScopeSet` v)
 233           (ids `delVarEnv` v) (tvs `delVarEnv` v)
 234
 235 -- | Add the 'Var's to the in-scope set: see also 'extendInScope'
 236 extendInScopeList :: Subst -> [Var] -> Subst
 237 extendInScopeList (Subst in_scope ids tvs) vs
 238   = Subst (in_scope `extendInScopeSetList` vs)
 239           (ids `delVarEnvList` vs) (tvs `delVarEnvList` vs)
 240
 241 -- | Optimized version of 'extendInScopeList' that can be used if you are certain
 242 -- all the things being added are 'Id's and hence none are 'TyVar's
 243 extendInScopeIds :: Subst -> [Id] -> Subst
 244 extendInScopeIds (Subst in_scope ids tvs) vs
 245   = Subst (in_scope `extendInScopeSetList` vs)
 246           (ids `delVarEnvList` vs) tvs
 247 \end{code}
 248
 249 Pretty printing, for debugging only
 250
 251 \begin{code}
 252 instance Outputable Subst where
 253   ppr (Subst in_scope ids tvs)
 254         =  ptext (sLit "<InScope =") <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
 255         $$ ptext (sLit " IdSubst   =") <+> ppr ids
 256         $$ ptext (sLit " TvSubst   =") <+> ppr tvs
 257          <> char '>'
 258 \end{code}
 259
 260
 261 %************************************************************************
 262 %*                                                                      *
 263         Substituting expressions
 264 %*                                                                      *
 265 %************************************************************************
 266
 267 \begin{code}
 268 -- | Apply a substititon to an entire 'CoreExpr'. Rememeber, you may only
 269 -- apply the substitution /once/: see "CoreSubst#apply_once"
 270 --
 271 -- Do *not* attempt to short-cut in the case of an empty substitution!
 272 -- See Note [Extending the Subst]
 273 substExpr :: Subst -> CoreExpr -> CoreExpr
 274 substExpr subst expr
 275   = go expr
 276   where
 277     go (Var v)         = lookupIdSubst subst v
 278     go (Type ty)       = Type (substTy subst ty)
 279     go (Lit lit)       = Lit lit
 280     go (App fun arg)   = App (go fun) (go arg)
 281     go (Note note e)   = Note (go_note note) (go e)
 282     go (Cast e co)     = Cast (go e) (substTy subst co)
 283     go (Lam bndr body) = Lam bndr' (substExpr subst' body)
 284                        where
 285                          (subst', bndr') = substBndr subst bndr
 286
 287     go (Let bind body) = Let bind' (substExpr subst' body)
 288                        where
 289                          (subst', bind') = substBind subst bind
 290
 291     go (Case scrut bndr ty alts) = Case (go scrut) bndr' (substTy subst ty) (map (go_alt subst') alts)
 292                                  where
 293                                  (subst', bndr') = substBndr subst bndr
 294
 295     go_alt subst (con, bndrs, rhs) = (con, bndrs', substExpr subst' rhs)
 296                                  where
 297                                    (subst', bndrs') = substBndrs subst bndrs
 298
 299     go_note note             = note
 300
 301 -- | Apply a substititon to an entire 'CoreBind', additionally returning an updated 'Subst'
 302 -- that should be used by subsequent substitutons.
 303 substBind :: Subst -> CoreBind -> (Subst, CoreBind)
 304 substBind subst (NonRec bndr rhs) = (subst', NonRec bndr' (substExpr subst rhs))
 305                                   where
 306                                     (subst', bndr') = substBndr subst bndr
 307
 308 substBind subst (Rec pairs) = (subst', Rec pairs')
 309                             where
 310                                 (subst', bndrs') = substRecBndrs subst (map fst pairs)
 311                                 pairs'  = bndrs' `zip` rhss'
 312                                 rhss'   = map (substExpr subst' . snd) pairs
 313 \end{code}
 314
 315 \begin{code}
 316 -- | De-shadowing the program is sometimes a useful pre-pass. It can be done simply
 317 -- by running over the bindings with an empty substitution, becuase substitution
 318 -- returns a result that has no-shadowing guaranteed.
 319 --
 320 -- (Actually, within a single /type/ there might still be shadowing, because
 321 -- 'substTy' is a no-op for the empty substitution, but that's probably OK.)
 322 deShadowBinds :: [CoreBind] -> [CoreBind]
 323 deShadowBinds binds = snd (mapAccumL substBind emptySubst binds)
 324 \end{code}
 325
 326
 327 %************************************************************************
 328 %*                                                                      *
 329         Substituting binders
 330 %*                                                                      *
 331 %************************************************************************
 332
 333 Remember that substBndr and friends are used when doing expression
 334 substitution only.  Their only business is substitution, so they
 335 preserve all IdInfo (suitably substituted).  For example, we *want* to
 336 preserve occ info in rules.
 337
 338 \begin{code}
 339 -- | Substitutes a 'Var' for another one according to the 'Subst' given, returning
 340 -- the result and an updated 'Subst' that should be used by subsequent substitutons.
 341 -- 'IdInfo' is preserved by this process, although it is substituted into appropriately.
 342 substBndr :: Subst -> Var -> (Subst, Var)
 343 substBndr subst bndr
 344   | isTyVar bndr  = substTyVarBndr subst bndr
 345   | otherwise     = substIdBndr subst subst bndr
 346
 347 -- | Applies 'substBndr' to a number of 'Var's, accumulating a new 'Subst' left-to-right
 348 substBndrs :: Subst -> [Var] -> (Subst, [Var])
 349 substBndrs subst bndrs = mapAccumL substBndr subst bndrs
 350
 351 -- | Substitute in a mutually recursive group of 'Id's
 352 substRecBndrs :: Subst -> [Id] -> (Subst, [Id])
 353 substRecBndrs subst bndrs
 354   = (new_subst, new_bndrs)
 355   where         -- Here's the reason we need to pass rec_subst to subst_id
 356     (new_subst, new_bndrs) = mapAccumL (substIdBndr new_subst) subst bndrs
 357 \end{code}
 358
 359
 360 \begin{code}
 361 substIdBndr :: Subst            -- ^ Substitution to use for the IdInfo
 362             -> Subst -> Id      -- ^ Substitition and Id to transform
 363             -> (Subst, Id)      -- ^ Transformed pair
 364                                 -- NB: unfolding may be zapped
 365
 366 substIdBndr rec_subst subst@(Subst in_scope env tvs) old_id
 367   = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
 368   where
 369     id1 = uniqAway in_scope old_id      -- id1 is cloned if necessary
 370     id2 | no_type_change = id1
 371         | otherwise      = setIdType id1 (substTy subst old_ty)
 372
 373     old_ty = idType old_id
 374     no_type_change = isEmptyVarEnv tvs ||
 375                      isEmptyVarSet (Type.tyVarsOfType old_ty)
 376
 377         -- new_id has the right IdInfo
 378         -- The lazy-set is because we're in a loop here, with
 379         -- rec_subst, when dealing with a mutually-recursive group
 380     new_id = maybeModifyIdInfo mb_new_info id2
 381     mb_new_info = substIdInfo rec_subst id2 (idInfo id2)
 382         -- NB: unfolding info may be zapped
 383
 384         -- Extend the substitution if the unique has changed
 385         -- See the notes with substTyVarBndr for the delVarEnv
 386     new_env | no_change = delVarEnv env old_id
 387             | otherwise = extendVarEnv env old_id (Var new_id)
 388
 389     no_change = id1 == old_id
 390         -- See Note [Extending the Subst]
 391         -- it's /not/ necessary to check mb_new_info and no_type_change
 392 \end{code}
 393
 394 Now a variant that unconditionally allocates a new unique.
 395 It also unconditionally zaps the OccInfo.
 396
 397 \begin{code}
 398 -- | Very similar to 'substBndr', but it always allocates a new 'Unique' for
 399 -- each variable in its output and removes all 'IdInfo'
 400 cloneIdBndr :: Subst -> UniqSupply -> Id -> (Subst, Id)
 401 cloneIdBndr subst us old_id
 402   = clone_id subst subst (old_id, uniqFromSupply us)
 403
 404 -- | Applies 'cloneIdBndr' to a number of 'Id's, accumulating a final
 405 -- substitution from left to right
 406 cloneIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
 407 cloneIdBndrs subst us ids
 408   = mapAccumL (clone_id subst) subst (ids `zip` uniqsFromSupply us)
 409
 410 -- | Clone a mutually recursive group of 'Id's
 411 cloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
 412 cloneRecIdBndrs subst us ids
 413   = (subst', ids')
 414   where
 415     (subst', ids') = mapAccumL (clone_id subst') subst
 416                                (ids `zip` uniqsFromSupply us)
 417
 418 -- Just like substIdBndr, except that it always makes a new unique
 419 -- It is given the unique to use
 420 clone_id    :: Subst                    -- Substitution for the IdInfo
 421             -> Subst -> (Id, Unique)    -- Substitition and Id to transform
 422             -> (Subst, Id)              -- Transformed pair
 423
 424 clone_id rec_subst subst@(Subst in_scope env tvs) (old_id, uniq)
 425   = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
 426   where
 427     id1     = setVarUnique old_id uniq
 428     id2     = substIdType subst id1
 429     new_id  = maybeModifyIdInfo (substIdInfo rec_subst id2 (idInfo old_id)) id2
 430     new_env = extendVarEnv env old_id (Var new_id)
 431 \end{code}
 432
 433
 434 %************************************************************************
 435 %*                                                                      *
 436                 Types
 437 %*                                                                      *
 438 %************************************************************************
 439
 440 For types we just call the corresponding function in Type, but we have
 441 to repackage the substitution, from a Subst to a TvSubst
 442
 443 \begin{code}
 444 substTyVarBndr :: Subst -> TyVar -> (Subst, TyVar)
 445 substTyVarBndr (Subst in_scope id_env tv_env) tv
 446   = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
 447         (TvSubst in_scope' tv_env', tv')
 448            -> (Subst in_scope' id_env tv_env', tv')
 449
 450 -- | See 'Type.substTy'
 451 substTy :: Subst -> Type -> Type
 452 substTy (Subst in_scope _id_env tv_env) ty
 453   = Type.substTy (TvSubst in_scope tv_env) ty
 454 \end{code}
 455
 456
 457 %************************************************************************
 458 %*                                                                      *
 459 \section{IdInfo substitution}
 460 %*                                                                      *
 461 %************************************************************************
 462
 463 \begin{code}
 464 substIdType :: Subst -> Id -> Id
 465 substIdType subst@(Subst _ _ tv_env) id
 466   | isEmptyVarEnv tv_env || isEmptyVarSet (Type.tyVarsOfType old_ty) = id
 467   | otherwise   = setIdType id (substTy subst old_ty)
 468                 -- The tyVarsOfType is cheaper than it looks
 469                 -- because we cache the free tyvars of the type
 470                 -- in a Note in the id's type itself
 471   where
 472     old_ty = idType id
 473
 474 ------------------
 475 -- | Substitute into some 'IdInfo' with regard to the supplied new 'Id'.
 476 -- Always zaps the unfolding, to save substitution work
 477 substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo
 478 substIdInfo subst new_id info
 479   | nothing_to_do = Nothing
 480   | otherwise     = Just (info `setSpecInfo`      substSpec subst new_id old_rules
 481                                `setUnfoldingInfo` substUnfolding subst old_unf)
 482   where
 483     old_rules     = specInfo info
 484     old_unf       = unfoldingInfo info
 485     nothing_to_do = isEmptySpecInfo old_rules && isClosedUnfolding old_unf
 486
 487
 488 ------------------
 489 -- | Substitutes for the 'Id's within an unfolding
 490 substUnfolding :: Subst -> Unfolding -> Unfolding
 491         -- Seq'ing on the returned Unfolding is enough to cause
 492         -- all the substitutions to happen completely
 493 substUnfolding subst unf@(InlineRule { uf_tmpl = tmpl, uf_worker = mb_wkr })
 494         -- Retain an InlineRule!
 495   = seqExpr new_tmpl `seq`
 496     new_mb_wkr `seq`
 497     unf { uf_tmpl = new_tmpl, uf_worker = new_mb_wkr }
 498   where
 499     new_tmpl   = substExpr subst tmpl
 500     new_mb_wkr = case mb_wkr of
 501                   Nothing -> Nothing
 502                   Just w  -> subst_wkr w
 503
 504     subst_wkr w = case lookupIdSubst subst w of
 505                     Var w1 -> Just w1
 506                     other  -> WARN( not (exprIsTrivial other), text "CoreSubst.substWorker:" <+> ppr w )
 507                               Nothing   -- Worker has got substituted away altogether
 508                                         -- (This can happen if it's trivial,
 509                                         --  via postInlineUnconditionally, hence warning)
 510
 511 substUnfolding _ (CoreUnfolding {}) = NoUnfolding       -- Discard
 512         -- Always zap a CoreUnfolding, to save substitution work
 513
 514 substUnfolding _ unf = unf      -- Otherwise no substitution to do
 515
 516 ------------------
 517 -- | Substitutes for the 'Id's within the 'WorkerInfo' given the new function 'Id'
 518 substSpec :: Subst -> Id -> SpecInfo -> SpecInfo
 519 substSpec subst new_fn (SpecInfo rules rhs_fvs)
 520   = seqSpecInfo new_rules `seq` new_rules
 521   where
 522     new_name = idName new_fn
 523     new_rules = SpecInfo (map do_subst rules) (substVarSet subst rhs_fvs)
 524
 525     do_subst rule@(BuiltinRule {}) = rule
 526     do_subst rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs })
 527         = rule { ru_bndrs = bndrs',
 528                  ru_fn    = new_name,   -- Important: the function may have changed its name!
 529                  ru_args  = map (substExpr subst') args,
 530                  ru_rhs   = substExpr subst' rhs }
 531         where
 532           (subst', bndrs') = substBndrs subst bndrs
 533
 534 ------------------
 535 substVarSet :: Subst -> VarSet -> VarSet
 536 substVarSet subst fvs
 537   = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
 538   where
 539     subst_fv subst fv
 540         | isId fv   = exprFreeVars (lookupIdSubst subst fv)
 541         | otherwise = Type.tyVarsOfType (lookupTvSubst subst fv)
 542 \end{code}
 543
 544 %************************************************************************
 545 %*                                                                      *
 546         The Very Simple Optimiser
 547 %*                                                                      *
 548 %************************************************************************
 549
 550 \begin{code}
 551 simpleOptExpr :: CoreExpr -> CoreExpr
 552 -- Return an occur-analysed and slightly optimised expression
 553 -- The optimisation is very straightforward: just
 554 -- inline non-recursive bindings that are used only once,
 555 -- or where the RHS is trivial
 556
 557 simpleOptExpr expr
 558   = go init_subst (occurAnalyseExpr expr)
 559   where
 560     init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr))
 561         -- It's potentially to make a proper in-scope set
 562         -- Consider  let x = ..y.. in \y. ...x...
 563         -- Then we should remember to clone y before substituting
 564         -- for x.  It's very unlikely to occur, because we probably
 565         -- won't *be* substituting for x if it occurs inside a
 566         -- lambda.
 567         --
 568         -- It's a bit painful to call exprFreeVars, because it makes
 569         -- three passes instead of two (occ-anal, and go)
 570
 571     go subst (Var v)          = lookupIdSubst subst v
 572     go subst (App e1 e2)      = App (go subst e1) (go subst e2)
 573     go subst (Type ty)        = Type (substTy subst ty)
 574     go _     (Lit lit)        = Lit lit
 575     go subst (Note note e)    = Note note (go subst e)
 576     go subst (Cast e co)      = Cast (go subst e) (substTy subst co)
 577     go subst (Let bind body)  = go_bind subst bind body
 578     go subst (Lam bndr body)  = Lam bndr' (go subst' body)
 579                               where
 580                                 (subst', bndr') = substBndr subst bndr
 581
 582     go subst (Case e b ty as) = Case (go subst e) b'
 583                                      (substTy subst ty)
 584                                      (map (go_alt subst') as)
 585                               where
 586                                  (subst', b') = substBndr subst b
 587
 588
 589     ----------------------
 590     go_alt subst (con, bndrs, rhs) = (con, bndrs', go subst' rhs)
 591                                  where
 592                                    (subst', bndrs') = substBndrs subst bndrs
 593
 594     ----------------------
 595     go_bind subst (Rec prs) body = Let (Rec (bndrs' `zip` rhss'))
 596                                        (go subst' body)
 597                             where
 598                               (bndrs, rhss)    = unzip prs
 599                               (subst', bndrs') = substRecBndrs subst bndrs
 600                               rhss'            = map (go subst') rhss
 601
 602     go_bind subst (NonRec b r) body = go_nonrec subst b (go subst r) body
 603
 604     ----------------------
 605     go_nonrec subst b (Type ty') body
 606       | isTyVar b = go (extendTvSubst subst b ty') body
 607         -- let a::* = TYPE ty in <body>
 608     go_nonrec subst b r' body
 609       | isId b  -- let x = e in <body>
 610       , exprIsTrivial r' || safe_to_inline (idOccInfo b)
 611       = go (extendIdSubst subst b r') body
 612     go_nonrec subst b r' body
 613       = Let (NonRec b' r') (go subst' body)
 614       where
 615         (subst', b') = substBndr subst b
 616
 617     ----------------------
 618         -- Unconditionally safe to inline
 619     safe_to_inline :: OccInfo -> Bool
 620     safe_to_inline IAmDead                  = True
 621     safe_to_inline (OneOcc in_lam one_br _) = not in_lam && one_br
 622     safe_to_inline (IAmALoopBreaker {})     = False
 623     safe_to_inline NoOccInfo                = False
 624 \end{code}