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 substInlineRuleGuidance, 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 )
52 import PprCore () -- Instances
59 %************************************************************************
61 \subsection{Substitutions}
63 %************************************************************************
66 -- | A substitution environment, containing both 'Id' and 'TyVar' substitutions.
68 -- Some invariants apply to how you use the substitution:
70 -- 1. #in_scope_invariant# The in-scope set contains at least those 'Id's and 'TyVar's that will be in scope /after/
71 -- applying the substitution to a term. Precisely, the in-scope set must be a superset of the free vars of the
72 -- substitution range that might possibly clash with locally-bound variables in the thing being substituted in.
74 -- 2. #apply_once# You may apply the substitution only /once/
76 -- There are various ways of setting up the in-scope set such that the first of these invariants hold:
78 -- * Arrange that the in-scope set really is all the things in scope
80 -- * Arrange that it's the free vars of the range of the substitution
82 -- * Make it empty, if you know that all the free vars of the substitution are fresh, and hence can't possibly clash
84 = Subst InScopeSet -- Variables in in scope (both Ids and TyVars) /after/
85 -- applying the substitution
86 IdSubstEnv -- Substitution for Ids
87 TvSubstEnv -- Substitution for TyVars
89 -- INVARIANT 1: See #in_scope_invariant#
90 -- This is what lets us deal with name capture properly
91 -- It's a hard invariant to check...
93 -- INVARIANT 2: The substitution is apply-once; see Note [Apply once] with
96 -- INVARIANT 3: See Note [Extending the Subst]
99 Note [Extending the Subst]
100 ~~~~~~~~~~~~~~~~~~~~~~~~~~
101 For a core Subst, which binds Ids as well, we make a different choice for Ids
102 than we do for TyVars.
104 For TyVars, see Note [Extending the TvSubst] with Type.TvSubstEnv
106 For Ids, we have a different invariant
107 The IdSubstEnv is extended *only* when the Unique on an Id changes
108 Otherwise, we just extend the InScopeSet
112 * In substIdBndr, we extend the IdSubstEnv only when the unique changes
114 * If the TvSubstEnv and IdSubstEnv are both empty, substExpr does nothing
115 (Note that the above rule for substIdBndr maintains this property. If
116 the incoming envts are both empty, then substituting the type and
117 IdInfo can't change anything.)
119 * In lookupIdSubst, we *must* look up the Id in the in-scope set, because
120 it may contain non-trivial changes. Example:
121 (/\a. \x:a. ...x...) Int
122 We extend the TvSubstEnv with [a |-> Int]; but x's unique does not change
123 so we only extend the in-scope set. Then we must look up in the in-scope
124 set when we find the occurrence of x.
126 * The requirement to look up the Id in the in-scope set means that we
127 must NOT take no-op short cut in the case the substitution is empty.
128 We must still look up every Id in the in-scope set.
130 * (However, we don't need to do so for expressions found in the IdSubst
131 itself, whose range is assumed to be correct wrt the in-scope set.)
133 Why do we make a different choice for the IdSubstEnv than the TvSubstEnv?
135 * For Ids, we change the IdInfo all the time (e.g. deleting the
136 unfolding), and adding it back later, so using the TyVar convention
137 would entail extending the substitution almost all the time
139 * The simplifier wants to look up in the in-scope set anyway, in case it
140 can see a better unfolding from an enclosing case expression
142 * For TyVars, only coercion variables can possibly change, and they are
146 -- | An environment for substituting for 'Id's
147 type IdSubstEnv = IdEnv CoreExpr
149 ----------------------------
150 isEmptySubst :: Subst -> Bool
151 isEmptySubst (Subst _ id_env tv_env) = isEmptyVarEnv id_env && isEmptyVarEnv tv_env
154 emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv
156 mkEmptySubst :: InScopeSet -> Subst
157 mkEmptySubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv
159 mkSubst :: InScopeSet -> TvSubstEnv -> IdSubstEnv -> Subst
160 mkSubst in_scope tvs ids = Subst in_scope ids tvs
162 -- getTvSubst :: Subst -> TvSubst
163 -- getTvSubst (Subst in_scope _ tv_env) = TvSubst in_scope tv_env
165 -- getTvSubstEnv :: Subst -> TvSubstEnv
166 -- getTvSubstEnv (Subst _ _ tv_env) = tv_env
168 -- setTvSubstEnv :: Subst -> TvSubstEnv -> Subst
169 -- setTvSubstEnv (Subst in_scope ids _) tvs = Subst in_scope ids tvs
171 -- | Find the in-scope set: see "CoreSubst#in_scope_invariant"
172 substInScope :: Subst -> InScopeSet
173 substInScope (Subst in_scope _ _) = in_scope
175 -- | Remove all substitutions for 'Id's and 'Var's that might have been built up
176 -- while preserving the in-scope set
177 zapSubstEnv :: Subst -> Subst
178 zapSubstEnv (Subst in_scope _ _) = Subst in_scope emptyVarEnv emptyVarEnv
180 -- | Add a substitution for an 'Id' to the 'Subst': you must ensure that the in-scope set is
181 -- such that the "CoreSubst#in_scope_invariant" is true after extending the substitution like this
182 extendIdSubst :: Subst -> Id -> CoreExpr -> Subst
183 -- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set
184 extendIdSubst (Subst in_scope ids tvs) v r = Subst in_scope (extendVarEnv ids v r) tvs
186 -- | Adds multiple 'Id' substitutions to the 'Subst': see also 'extendIdSubst'
187 extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst
188 extendIdSubstList (Subst in_scope ids tvs) prs = Subst in_scope (extendVarEnvList ids prs) tvs
190 -- | Add a substitution for a 'TyVar' to the 'Subst': you must ensure that the in-scope set is
191 -- such that the "CoreSubst#in_scope_invariant" is true after extending the substitution like this
192 extendTvSubst :: Subst -> TyVar -> Type -> Subst
193 extendTvSubst (Subst in_scope ids tvs) v r = Subst in_scope ids (extendVarEnv tvs v r)
195 -- | Adds multiple 'TyVar' substitutions to the 'Subst': see also 'extendTvSubst'
196 extendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst
197 extendTvSubstList (Subst in_scope ids tvs) prs = Subst in_scope ids (extendVarEnvList tvs prs)
199 -- | Add a substitution for a 'TyVar' or 'Id' as appropriate to the 'Var' being added. See also
200 -- 'extendIdSubst' and 'extendTvSubst'
201 extendSubst :: Subst -> Var -> CoreArg -> Subst
202 extendSubst (Subst in_scope ids tvs) tv (Type ty)
203 = ASSERT( isTyVar tv ) Subst in_scope ids (extendVarEnv tvs tv ty)
204 extendSubst (Subst in_scope ids tvs) id expr
205 = ASSERT( isId id ) Subst in_scope (extendVarEnv ids id expr) tvs
207 -- | Add a substitution for a 'TyVar' or 'Id' as appropriate to all the 'Var's being added. See also 'extendSubst'
208 extendSubstList :: Subst -> [(Var,CoreArg)] -> Subst
209 extendSubstList subst [] = subst
210 extendSubstList subst ((var,rhs):prs) = extendSubstList (extendSubst subst var rhs) prs
212 -- | Find the substitution for an 'Id' in the 'Subst'
213 lookupIdSubst :: Subst -> Id -> CoreExpr
214 lookupIdSubst (Subst in_scope ids _) v
215 | not (isLocalId v) = Var v
216 | Just e <- lookupVarEnv ids v = e
217 | Just v' <- lookupInScope in_scope v = Var v'
218 -- Vital! See Note [Extending the Subst]
219 | otherwise = WARN( True, ptext (sLit "CoreSubst.lookupIdSubst") <+> ppr v $$ ppr in_scope )
222 -- | Find the substitution for a 'TyVar' in the 'Subst'
223 lookupTvSubst :: Subst -> TyVar -> Type
224 lookupTvSubst (Subst _ _ tvs) v = lookupVarEnv tvs v `orElse` Type.mkTyVarTy v
226 -- | Simultaneously substitute for a bunch of variables
227 -- No left-right shadowing
228 -- ie the substitution for (\x \y. e) a1 a2
229 -- so neither x nor y scope over a1 a2
230 mkOpenSubst :: InScopeSet -> [(Var,CoreArg)] -> Subst
231 mkOpenSubst in_scope pairs = Subst in_scope
232 (mkVarEnv [(id,e) | (id, e) <- pairs, isId id])
233 (mkVarEnv [(tv,ty) | (tv, Type ty) <- pairs])
235 ------------------------------
236 isInScope :: Var -> Subst -> Bool
237 isInScope v (Subst in_scope _ _) = v `elemInScopeSet` in_scope
239 -- | Add the 'Var' to the in-scope set: as a side effect, removes any existing substitutions for it
240 extendInScope :: Subst -> Var -> Subst
241 extendInScope (Subst in_scope ids tvs) v
242 = Subst (in_scope `extendInScopeSet` v)
243 (ids `delVarEnv` v) (tvs `delVarEnv` v)
245 -- | Add the 'Var's to the in-scope set: see also 'extendInScope'
246 extendInScopeList :: Subst -> [Var] -> Subst
247 extendInScopeList (Subst in_scope ids tvs) vs
248 = Subst (in_scope `extendInScopeSetList` vs)
249 (ids `delVarEnvList` vs) (tvs `delVarEnvList` vs)
251 -- | Optimized version of 'extendInScopeList' that can be used if you are certain
252 -- all the things being added are 'Id's and hence none are 'TyVar's
253 extendInScopeIds :: Subst -> [Id] -> Subst
254 extendInScopeIds (Subst in_scope ids tvs) vs
255 = Subst (in_scope `extendInScopeSetList` vs)
256 (ids `delVarEnvList` vs) tvs
259 Pretty printing, for debugging only
262 instance Outputable Subst where
263 ppr (Subst in_scope ids tvs)
264 = ptext (sLit "<InScope =") <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
265 $$ ptext (sLit " IdSubst =") <+> ppr ids
266 $$ ptext (sLit " TvSubst =") <+> ppr tvs
271 %************************************************************************
273 Substituting expressions
275 %************************************************************************
278 -- | Apply a substititon to an entire 'CoreExpr'. Rememeber, you may only
279 -- apply the substitution /once/: see "CoreSubst#apply_once"
281 -- Do *not* attempt to short-cut in the case of an empty substitution!
282 -- See Note [Extending the Subst]
283 substExpr :: Subst -> CoreExpr -> CoreExpr
287 go (Var v) = lookupIdSubst subst v
288 go (Type ty) = Type (substTy subst ty)
289 go (Lit lit) = Lit lit
290 go (App fun arg) = App (go fun) (go arg)
291 go (Note note e) = Note (go_note note) (go e)
292 go (Cast e co) = Cast (go e) (substTy subst co)
293 go (Lam bndr body) = Lam bndr' (substExpr subst' body)
295 (subst', bndr') = substBndr subst bndr
297 go (Let bind body) = Let bind' (substExpr subst' body)
299 (subst', bind') = substBind subst bind
301 go (Case scrut bndr ty alts) = Case (go scrut) bndr' (substTy subst ty) (map (go_alt subst') alts)
303 (subst', bndr') = substBndr subst bndr
305 go_alt subst (con, bndrs, rhs) = (con, bndrs', substExpr subst' rhs)
307 (subst', bndrs') = substBndrs subst bndrs
311 -- | Apply a substititon to an entire 'CoreBind', additionally returning an updated 'Subst'
312 -- that should be used by subsequent substitutons.
313 substBind :: Subst -> CoreBind -> (Subst, CoreBind)
314 substBind subst (NonRec bndr rhs) = (subst', NonRec bndr' (substExpr subst rhs))
316 (subst', bndr') = substBndr subst bndr
318 substBind subst (Rec pairs) = (subst', Rec pairs')
320 (subst', bndrs') = substRecBndrs subst (map fst pairs)
321 pairs' = bndrs' `zip` rhss'
322 rhss' = map (substExpr subst' . snd) pairs
326 -- | De-shadowing the program is sometimes a useful pre-pass. It can be done simply
327 -- by running over the bindings with an empty substitution, becuase substitution
328 -- returns a result that has no-shadowing guaranteed.
330 -- (Actually, within a single /type/ there might still be shadowing, because
331 -- 'substTy' is a no-op for the empty substitution, but that's probably OK.)
333 -- [Aug 09] This function is not used in GHC at the moment, but seems so
334 -- short and simple that I'm going to leave it here
335 deShadowBinds :: [CoreBind] -> [CoreBind]
336 deShadowBinds binds = snd (mapAccumL substBind emptySubst binds)
340 %************************************************************************
344 %************************************************************************
346 Remember that substBndr and friends are used when doing expression
347 substitution only. Their only business is substitution, so they
348 preserve all IdInfo (suitably substituted). For example, we *want* to
349 preserve occ info in rules.
352 -- | Substitutes a 'Var' for another one according to the 'Subst' given, returning
353 -- the result and an updated 'Subst' that should be used by subsequent substitutons.
354 -- 'IdInfo' is preserved by this process, although it is substituted into appropriately.
355 substBndr :: Subst -> Var -> (Subst, Var)
357 | isTyVar bndr = substTyVarBndr subst bndr
358 | otherwise = substIdBndr subst subst bndr
360 -- | Applies 'substBndr' to a number of 'Var's, accumulating a new 'Subst' left-to-right
361 substBndrs :: Subst -> [Var] -> (Subst, [Var])
362 substBndrs subst bndrs = mapAccumL substBndr subst bndrs
364 -- | Substitute in a mutually recursive group of 'Id's
365 substRecBndrs :: Subst -> [Id] -> (Subst, [Id])
366 substRecBndrs subst bndrs
367 = (new_subst, new_bndrs)
368 where -- Here's the reason we need to pass rec_subst to subst_id
369 (new_subst, new_bndrs) = mapAccumL (substIdBndr new_subst) subst bndrs
374 substIdBndr :: Subst -- ^ Substitution to use for the IdInfo
375 -> Subst -> Id -- ^ Substitition and Id to transform
376 -> (Subst, Id) -- ^ Transformed pair
377 -- NB: unfolding may be zapped
379 substIdBndr rec_subst subst@(Subst in_scope env tvs) old_id
380 = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
382 id1 = uniqAway in_scope old_id -- id1 is cloned if necessary
383 id2 | no_type_change = id1
384 | otherwise = setIdType id1 (substTy subst old_ty)
386 old_ty = idType old_id
387 no_type_change = isEmptyVarEnv tvs ||
388 isEmptyVarSet (Type.tyVarsOfType old_ty)
390 -- new_id has the right IdInfo
391 -- The lazy-set is because we're in a loop here, with
392 -- rec_subst, when dealing with a mutually-recursive group
393 new_id = maybeModifyIdInfo mb_new_info id2
394 mb_new_info = substIdInfo rec_subst id2 (idInfo id2)
395 -- NB: unfolding info may be zapped
397 -- Extend the substitution if the unique has changed
398 -- See the notes with substTyVarBndr for the delVarEnv
399 new_env | no_change = delVarEnv env old_id
400 | otherwise = extendVarEnv env old_id (Var new_id)
402 no_change = id1 == old_id
403 -- See Note [Extending the Subst]
404 -- it's /not/ necessary to check mb_new_info and no_type_change
407 Now a variant that unconditionally allocates a new unique.
408 It also unconditionally zaps the OccInfo.
411 -- | Very similar to 'substBndr', but it always allocates a new 'Unique' for
412 -- each variable in its output and removes all 'IdInfo'
413 cloneIdBndr :: Subst -> UniqSupply -> Id -> (Subst, Id)
414 cloneIdBndr subst us old_id
415 = clone_id subst subst (old_id, uniqFromSupply us)
417 -- | Applies 'cloneIdBndr' to a number of 'Id's, accumulating a final
418 -- substitution from left to right
419 cloneIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
420 cloneIdBndrs subst us ids
421 = mapAccumL (clone_id subst) subst (ids `zip` uniqsFromSupply us)
423 -- | Clone a mutually recursive group of 'Id's
424 cloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
425 cloneRecIdBndrs subst us ids
428 (subst', ids') = mapAccumL (clone_id subst') subst
429 (ids `zip` uniqsFromSupply us)
431 -- Just like substIdBndr, except that it always makes a new unique
432 -- It is given the unique to use
433 clone_id :: Subst -- Substitution for the IdInfo
434 -> Subst -> (Id, Unique) -- Substitition and Id to transform
435 -> (Subst, Id) -- Transformed pair
437 clone_id rec_subst subst@(Subst in_scope env tvs) (old_id, uniq)
438 = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
440 id1 = setVarUnique old_id uniq
441 id2 = substIdType subst id1
442 new_id = maybeModifyIdInfo (substIdInfo rec_subst id2 (idInfo old_id)) id2
443 new_env = extendVarEnv env old_id (Var new_id)
447 %************************************************************************
451 %************************************************************************
453 For types we just call the corresponding function in Type, but we have
454 to repackage the substitution, from a Subst to a TvSubst
457 substTyVarBndr :: Subst -> TyVar -> (Subst, TyVar)
458 substTyVarBndr (Subst in_scope id_env tv_env) tv
459 = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
460 (TvSubst in_scope' tv_env', tv')
461 -> (Subst in_scope' id_env tv_env', tv')
463 -- | See 'Type.substTy'
464 substTy :: Subst -> Type -> Type
465 substTy (Subst in_scope _id_env tv_env) ty
466 = Type.substTy (TvSubst in_scope tv_env) ty
470 %************************************************************************
472 \section{IdInfo substitution}
474 %************************************************************************
477 substIdType :: Subst -> Id -> Id
478 substIdType subst@(Subst _ _ tv_env) id
479 | isEmptyVarEnv tv_env || isEmptyVarSet (Type.tyVarsOfType old_ty) = id
480 | otherwise = setIdType id (substTy subst old_ty)
481 -- The tyVarsOfType is cheaper than it looks
482 -- because we cache the free tyvars of the type
483 -- in a Note in the id's type itself
488 -- | Substitute into some 'IdInfo' with regard to the supplied new 'Id'.
489 -- Always zaps the unfolding, to save substitution work
490 substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo
491 substIdInfo subst new_id info
492 | nothing_to_do = Nothing
493 | otherwise = Just (info `setSpecInfo` substSpec subst new_id old_rules
494 `setUnfoldingInfo` substUnfolding subst old_unf)
496 old_rules = specInfo info
497 old_unf = unfoldingInfo info
498 nothing_to_do = isEmptySpecInfo old_rules && isClosedUnfolding old_unf
502 -- | Substitutes for the 'Id's within an unfolding
503 substUnfolding :: Subst -> Unfolding -> Unfolding
504 -- Seq'ing on the returned Unfolding is enough to cause
505 -- all the substitutions to happen completely
506 substUnfolding subst (DFunUnfolding con args)
507 = DFunUnfolding con (map (substExpr subst) args)
509 substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_guidance = guide@(InlineRule {}) })
510 -- Retain an InlineRule!
511 = seqExpr new_tmpl `seq`
513 unf { uf_tmpl = new_tmpl, uf_guidance = guide { ug_ir_info = new_mb_wkr } }
515 new_tmpl = substExpr subst tmpl
516 new_mb_wkr = substInlineRuleGuidance subst (ug_ir_info guide)
518 substUnfolding _ (CoreUnfolding {}) = NoUnfolding -- Discard
519 -- Always zap a CoreUnfolding, to save substitution work
521 substUnfolding _ unf = unf -- Otherwise no substitution to do
524 substInlineRuleGuidance :: Subst -> InlineRuleInfo -> InlineRuleInfo
525 substInlineRuleGuidance subst (InlWrapper wkr)
526 = case lookupIdSubst subst wkr of
527 Var w1 -> InlWrapper w1
528 other -> WARN( not (exprIsTrivial other), text "CoreSubst.substWorker:" <+> ppr wkr )
529 InlUnSat -- Worker has got substituted away altogether
530 -- (This can happen if it's trivial, via
531 -- postInlineUnconditionally, hence only warning)
532 substInlineRuleGuidance _ info = info
535 substIdOcc :: Subst -> Id -> Id
536 -- These Ids should not be substituted to non-Ids
537 substIdOcc subst v = case lookupIdSubst subst v of
539 other -> pprPanic "substIdOcc" (vcat [ppr v <+> ppr other, ppr subst])
542 -- | Substitutes for the 'Id's within the 'WorkerInfo' given the new function 'Id'
543 substSpec :: Subst -> Id -> SpecInfo -> SpecInfo
544 substSpec subst new_id (SpecInfo rules rhs_fvs)
545 = seqSpecInfo new_spec `seq` new_spec
547 subst_ru_fn = const (idName new_id)
548 new_spec = SpecInfo (map (substRule subst subst_ru_fn) rules)
549 (substVarSet subst rhs_fvs)
552 substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]
553 substRulesForImportedIds subst rules
554 = map (substRule subst (\name -> name)) rules
557 substRule :: Subst -> (Name -> Name) -> CoreRule -> CoreRule
559 -- The subst_ru_fn argument is applied to substitute the ru_fn field
561 -- - Rules for *imported* Ids never change ru_fn
562 -- - Rules for *local* Ids are in the IdInfo for that Id,
563 -- and the ru_fn field is simply replaced by the new name
566 substRule _ _ rule@(BuiltinRule {}) = rule
567 substRule subst subst_ru_fn rule@(Rule { ru_bndrs = bndrs, ru_args = args
568 , ru_fn = fn_name, ru_rhs = rhs })
569 = rule { ru_bndrs = bndrs',
570 ru_fn = subst_ru_fn fn_name,
571 ru_args = map (substExpr subst') args,
572 ru_rhs = substExpr subst' rhs }
574 (subst', bndrs') = substBndrs subst bndrs
577 substVarSet :: Subst -> VarSet -> VarSet
578 substVarSet subst fvs
579 = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
582 | isId fv = exprFreeVars (lookupIdSubst subst fv)
583 | otherwise = Type.tyVarsOfType (lookupTvSubst subst fv)
586 %************************************************************************
588 The Very Simple Optimiser
590 %************************************************************************
593 simpleOptExpr :: CoreExpr -> CoreExpr
594 -- Do simple optimisation on an expression
595 -- The optimisation is very straightforward: just
596 -- inline non-recursive bindings that are used only once,
597 -- or where the RHS is trivial
599 -- The result is NOT guaranteed occurence-analysed, becuase
600 -- in (let x = y in ....) we substitute for x; so y's occ-info
601 -- may change radically
604 = go init_subst (occurAnalyseExpr expr)
606 init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr))
607 -- It's potentially important to make a proper in-scope set
608 -- Consider let x = ..y.. in \y. ...x...
609 -- Then we should remember to clone y before substituting
610 -- for x. It's very unlikely to occur, because we probably
611 -- won't *be* substituting for x if it occurs inside a
614 -- It's a bit painful to call exprFreeVars, because it makes
615 -- three passes instead of two (occ-anal, and go)
617 go subst (Var v) = lookupIdSubst subst v
618 go subst (App e1 e2) = App (go subst e1) (go subst e2)
619 go subst (Type ty) = Type (substTy subst ty)
620 go _ (Lit lit) = Lit lit
621 go subst (Note note e) = Note note (go subst e)
622 go subst (Cast e co) = Cast (go subst e) (substTy subst co)
623 go subst (Let bind body) = go_let subst bind body
624 go subst (Lam bndr body) = Lam bndr' (go subst' body)
626 (subst', bndr') = substBndr subst bndr
628 go subst (Case e b ty as) = Case (go subst e) b'
630 (map (go_alt subst') as)
632 (subst', b') = substBndr subst b
635 ----------------------
636 go_alt subst (con, bndrs, rhs) = (con, bndrs', go subst' rhs)
638 (subst', bndrs') = substBndrs subst bndrs
640 ----------------------
641 go_let subst (Rec prs) body
642 = Let (Rec (reverse rev_prs')) (go subst'' body)
644 (subst', bndrs') = substRecBndrs subst (map fst prs)
645 (subst'', rev_prs') = foldl do_pr (subst', []) (prs `zip` bndrs')
646 do_pr (subst, prs) ((b,r), b') = case go_bind subst b r of
647 Left subst' -> (subst', prs)
648 Right r' -> (subst, (b',r'):prs)
650 go_let subst (NonRec b r) body
651 = case go_bind subst b r of
652 Left subst' -> go subst' body
653 Right r' -> Let (NonRec b' r') (go subst' body)
655 (subst', b') = substBndr subst b
658 ----------------------
659 go_bind :: Subst -> Var -> CoreExpr -> Either Subst CoreExpr
660 -- (go_bind subst old_var old_rhs)
661 -- either extends subst with (old_var -> new_rhs)
662 -- or return new_rhs for a binding new_var = new_rhs
665 , isTyVar b -- let a::* = TYPE ty in <body>
666 = Left (extendTvSubst subst b (substTy subst ty))
668 | isId b -- let x = e in <body>
669 , safe_to_inline (idOccInfo b) || exprIsTrivial r'
670 = Left (extendIdSubst subst b r')
677 ----------------------
678 -- Unconditionally safe to inline
679 safe_to_inline :: OccInfo -> Bool
680 safe_to_inline IAmDead = True
681 safe_to_inline (OneOcc in_lam one_br _) = not in_lam && one_br
682 safe_to_inline (IAmALoopBreaker {}) = False
683 safe_to_inline NoOccInfo = False