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, substExprSC, substBind, substBindSC,
16 substUnfolding, substUnfoldingSC,
17 substUnfoldingSource, lookupIdSubst, lookupTvSubst, substIdOcc,
19 -- ** Operations on substitutions
20 emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst,
21 extendIdSubst, extendIdSubstList, extendTvSubst, extendTvSubstList,
22 extendSubst, extendSubstList, zapSubstEnv,
23 extendInScope, extendInScopeList, extendInScopeIds,
26 -- ** Substituting and cloning binders
27 substBndr, substBndrs, substRecBndrs,
28 cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs,
30 -- ** Simple expression optimiser
31 simpleOptPgm, simpleOptExpr
34 #include "HsVersions.h"
40 import OccurAnal( occurAnalyseExpr, occurAnalysePgm )
43 import Type ( Type, TvSubst(..), TvSubstEnv )
44 import Coercion ( isIdentityCoercion )
45 import OptCoercion ( optCoercion )
50 import Var ( Var, TyVar, setVarUnique )
56 import DynFlags ( DynFlags, DynFlag(..) )
57 import BasicTypes ( isAlwaysActive )
59 import PprCore () -- Instances
66 %************************************************************************
68 \subsection{Substitutions}
70 %************************************************************************
73 -- | A substitution environment, containing both 'Id' and 'TyVar' substitutions.
75 -- Some invariants apply to how you use the substitution:
77 -- 1. #in_scope_invariant# The in-scope set contains at least those 'Id's and 'TyVar's that will be in scope /after/
78 -- applying the substitution to a term. Precisely, the in-scope set must be a superset of the free vars of the
79 -- substitution range that might possibly clash with locally-bound variables in the thing being substituted in.
81 -- 2. #apply_once# You may apply the substitution only /once/
83 -- There are various ways of setting up the in-scope set such that the first of these invariants hold:
85 -- * Arrange that the in-scope set really is all the things in scope
87 -- * Arrange that it's the free vars of the range of the substitution
89 -- * Make it empty, if you know that all the free vars of the substitution are fresh, and hence can't possibly clash
91 = Subst InScopeSet -- Variables in in scope (both Ids and TyVars) /after/
92 -- applying the substitution
93 IdSubstEnv -- Substitution for Ids
94 TvSubstEnv -- Substitution for TyVars
96 -- INVARIANT 1: See #in_scope_invariant#
97 -- This is what lets us deal with name capture properly
98 -- It's a hard invariant to check...
100 -- INVARIANT 2: The substitution is apply-once; see Note [Apply once] with
103 -- INVARIANT 3: See Note [Extending the Subst]
106 Note [Extending the Subst]
107 ~~~~~~~~~~~~~~~~~~~~~~~~~~
108 For a core Subst, which binds Ids as well, we make a different choice for Ids
109 than we do for TyVars.
111 For TyVars, see Note [Extending the TvSubst] with Type.TvSubstEnv
113 For Ids, we have a different invariant
114 The IdSubstEnv is extended *only* when the Unique on an Id changes
115 Otherwise, we just extend the InScopeSet
119 * In substIdBndr, we extend the IdSubstEnv only when the unique changes
121 * If the TvSubstEnv and IdSubstEnv are both empty, substExpr does nothing
122 (Note that the above rule for substIdBndr maintains this property. If
123 the incoming envts are both empty, then substituting the type and
124 IdInfo can't change anything.)
126 * In lookupIdSubst, we *must* look up the Id in the in-scope set, because
127 it may contain non-trivial changes. Example:
128 (/\a. \x:a. ...x...) Int
129 We extend the TvSubstEnv with [a |-> Int]; but x's unique does not change
130 so we only extend the in-scope set. Then we must look up in the in-scope
131 set when we find the occurrence of x.
133 * The requirement to look up the Id in the in-scope set means that we
134 must NOT take no-op short cut in the case the substitution is empty.
135 We must still look up every Id in the in-scope set.
137 * (However, we don't need to do so for expressions found in the IdSubst
138 itself, whose range is assumed to be correct wrt the in-scope set.)
140 Why do we make a different choice for the IdSubstEnv than the TvSubstEnv?
142 * For Ids, we change the IdInfo all the time (e.g. deleting the
143 unfolding), and adding it back later, so using the TyVar convention
144 would entail extending the substitution almost all the time
146 * The simplifier wants to look up in the in-scope set anyway, in case it
147 can see a better unfolding from an enclosing case expression
149 * For TyVars, only coercion variables can possibly change, and they are
153 -- | An environment for substituting for 'Id's
154 type IdSubstEnv = IdEnv CoreExpr
156 ----------------------------
157 isEmptySubst :: Subst -> Bool
158 isEmptySubst (Subst _ id_env tv_env) = isEmptyVarEnv id_env && isEmptyVarEnv tv_env
161 emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv
163 mkEmptySubst :: InScopeSet -> Subst
164 mkEmptySubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv
166 mkSubst :: InScopeSet -> TvSubstEnv -> IdSubstEnv -> Subst
167 mkSubst in_scope tvs ids = Subst in_scope ids tvs
169 -- getTvSubst :: Subst -> TvSubst
170 -- getTvSubst (Subst in_scope _ tv_env) = TvSubst in_scope tv_env
172 -- getTvSubstEnv :: Subst -> TvSubstEnv
173 -- getTvSubstEnv (Subst _ _ tv_env) = tv_env
175 -- setTvSubstEnv :: Subst -> TvSubstEnv -> Subst
176 -- setTvSubstEnv (Subst in_scope ids _) tvs = Subst in_scope ids tvs
178 -- | Find the in-scope set: see "CoreSubst#in_scope_invariant"
179 substInScope :: Subst -> InScopeSet
180 substInScope (Subst in_scope _ _) = in_scope
182 -- | Remove all substitutions for 'Id's and 'Var's that might have been built up
183 -- while preserving the in-scope set
184 zapSubstEnv :: Subst -> Subst
185 zapSubstEnv (Subst in_scope _ _) = Subst in_scope emptyVarEnv emptyVarEnv
187 -- | Add a substitution for an 'Id' to the 'Subst': you must ensure that the in-scope set is
188 -- such that the "CoreSubst#in_scope_invariant" is true after extending the substitution like this
189 extendIdSubst :: Subst -> Id -> CoreExpr -> Subst
190 -- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set
191 extendIdSubst (Subst in_scope ids tvs) v r = Subst in_scope (extendVarEnv ids v r) tvs
193 -- | Adds multiple 'Id' substitutions to the 'Subst': see also 'extendIdSubst'
194 extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst
195 extendIdSubstList (Subst in_scope ids tvs) prs = Subst in_scope (extendVarEnvList ids prs) tvs
197 -- | Add a substitution for a 'TyVar' to the 'Subst': you must ensure that the in-scope set is
198 -- such that the "CoreSubst#in_scope_invariant" is true after extending the substitution like this
199 extendTvSubst :: Subst -> TyVar -> Type -> Subst
200 extendTvSubst (Subst in_scope ids tvs) v r = Subst in_scope ids (extendVarEnv tvs v r)
202 -- | Adds multiple 'TyVar' substitutions to the 'Subst': see also 'extendTvSubst'
203 extendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst
204 extendTvSubstList (Subst in_scope ids tvs) prs = Subst in_scope ids (extendVarEnvList tvs prs)
206 -- | Add a substitution for a 'TyVar' or 'Id' as appropriate to the 'Var' being added. See also
207 -- 'extendIdSubst' and 'extendTvSubst'
208 extendSubst :: Subst -> Var -> CoreArg -> Subst
209 extendSubst (Subst in_scope ids tvs) tv (Type ty)
210 = ASSERT( isTyCoVar tv ) Subst in_scope ids (extendVarEnv tvs tv ty)
211 extendSubst (Subst in_scope ids tvs) id expr
212 = ASSERT( isId id ) Subst in_scope (extendVarEnv ids id expr) tvs
214 -- | Add a substitution for a 'TyVar' or 'Id' as appropriate to all the 'Var's being added. See also 'extendSubst'
215 extendSubstList :: Subst -> [(Var,CoreArg)] -> Subst
216 extendSubstList subst [] = subst
217 extendSubstList subst ((var,rhs):prs) = extendSubstList (extendSubst subst var rhs) prs
219 -- | Find the substitution for an 'Id' in the 'Subst'
220 lookupIdSubst :: SDoc -> Subst -> Id -> CoreExpr
221 lookupIdSubst doc (Subst in_scope ids _) v
222 | not (isLocalId v) = Var v
223 | Just e <- lookupVarEnv ids v = e
224 | Just v' <- lookupInScope in_scope v = Var v'
225 -- Vital! See Note [Extending the Subst]
226 | otherwise = WARN( True, ptext (sLit "CoreSubst.lookupIdSubst") <+> ppr v $$ ppr in_scope $$ doc)
229 -- | Find the substitution for a 'TyVar' in the 'Subst'
230 lookupTvSubst :: Subst -> TyVar -> Type
231 lookupTvSubst (Subst _ _ tvs) v = lookupVarEnv tvs v `orElse` Type.mkTyVarTy v
233 -- | Simultaneously substitute for a bunch of variables
234 -- No left-right shadowing
235 -- ie the substitution for (\x \y. e) a1 a2
236 -- so neither x nor y scope over a1 a2
237 mkOpenSubst :: InScopeSet -> [(Var,CoreArg)] -> Subst
238 mkOpenSubst in_scope pairs = Subst in_scope
239 (mkVarEnv [(id,e) | (id, e) <- pairs, isId id])
240 (mkVarEnv [(tv,ty) | (tv, Type ty) <- pairs])
242 ------------------------------
243 isInScope :: Var -> Subst -> Bool
244 isInScope v (Subst in_scope _ _) = v `elemInScopeSet` in_scope
246 -- | Add the 'Var' to the in-scope set: as a side effect, removes any existing substitutions for it
247 extendInScope :: Subst -> Var -> Subst
248 extendInScope (Subst in_scope ids tvs) v
249 = Subst (in_scope `extendInScopeSet` v)
250 (ids `delVarEnv` v) (tvs `delVarEnv` v)
252 -- | Add the 'Var's to the in-scope set: see also 'extendInScope'
253 extendInScopeList :: Subst -> [Var] -> Subst
254 extendInScopeList (Subst in_scope ids tvs) vs
255 = Subst (in_scope `extendInScopeSetList` vs)
256 (ids `delVarEnvList` vs) (tvs `delVarEnvList` vs)
258 -- | Optimized version of 'extendInScopeList' that can be used if you are certain
259 -- all the things being added are 'Id's and hence none are 'TyVar's
260 extendInScopeIds :: Subst -> [Id] -> Subst
261 extendInScopeIds (Subst in_scope ids tvs) vs
262 = Subst (in_scope `extendInScopeSetList` vs)
263 (ids `delVarEnvList` vs) tvs
266 Pretty printing, for debugging only
269 instance Outputable Subst where
270 ppr (Subst in_scope ids tvs)
271 = ptext (sLit "<InScope =") <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
272 $$ ptext (sLit " IdSubst =") <+> ppr ids
273 $$ ptext (sLit " TvSubst =") <+> ppr tvs
278 %************************************************************************
280 Substituting expressions
282 %************************************************************************
285 -- | Apply a substititon to an entire 'CoreExpr'. Rememeber, you may only
286 -- apply the substitution /once/: see "CoreSubst#apply_once"
288 -- Do *not* attempt to short-cut in the case of an empty substitution!
289 -- See Note [Extending the Subst]
290 substExprSC :: SDoc -> Subst -> CoreExpr -> CoreExpr
291 substExprSC _doc subst orig_expr
292 | isEmptySubst subst = orig_expr
293 | otherwise = -- pprTrace "enter subst-expr" (doc $$ ppr orig_expr) $
294 subst_expr subst orig_expr
296 substExpr :: SDoc -> Subst -> CoreExpr -> CoreExpr
297 substExpr _doc subst orig_expr = subst_expr subst orig_expr
299 subst_expr :: Subst -> CoreExpr -> CoreExpr
300 subst_expr subst expr
303 go (Var v) = lookupIdSubst (text "subst_expr") subst v
304 go (Type ty) = Type (substTy subst ty)
305 go (Lit lit) = Lit lit
306 go (App fun arg) = App (go fun) (go arg)
307 go (Note note e) = Note (go_note note) (go e)
309 | isIdentityCoercion co' = go e
310 | otherwise = Cast (go e) co'
312 co' = optCoercion (getTvSubst subst) co
313 -- Optimise coercions as we go; this is good, for example
314 -- in the RHS of rules, which are only substituted in
316 go (Lam bndr body) = Lam bndr' (subst_expr subst' body)
318 (subst', bndr') = substBndr subst bndr
320 go (Let bind body) = Let bind' (subst_expr subst' body)
322 (subst', bind') = substBind subst bind
324 go (Case scrut bndr ty alts) = Case (go scrut) bndr' (substTy subst ty) (map (go_alt subst') alts)
326 (subst', bndr') = substBndr subst bndr
328 go_alt subst (con, bndrs, rhs) = (con, bndrs', subst_expr subst' rhs)
330 (subst', bndrs') = substBndrs subst bndrs
334 -- | Apply a substititon to an entire 'CoreBind', additionally returning an updated 'Subst'
335 -- that should be used by subsequent substitutons.
336 substBind, substBindSC :: Subst -> CoreBind -> (Subst, CoreBind)
338 substBindSC subst bind -- Short-cut if the substitution is empty
339 | not (isEmptySubst subst)
340 = substBind subst bind
343 NonRec bndr rhs -> (subst', NonRec bndr' rhs)
345 (subst', bndr') = substBndr subst bndr
346 Rec pairs -> (subst', Rec (bndrs' `zip` rhss'))
348 (bndrs, rhss) = unzip pairs
349 (subst', bndrs') = substRecBndrs subst bndrs
350 rhss' | isEmptySubst subst' = rhss
351 | otherwise = map (subst_expr subst') rhss
353 substBind subst (NonRec bndr rhs) = (subst', NonRec bndr' (subst_expr subst rhs))
355 (subst', bndr') = substBndr subst bndr
357 substBind subst (Rec pairs) = (subst', Rec (bndrs' `zip` rhss'))
359 (bndrs, rhss) = unzip pairs
360 (subst', bndrs') = substRecBndrs subst bndrs
361 rhss' = map (subst_expr subst') rhss
365 -- | De-shadowing the program is sometimes a useful pre-pass. It can be done simply
366 -- by running over the bindings with an empty substitution, becuase substitution
367 -- returns a result that has no-shadowing guaranteed.
369 -- (Actually, within a single /type/ there might still be shadowing, because
370 -- 'substTy' is a no-op for the empty substitution, but that's probably OK.)
372 -- [Aug 09] This function is not used in GHC at the moment, but seems so
373 -- short and simple that I'm going to leave it here
374 deShadowBinds :: [CoreBind] -> [CoreBind]
375 deShadowBinds binds = snd (mapAccumL substBind emptySubst binds)
379 %************************************************************************
383 %************************************************************************
385 Remember that substBndr and friends are used when doing expression
386 substitution only. Their only business is substitution, so they
387 preserve all IdInfo (suitably substituted). For example, we *want* to
388 preserve occ info in rules.
391 -- | Substitutes a 'Var' for another one according to the 'Subst' given, returning
392 -- the result and an updated 'Subst' that should be used by subsequent substitutons.
393 -- 'IdInfo' is preserved by this process, although it is substituted into appropriately.
394 substBndr :: Subst -> Var -> (Subst, Var)
396 | isTyCoVar bndr = substTyVarBndr subst bndr
397 | otherwise = substIdBndr (text "var-bndr") subst subst bndr
399 -- | Applies 'substBndr' to a number of 'Var's, accumulating a new 'Subst' left-to-right
400 substBndrs :: Subst -> [Var] -> (Subst, [Var])
401 substBndrs subst bndrs = mapAccumL substBndr subst bndrs
403 -- | Substitute in a mutually recursive group of 'Id's
404 substRecBndrs :: Subst -> [Id] -> (Subst, [Id])
405 substRecBndrs subst bndrs
406 = (new_subst, new_bndrs)
407 where -- Here's the reason we need to pass rec_subst to subst_id
408 (new_subst, new_bndrs) = mapAccumL (substIdBndr (text "rec-bndr") new_subst) subst bndrs
414 -> Subst -- ^ Substitution to use for the IdInfo
415 -> Subst -> Id -- ^ Substitition and Id to transform
416 -> (Subst, Id) -- ^ Transformed pair
417 -- NB: unfolding may be zapped
419 substIdBndr _doc rec_subst subst@(Subst in_scope env tvs) old_id
420 = -- pprTrace "substIdBndr" (doc $$ ppr old_id $$ ppr in_scope) $
421 (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
423 id1 = uniqAway in_scope old_id -- id1 is cloned if necessary
424 id2 | no_type_change = id1
425 | otherwise = setIdType id1 (substTy subst old_ty)
427 old_ty = idType old_id
428 no_type_change = isEmptyVarEnv tvs ||
429 isEmptyVarSet (Type.tyVarsOfType old_ty)
431 -- new_id has the right IdInfo
432 -- The lazy-set is because we're in a loop here, with
433 -- rec_subst, when dealing with a mutually-recursive group
434 new_id = maybeModifyIdInfo mb_new_info id2
435 mb_new_info = substIdInfo rec_subst id2 (idInfo id2)
436 -- NB: unfolding info may be zapped
438 -- Extend the substitution if the unique has changed
439 -- See the notes with substTyVarBndr for the delVarEnv
440 new_env | no_change = delVarEnv env old_id
441 | otherwise = extendVarEnv env old_id (Var new_id)
443 no_change = id1 == old_id
444 -- See Note [Extending the Subst]
445 -- it's /not/ necessary to check mb_new_info and no_type_change
448 Now a variant that unconditionally allocates a new unique.
449 It also unconditionally zaps the OccInfo.
452 -- | Very similar to 'substBndr', but it always allocates a new 'Unique' for
453 -- each variable in its output. It substitutes the IdInfo though.
454 cloneIdBndr :: Subst -> UniqSupply -> Id -> (Subst, Id)
455 cloneIdBndr subst us old_id
456 = clone_id subst subst (old_id, uniqFromSupply us)
458 -- | Applies 'cloneIdBndr' to a number of 'Id's, accumulating a final
459 -- substitution from left to right
460 cloneIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
461 cloneIdBndrs subst us ids
462 = mapAccumL (clone_id subst) subst (ids `zip` uniqsFromSupply us)
464 -- | Clone a mutually recursive group of 'Id's
465 cloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
466 cloneRecIdBndrs subst us ids
469 (subst', ids') = mapAccumL (clone_id subst') subst
470 (ids `zip` uniqsFromSupply us)
472 -- Just like substIdBndr, except that it always makes a new unique
473 -- It is given the unique to use
474 clone_id :: Subst -- Substitution for the IdInfo
475 -> Subst -> (Id, Unique) -- Substitition and Id to transform
476 -> (Subst, Id) -- Transformed pair
478 clone_id rec_subst subst@(Subst in_scope env tvs) (old_id, uniq)
479 = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
481 id1 = setVarUnique old_id uniq
482 id2 = substIdType subst id1
483 new_id = maybeModifyIdInfo (substIdInfo rec_subst id2 (idInfo old_id)) id2
484 new_env = extendVarEnv env old_id (Var new_id)
488 %************************************************************************
492 %************************************************************************
494 For types we just call the corresponding function in Type, but we have
495 to repackage the substitution, from a Subst to a TvSubst
498 substTyVarBndr :: Subst -> TyVar -> (Subst, TyVar)
499 substTyVarBndr (Subst in_scope id_env tv_env) tv
500 = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
501 (TvSubst in_scope' tv_env', tv')
502 -> (Subst in_scope' id_env tv_env', tv')
504 -- | See 'Type.substTy'
505 substTy :: Subst -> Type -> Type
506 substTy subst ty = Type.substTy (getTvSubst subst) ty
508 getTvSubst :: Subst -> TvSubst
509 getTvSubst (Subst in_scope _id_env tv_env) = TvSubst in_scope tv_env
513 %************************************************************************
515 \section{IdInfo substitution}
517 %************************************************************************
520 substIdType :: Subst -> Id -> Id
521 substIdType subst@(Subst _ _ tv_env) id
522 | isEmptyVarEnv tv_env || isEmptyVarSet (Type.tyVarsOfType old_ty) = id
523 | otherwise = setIdType id (substTy subst old_ty)
524 -- The tyVarsOfType is cheaper than it looks
525 -- because we cache the free tyvars of the type
526 -- in a Note in the id's type itself
531 -- | Substitute into some 'IdInfo' with regard to the supplied new 'Id'.
532 substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo
533 substIdInfo subst new_id info
534 | nothing_to_do = Nothing
535 | otherwise = Just (info `setSpecInfo` substSpec subst new_id old_rules
536 `setUnfoldingInfo` substUnfolding subst old_unf)
538 old_rules = specInfo info
539 old_unf = unfoldingInfo info
540 nothing_to_do = isEmptySpecInfo old_rules && isClosedUnfolding old_unf
544 -- | Substitutes for the 'Id's within an unfolding
545 substUnfolding, substUnfoldingSC :: Subst -> Unfolding -> Unfolding
546 -- Seq'ing on the returned Unfolding is enough to cause
547 -- all the substitutions to happen completely
549 substUnfoldingSC subst unf -- Short-cut version
550 | isEmptySubst subst = unf
551 | otherwise = substUnfolding subst unf
553 substUnfolding subst (DFunUnfolding ar con args)
554 = DFunUnfolding ar con (map (substExpr (text "dfun-unf") subst) args)
556 substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_src = src })
557 -- Retain an InlineRule!
558 | not (isStableSource src) -- Zap an unstable unfolding, to save substitution work
560 | otherwise -- But keep a stable one!
561 = seqExpr new_tmpl `seq`
563 unf { uf_tmpl = new_tmpl, uf_src = new_src }
565 new_tmpl = substExpr (text "subst-unf") subst tmpl
566 new_src = substUnfoldingSource subst src
568 substUnfolding _ unf = unf -- NoUnfolding, OtherCon
571 substUnfoldingSource :: Subst -> UnfoldingSource -> UnfoldingSource
572 substUnfoldingSource (Subst in_scope ids _) (InlineWrapper wkr)
573 | Just wkr_expr <- lookupVarEnv ids wkr
575 Var w1 -> InlineWrapper w1
576 _other -> -- WARN( True, text "Interesting! CoreSubst.substWorker1:" <+> ppr wkr
577 -- <+> ifPprDebug (equals <+> ppr wkr_expr) )
578 -- Note [Worker inlining]
579 InlineStable -- It's not a wrapper any more, but still inline it!
581 | Just w1 <- lookupInScope in_scope wkr = InlineWrapper w1
582 | otherwise = -- WARN( True, text "Interesting! CoreSubst.substWorker2:" <+> ppr wkr )
583 -- This can legitimately happen. The worker has been inlined and
584 -- dropped as dead code, because we don't treat the UnfoldingSource
585 -- as an "occurrence".
586 -- Note [Worker inlining]
589 substUnfoldingSource _ src = src
592 substIdOcc :: Subst -> Id -> Id
593 -- These Ids should not be substituted to non-Ids
594 substIdOcc subst v = case lookupIdSubst (text "substIdOcc") subst v of
596 other -> pprPanic "substIdOcc" (vcat [ppr v <+> ppr other, ppr subst])
599 -- | Substitutes for the 'Id's within the 'WorkerInfo' given the new function 'Id'
600 substSpec :: Subst -> Id -> SpecInfo -> SpecInfo
601 substSpec subst new_id (SpecInfo rules rhs_fvs)
602 = seqSpecInfo new_spec `seq` new_spec
604 subst_ru_fn = const (idName new_id)
605 new_spec = SpecInfo (map (substRule subst subst_ru_fn) rules)
606 (substVarSet subst rhs_fvs)
609 substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]
610 substRulesForImportedIds subst rules
611 = map (substRule subst not_needed) rules
613 not_needed name = pprPanic "substRulesForImportedIds" (ppr name)
616 substRule :: Subst -> (Name -> Name) -> CoreRule -> CoreRule
618 -- The subst_ru_fn argument is applied to substitute the ru_fn field
620 -- - Rules for *imported* Ids never change ru_fn
621 -- - Rules for *local* Ids are in the IdInfo for that Id,
622 -- and the ru_fn field is simply replaced by the new name
625 substRule _ _ rule@(BuiltinRule {}) = rule
626 substRule subst subst_ru_fn rule@(Rule { ru_bndrs = bndrs, ru_args = args
627 , ru_fn = fn_name, ru_rhs = rhs
628 , ru_local = is_local })
629 = rule { ru_bndrs = bndrs',
631 then subst_ru_fn fn_name
633 ru_args = map (substExpr (text "subst-rule" <+> ppr fn_name) subst') args,
634 ru_rhs = substExpr (text "subst-rule" <+> ppr fn_name) subst' rhs }
636 (subst', bndrs') = substBndrs subst bndrs
639 substVarSet :: Subst -> VarSet -> VarSet
640 substVarSet subst fvs
641 = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
644 | isId fv = exprFreeVars (lookupIdSubst (text "substVarSet") subst fv)
645 | otherwise = Type.tyVarsOfType (lookupTvSubst subst fv)
648 Note [Worker inlining]
649 ~~~~~~~~~~~~~~~~~~~~~~
650 A worker can get sustituted away entirely.
651 - it might be trivial
652 - it might simply be very small
653 We do not treat an InlWrapper as an 'occurrence' in the occurence
654 analyser, so it's possible that the worker is not even in scope any more.
656 In all all these cases we simply drop the special case, returning to
657 InlVanilla. The WARN is just so I can see if it happens a lot.
660 %************************************************************************
662 The Very Simple Optimiser
664 %************************************************************************
667 simpleOptExpr :: CoreExpr -> CoreExpr
668 -- Do simple optimisation on an expression
669 -- The optimisation is very straightforward: just
670 -- inline non-recursive bindings that are used only once,
671 -- or where the RHS is trivial
673 -- The result is NOT guaranteed occurence-analysed, becuase
674 -- in (let x = y in ....) we substitute for x; so y's occ-info
675 -- may change radically
678 = -- pprTrace "simpleOptExpr" (ppr init_subst $$ ppr expr)
679 simple_opt_expr init_subst (occurAnalyseExpr expr)
681 init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr))
682 -- It's potentially important to make a proper in-scope set
683 -- Consider let x = ..y.. in \y. ...x...
684 -- Then we should remember to clone y before substituting
685 -- for x. It's very unlikely to occur, because we probably
686 -- won't *be* substituting for x if it occurs inside a
689 -- It's a bit painful to call exprFreeVars, because it makes
690 -- three passes instead of two (occ-anal, and go)
692 ----------------------
693 simpleOptPgm :: DynFlags -> [CoreBind] -> [CoreRule] -> IO ([CoreBind], [CoreRule])
694 simpleOptPgm dflags binds rules
695 = do { dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
696 (pprCoreBindings occ_anald_binds);
698 ; return (reverse binds', substRulesForImportedIds subst' rules) }
700 occ_anald_binds = occurAnalysePgm binds rules
701 (subst', binds') = foldl do_one (emptySubst, []) occ_anald_binds
703 do_one (subst, binds') bind
704 = case simple_opt_bind subst bind of
705 (subst', Nothing) -> (subst', binds')
706 (subst', Just bind') -> (subst', bind':binds')
708 ----------------------
713 type InExpr = CoreExpr
714 type OutExpr = CoreExpr
716 -- In these functions the substitution maps InVar -> OutExpr
718 ----------------------
719 simple_opt_expr :: Subst -> InExpr -> OutExpr
720 simple_opt_expr subst expr
723 go (Var v) = lookupIdSubst (text "simpleOptExpr") subst v
724 go (App e1 e2) = App (go e1) (go e2)
725 go (Type ty) = Type (substTy subst ty)
726 go (Lit lit) = Lit lit
727 go (Note note e) = Note note (go e)
728 go (Cast e co) | isIdentityCoercion co' = go e
729 | otherwise = Cast (go e) co'
731 co' = substTy subst co
733 go (Let bind body) = maybeLet mb_bind (simple_opt_expr subst' body)
735 (subst', mb_bind) = simple_opt_bind subst bind
736 go lam@(Lam {}) = go_lam [] subst lam
737 go (Case e b ty as) = Case (go e) b' (substTy subst ty)
738 (map (go_alt subst') as)
740 (subst', b') = subst_opt_bndr subst b
742 ----------------------
743 go_alt subst (con, bndrs, rhs)
744 = (con, bndrs', simple_opt_expr subst' rhs)
746 (subst', bndrs') = subst_opt_bndrs subst bndrs
748 ----------------------
749 -- go_lam tries eta reduction
750 go_lam bs' subst (Lam b e)
751 = go_lam (b':bs') subst' e
753 (subst', b') = subst_opt_bndr subst b
755 | Just etad_e <- tryEtaReduce bs e' = etad_e
756 | otherwise = mkLams bs e'
759 e' = simple_opt_expr subst e
761 ----------------------
762 simple_opt_bind :: Subst -> CoreBind -> (Subst, Maybe CoreBind)
763 simple_opt_bind subst (Rec prs)
764 = (subst'', Just (Rec (reverse rev_prs')))
766 (subst', bndrs') = subst_opt_bndrs subst (map fst prs)
767 (subst'', rev_prs') = foldl do_pr (subst', []) (prs `zip` bndrs')
768 do_pr (subst, prs) ((b,r), b') = case simple_opt_pair subst b r of
769 Left subst' -> (subst', prs)
770 Right r' -> (subst, (b2,r'):prs)
772 b2 = add_info subst b b'
774 simple_opt_bind subst (NonRec b r)
775 = case simple_opt_pair subst b r of
776 Left ext_subst -> (ext_subst, Nothing)
777 Right r' -> (subst', Just (NonRec b2 r'))
779 (subst', b') = subst_opt_bndr subst b
780 b2 = add_info subst' b b'
782 ----------------------
783 simple_opt_pair :: Subst -> InVar -> InExpr -> Either Subst OutExpr
784 -- (simple_opt_pair subst in_var in_rhs)
785 -- either extends subst with (in_var -> out_rhs)
786 -- or return out_rhs for a binding out_var = out_rhs
787 simple_opt_pair subst b r
788 | Type ty <- r -- let a::* = TYPE ty in <body>
789 = ASSERT( isTyCoVar b )
790 Left (extendTvSubst subst b (substTy subst ty))
792 | isId b -- let x = e in <body>
793 , safe_to_inline (idOccInfo b)
794 , isAlwaysActive (idInlineActivation b) -- Note [Inline prag in simplOpt]
795 , not (isStableUnfolding (idUnfolding b))
796 , not (isExportedId b)
797 = Left (extendIdSubst subst b r')
802 r' = simple_opt_expr subst r
804 -- Unconditionally safe to inline
805 safe_to_inline :: OccInfo -> Bool
806 safe_to_inline (IAmALoopBreaker {}) = False
807 safe_to_inline IAmDead = True
808 safe_to_inline (OneOcc in_lam one_br _) = (not in_lam && one_br) || exprIsTrivial r'
809 safe_to_inline NoOccInfo = exprIsTrivial r'
811 ----------------------
812 subst_opt_bndr :: Subst -> InVar -> (Subst, OutVar)
813 subst_opt_bndr subst bndr
814 | isTyCoVar bndr = substTyVarBndr subst bndr
815 | otherwise = subst_opt_id_bndr subst bndr
817 subst_opt_id_bndr :: Subst -> InId -> (Subst, OutId)
818 -- Nuke all fragile IdInfo, unfolding, and RULES;
819 -- it gets added back later by add_info
820 -- Rather like SimplEnv.substIdBndr
822 -- It's important to zap fragile OccInfo (which CoreSubst.SubstIdBndr
823 -- carefully does not do) because simplOptExpr invalidates it
825 subst_opt_id_bndr subst@(Subst in_scope id_subst tv_subst) old_id
826 = (Subst new_in_scope new_id_subst tv_subst, new_id)
828 id1 = uniqAway in_scope old_id
829 id2 = setIdType id1 (substTy subst (idType old_id))
830 new_id = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding
831 -- and fragile OccInfo
832 new_in_scope = in_scope `extendInScopeSet` new_id
834 -- Extend the substitution if the unique has changed,
835 -- or there's some useful occurrence information
836 -- See the notes with substTyVarBndr for the delSubstEnv
837 new_id_subst | new_id /= old_id
838 = extendVarEnv id_subst old_id (Var new_id)
840 = delVarEnv id_subst old_id
842 ----------------------
843 subst_opt_bndrs :: Subst -> [InVar] -> (Subst, [OutVar])
844 subst_opt_bndrs subst bndrs
845 = mapAccumL subst_opt_bndr subst bndrs
847 ----------------------
848 add_info :: Subst -> InVar -> OutVar -> OutVar
849 add_info subst old_bndr new_bndr
850 | isTyCoVar old_bndr = new_bndr
851 | otherwise = maybeModifyIdInfo mb_new_info new_bndr
853 mb_new_info = substIdInfo subst new_bndr (idInfo old_bndr)
855 ----------------------
856 maybeLet :: Maybe CoreBind -> CoreExpr -> CoreExpr
857 maybeLet Nothing e = e
858 maybeLet (Just b) e = Let b e
861 Note [Inline prag in simplOpt]
862 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
863 If there's an INLINE/NOINLINE pragma that restricts the phase in
864 which the binder can be inlined, we don't inline here; after all,
865 we don't know what phase we're in. Here's an example
867 foo :: Int -> Int -> Int
871 {-# INLINE [1] inner #-}
877 When inlining 'foo' in 'bar' we want the let-binding for 'inner'
878 to remain visible until Phase 1