2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 Utility functions on @Core@ syntax
11 Subst, TvSubstEnv, IdSubstEnv, InScopeSet,
13 -- ** Substituting into expressions and related types
14 deShadowBinds, substSpec, substRulesForImportedIds,
15 substTy, substExpr, substBind, substUnfolding,
16 substInlineRuleInfo, lookupIdSubst, lookupTvSubst, substIdOcc,
18 -- ** Operations on substitutions
19 emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst,
20 extendIdSubst, extendIdSubstList, extendTvSubst, extendTvSubstList,
21 extendSubst, extendSubstList, zapSubstEnv,
22 extendInScope, extendInScopeList, extendInScopeIds,
25 -- ** Substituting and cloning binders
26 substBndr, substBndrs, substRecBndrs,
27 cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs,
29 -- ** Simple expression optimiser
33 #include "HsVersions.h"
38 import OccurAnal( occurAnalyseExpr )
41 import Type ( Type, TvSubst(..), TvSubstEnv )
46 import Var ( Var, TyVar, setVarUnique )
51 import BasicTypes ( isAlwaysActive )
53 import PprCore () -- Instances
60 %************************************************************************
62 \subsection{Substitutions}
64 %************************************************************************
67 -- | A substitution environment, containing both 'Id' and 'TyVar' substitutions.
69 -- Some invariants apply to how you use the substitution:
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.
75 -- 2. #apply_once# You may apply the substitution only /once/
77 -- There are various ways of setting up the in-scope set such that the first of these invariants hold:
79 -- * Arrange that the in-scope set really is all the things in scope
81 -- * Arrange that it's the free vars of the range of the substitution
83 -- * Make it empty, if you know that all the free vars of the substitution are fresh, and hence can't possibly clash
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
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...
94 -- INVARIANT 2: The substitution is apply-once; see Note [Apply once] with
97 -- INVARIANT 3: See Note [Extending the Subst]
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.
105 For TyVars, see Note [Extending the TvSubst] with Type.TvSubstEnv
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
113 * In substIdBndr, we extend the IdSubstEnv only when the unique changes
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.)
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.
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.
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.)
134 Why do we make a different choice for the IdSubstEnv than the TvSubstEnv?
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
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
143 * For TyVars, only coercion variables can possibly change, and they are
147 -- | An environment for substituting for 'Id's
148 type IdSubstEnv = IdEnv CoreExpr
150 ----------------------------
151 isEmptySubst :: Subst -> Bool
152 isEmptySubst (Subst _ id_env tv_env) = isEmptyVarEnv id_env && isEmptyVarEnv tv_env
155 emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv
157 mkEmptySubst :: InScopeSet -> Subst
158 mkEmptySubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv
160 mkSubst :: InScopeSet -> TvSubstEnv -> IdSubstEnv -> Subst
161 mkSubst in_scope tvs ids = Subst in_scope ids tvs
163 -- getTvSubst :: Subst -> TvSubst
164 -- getTvSubst (Subst in_scope _ tv_env) = TvSubst in_scope tv_env
166 -- getTvSubstEnv :: Subst -> TvSubstEnv
167 -- getTvSubstEnv (Subst _ _ tv_env) = tv_env
169 -- setTvSubstEnv :: Subst -> TvSubstEnv -> Subst
170 -- setTvSubstEnv (Subst in_scope ids _) tvs = Subst in_scope ids tvs
172 -- | Find the in-scope set: see "CoreSubst#in_scope_invariant"
173 substInScope :: Subst -> InScopeSet
174 substInScope (Subst in_scope _ _) = in_scope
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
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
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
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)
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)
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
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
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 )
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
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])
236 ------------------------------
237 isInScope :: Var -> Subst -> Bool
238 isInScope v (Subst in_scope _ _) = v `elemInScopeSet` in_scope
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)
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)
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
260 Pretty printing, for debugging only
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
272 %************************************************************************
274 Substituting expressions
276 %************************************************************************
279 -- | Apply a substititon to an entire 'CoreExpr'. Rememeber, you may only
280 -- apply the substitution /once/: see "CoreSubst#apply_once"
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
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)
296 (subst', bndr') = substBndr subst bndr
298 go (Let bind body) = Let bind' (substExpr subst' body)
300 (subst', bind') = substBind subst bind
302 go (Case scrut bndr ty alts) = Case (go scrut) bndr' (substTy subst ty) (map (go_alt subst') alts)
304 (subst', bndr') = substBndr subst bndr
306 go_alt subst (con, bndrs, rhs) = (con, bndrs', substExpr subst' rhs)
308 (subst', bndrs') = substBndrs subst bndrs
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))
317 (subst', bndr') = substBndr subst bndr
319 substBind subst (Rec pairs) = (subst', Rec pairs')
321 (subst', bndrs') = substRecBndrs subst (map fst pairs)
322 pairs' = bndrs' `zip` rhss'
323 rhss' = map (substExpr subst' . snd) pairs
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.
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.)
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)
341 %************************************************************************
345 %************************************************************************
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.
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)
358 | isTyVar bndr = substTyVarBndr subst bndr
359 | otherwise = substIdBndr subst subst bndr
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
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
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
380 substIdBndr rec_subst subst@(Subst in_scope env tvs) old_id
381 = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
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)
387 old_ty = idType old_id
388 no_type_change = isEmptyVarEnv tvs ||
389 isEmptyVarSet (Type.tyVarsOfType old_ty)
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
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)
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
408 Now a variant that unconditionally allocates a new unique.
409 It also unconditionally zaps the OccInfo.
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)
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)
424 -- | Clone a mutually recursive group of 'Id's
425 cloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
426 cloneRecIdBndrs subst us ids
429 (subst', ids') = mapAccumL (clone_id subst') subst
430 (ids `zip` uniqsFromSupply us)
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
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)
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)
448 %************************************************************************
452 %************************************************************************
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
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')
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
471 %************************************************************************
473 \section{IdInfo substitution}
475 %************************************************************************
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
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)
497 old_rules = specInfo info
498 old_unf = unfoldingInfo info
499 nothing_to_do = isEmptySpecInfo old_rules && isClosedUnfolding old_unf
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)
510 substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_guidance = guide@(InlineRule {}) })
511 -- Retain an InlineRule!
512 = seqExpr new_tmpl `seq`
514 unf { uf_tmpl = new_tmpl, uf_guidance = guide { ir_info = new_info } }
516 new_tmpl = substExpr subst tmpl
517 new_info = substInlineRuleInfo subst (ir_info guide)
519 substUnfolding _ (CoreUnfolding {}) = NoUnfolding -- Discard
520 -- Always zap a CoreUnfolding, to save substitution work
522 substUnfolding _ unf = unf -- NoUnfolding, OtherCon
525 substInlineRuleInfo :: Subst -> InlineRuleInfo -> InlineRuleInfo
526 substInlineRuleInfo (Subst in_scope ids _) (InlWrapper wkr)
527 | Just (Var w1) <- lookupVarEnv ids wkr = InlWrapper w1
528 | Just w1 <- lookupInScope in_scope wkr = InlWrapper w1
529 | otherwise = WARN( True, text "Interesting! CoreSubst.substWorker:" <+> ppr wkr )
530 InlVanilla -- Note [Worker inlining]
531 substInlineRuleInfo _ info = info
534 substIdOcc :: Subst -> Id -> Id
535 -- These Ids should not be substituted to non-Ids
536 substIdOcc subst v = case lookupIdSubst subst v of
538 other -> pprPanic "substIdOcc" (vcat [ppr v <+> ppr other, ppr subst])
541 -- | Substitutes for the 'Id's within the 'WorkerInfo' given the new function 'Id'
542 substSpec :: Subst -> Id -> SpecInfo -> SpecInfo
543 substSpec subst new_id (SpecInfo rules rhs_fvs)
544 = seqSpecInfo new_spec `seq` new_spec
546 subst_ru_fn = const (idName new_id)
547 new_spec = SpecInfo (map (substRule subst subst_ru_fn) rules)
548 (substVarSet subst rhs_fvs)
551 substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]
552 substRulesForImportedIds subst rules
553 = map (substRule subst (\name -> name)) rules
556 substRule :: Subst -> (Name -> Name) -> CoreRule -> CoreRule
558 -- The subst_ru_fn argument is applied to substitute the ru_fn field
560 -- - Rules for *imported* Ids never change ru_fn
561 -- - Rules for *local* Ids are in the IdInfo for that Id,
562 -- and the ru_fn field is simply replaced by the new name
565 substRule _ _ rule@(BuiltinRule {}) = rule
566 substRule subst subst_ru_fn rule@(Rule { ru_bndrs = bndrs, ru_args = args
567 , ru_fn = fn_name, ru_rhs = rhs })
568 = rule { ru_bndrs = bndrs',
569 ru_fn = subst_ru_fn fn_name,
570 ru_args = map (substExpr subst') args,
571 ru_rhs = substExpr subst' rhs }
573 (subst', bndrs') = substBndrs subst bndrs
576 substVarSet :: Subst -> VarSet -> VarSet
577 substVarSet subst fvs
578 = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
581 | isId fv = exprFreeVars (lookupIdSubst subst fv)
582 | otherwise = Type.tyVarsOfType (lookupTvSubst subst fv)
585 Note [Worker inlining]
586 ~~~~~~~~~~~~~~~~~~~~~~
587 A worker can get sustituted away entirely.
588 - it might be trivial
589 - it might simply be very small
590 We do not treat an InlWrapper as an 'occurrence' in the occurence
591 analyser, so it's possible that the worker is not even in scope any more.
593 In all all these cases we simply drop the special case, returning to
594 InlVanilla. The WARN is just so I can see if it happens a lot.
597 %************************************************************************
599 The Very Simple Optimiser
601 %************************************************************************
604 simpleOptExpr :: CoreExpr -> CoreExpr
605 -- Do simple optimisation on an expression
606 -- The optimisation is very straightforward: just
607 -- inline non-recursive bindings that are used only once,
608 -- or where the RHS is trivial
610 -- The result is NOT guaranteed occurence-analysed, becuase
611 -- in (let x = y in ....) we substitute for x; so y's occ-info
612 -- may change radically
615 = go init_subst (occurAnalyseExpr expr)
617 init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr))
618 -- It's potentially important to make a proper in-scope set
619 -- Consider let x = ..y.. in \y. ...x...
620 -- Then we should remember to clone y before substituting
621 -- for x. It's very unlikely to occur, because we probably
622 -- won't *be* substituting for x if it occurs inside a
625 -- It's a bit painful to call exprFreeVars, because it makes
626 -- three passes instead of two (occ-anal, and go)
628 go subst (Var v) = lookupIdSubst subst v
629 go subst (App e1 e2) = App (go subst e1) (go subst e2)
630 go subst (Type ty) = Type (substTy subst ty)
631 go _ (Lit lit) = Lit lit
632 go subst (Note note e) = Note note (go subst e)
633 go subst (Cast e co) = Cast (go subst e) (substTy subst co)
634 go subst (Let bind body) = go_let subst bind body
635 go subst (Lam bndr body) = Lam bndr' (go subst' body)
637 (subst', bndr') = substBndr subst bndr
639 go subst (Case e b ty as) = Case (go subst e) b'
641 (map (go_alt subst') as)
643 (subst', b') = substBndr subst b
646 ----------------------
647 go_alt subst (con, bndrs, rhs) = (con, bndrs', go subst' rhs)
649 (subst', bndrs') = substBndrs subst bndrs
651 ----------------------
652 go_let subst (Rec prs) body
653 = Let (Rec (reverse rev_prs')) (go subst'' body)
655 (subst', bndrs') = substRecBndrs subst (map fst prs)
656 (subst'', rev_prs') = foldl do_pr (subst', []) (prs `zip` bndrs')
657 do_pr (subst, prs) ((b,r), b') = case go_bind subst b r of
658 Left subst' -> (subst', prs)
659 Right r' -> (subst, (b',r'):prs)
661 go_let subst (NonRec b r) body
662 = case go_bind subst b r of
663 Left subst' -> go subst' body
664 Right r' -> Let (NonRec b' r') (go subst' body)
666 (subst', b') = substBndr subst b
669 ----------------------
670 go_bind :: Subst -> Var -> CoreExpr -> Either Subst CoreExpr
671 -- (go_bind subst old_var old_rhs)
672 -- either extends subst with (old_var -> new_rhs)
673 -- or return new_rhs for a binding new_var = new_rhs
676 , isTyVar b -- let a::* = TYPE ty in <body>
677 = Left (extendTvSubst subst b (substTy subst ty))
679 | isId b -- let x = e in <body>
680 , safe_to_inline (idOccInfo b) || exprIsTrivial r'
681 , isAlwaysActive (idInlineActivation b) -- Note [Inline prag in simplOpt]
682 = Left (extendIdSubst subst b r')
689 ----------------------
690 -- Unconditionally safe to inline
691 safe_to_inline :: OccInfo -> Bool
692 safe_to_inline IAmDead = True
693 safe_to_inline (OneOcc in_lam one_br _) = not in_lam && one_br
694 safe_to_inline (IAmALoopBreaker {}) = False
695 safe_to_inline NoOccInfo = False
698 Note [Inline prag in simplOpt]
699 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
700 If there's an INLINE/NOINLINE pragma that restricts the phase in
701 which the binder can be inlined, we don't inline here; after all,
702 we don't know what phase we're in. Here's an example
704 foo :: Int -> Int -> Int
708 {-# INLINE [1] inner #-}
714 When inlining 'foo' in 'bar' we want the let-binding for 'inner'
715 to remain visible until Phase 1