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