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