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