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 )
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_src = src })
511 -- Retain an InlineRule!
512 | not (isInlineRuleSource src) -- Always zap a CoreUnfolding, to save substitution work
514 | otherwise -- But keep an InlineRule!
515 = seqExpr new_tmpl `seq`
517 unf { uf_tmpl = new_tmpl, uf_src = new_src }
519 new_tmpl = substExpr subst tmpl
520 new_src = substUnfoldingSource subst src
522 substUnfolding _ unf = unf -- NoUnfolding, OtherCon
525 substUnfoldingSource :: Subst -> UnfoldingSource -> UnfoldingSource
526 substUnfoldingSource (Subst in_scope ids _) (InlineWrapper wkr)
527 | Just wkr_expr <- lookupVarEnv ids wkr
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!
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]
542 substUnfoldingSource _ src = src
545 substIdOcc :: Subst -> Id -> Id
546 -- These Ids should not be substituted to non-Ids
547 substIdOcc subst v = case lookupIdSubst subst v of
549 other -> pprPanic "substIdOcc" (vcat [ppr v <+> ppr other, ppr subst])
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
557 subst_ru_fn = const (idName new_id)
558 new_spec = SpecInfo (map (substRule subst subst_ru_fn) rules)
559 (substVarSet subst rhs_fvs)
562 substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]
563 substRulesForImportedIds subst rules
564 = map (substRule subst (\name -> name)) rules
567 substRule :: Subst -> (Name -> Name) -> CoreRule -> CoreRule
569 -- The subst_ru_fn argument is applied to substitute the ru_fn field
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
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 }
584 (subst', bndrs') = substBndrs subst bndrs
587 substVarSet :: Subst -> VarSet -> VarSet
588 substVarSet subst fvs
589 = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
592 | isId fv = exprFreeVars (lookupIdSubst subst fv)
593 | otherwise = Type.tyVarsOfType (lookupTvSubst subst fv)
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.
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.
608 %************************************************************************
610 The Very Simple Optimiser
612 %************************************************************************
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
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
626 = go init_subst (occurAnalyseExpr expr)
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
636 -- It's a bit painful to call exprFreeVars, because it makes
637 -- three passes instead of two (occ-anal, and go)
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)
648 (subst', bndr') = substBndr subst bndr
650 go subst (Case e b ty as) = Case (go subst e) b'
652 (map (go_alt subst') as)
654 (subst', b') = substBndr subst b
657 ----------------------
658 go_alt subst (con, bndrs, rhs) = (con, bndrs', go subst' rhs)
660 (subst', bndrs') = substBndrs subst bndrs
662 ----------------------
663 go_let subst (Rec prs) body
664 = Let (Rec (reverse rev_prs')) (go subst'' body)
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)
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)
677 (subst', b') = substBndr subst b
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
687 , isTyVar b -- let a::* = TYPE ty in <body>
688 = Left (extendTvSubst subst b (substTy subst ty))
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')
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
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
715 foo :: Int -> Int -> Int
719 {-# INLINE [1] inner #-}
725 When inlining 'foo' in 'bar' we want the let-binding for 'inner'
726 to remain visible until Phase 1