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