ffbcdb48772fbb178d65583a4a1e0298adc0e17a
[ghc.git] / compiler / simplCore / CSE.hs
1 {-
2 (c) The AQUA Project, Glasgow University, 1993-1998
3
4 \section{Common subexpression}
5 -}
6
7 {-# LANGUAGE CPP #-}
8
9 module CSE (cseProgram, cseOneExpr) where
10
11 #include "HsVersions.h"
12
13 import CoreSubst
14 import Var ( Var )
15 import VarEnv ( elemInScopeSet, mkInScopeSet )
16 import Id ( Id, idType, idInlineActivation, isDeadBinder
17 , zapIdOccInfo, zapIdUsageInfo, idInlinePragma
18 , isJoinId )
19 import CoreUtils ( mkAltExpr, eqExpr
20 , exprIsLiteralString
21 , stripTicksE, stripTicksT, mkTicks )
22 import CoreFVs ( exprFreeVars )
23 import Type ( tyConAppArgs )
24 import CoreSyn
25 import Outputable
26 import BasicTypes ( TopLevelFlag(..), isTopLevel
27 , isAlwaysActive, isAnyInlinePragma )
28 import TrieMap
29 import Util ( filterOut )
30 import Data.List ( mapAccumL )
31
32 {-
33 Simple common sub-expression
34 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
35 When we see
36 x1 = C a b
37 x2 = C x1 b
38 we build up a reverse mapping: C a b -> x1
39 C x1 b -> x2
40 and apply that to the rest of the program.
41
42 When we then see
43 y1 = C a b
44 y2 = C y1 b
45 we replace the C a b with x1. But then we *dont* want to
46 add x1 -> y1 to the mapping. Rather, we want the reverse, y1 -> x1
47 so that a subsequent binding
48 y2 = C y1 b
49 will get transformed to C x1 b, and then to x2.
50
51 So we carry an extra var->var substitution which we apply *before* looking up in the
52 reverse mapping.
53
54
55 Note [Shadowing]
56 ~~~~~~~~~~~~~~~~
57 We have to be careful about shadowing.
58 For example, consider
59 f = \x -> let y = x+x in
60 h = \x -> x+x
61 in ...
62
63 Here we must *not* do CSE on the inner x+x! The simplifier used to guarantee no
64 shadowing, but it doesn't any more (it proved too hard), so we clone as we go.
65 We can simply add clones to the substitution already described.
66
67
68 Note [CSE for bindings]
69 ~~~~~~~~~~~~~~~~~~~~~~~
70 Let-bindings have two cases, implemented by addBinding.
71
72 * SUBSTITUTE: applies when the RHS is a variable
73
74 let x = y in ...(h x)....
75
76 Here we want to extend the /substitution/ with x -> y, so that the
77 (h x) in the body might CSE with an enclosing (let v = h y in ...).
78 NB: the substitution maps InIds, so we extend the substitution with
79 a binding for the original InId 'x'
80
81 How can we have a variable on the RHS? Doesn't the simplifier inline them?
82
83 - First, the original RHS might have been (g z) which has CSE'd
84 with an enclosing (let y = g z in ...). This is super-important.
85 See Trac #5996:
86 x1 = C a b
87 x2 = C x1 b
88 y1 = C a b
89 y2 = C y1 b
90 Here we CSE y1's rhs to 'x1', and then we must add (y1->x1) to
91 the substitution so that we can CSE the binding for y2.
92
93 - Second, we use addBinding for case expression scrutinees too;
94 see Note [CSE for case expressions]
95
96 * EXTEND THE REVERSE MAPPING: applies in all other cases
97
98 let x = h y in ...(h y)...
99
100 Here we want to extend the /reverse mapping (cs_map)/ so that
101 we CSE the (h y) call to x.
102
103 Note that we use EXTEND even for a trivial expression, provided it
104 is not a variable or literal. In particular this /includes/ type
105 applications. This can be important (Trac #13156); e.g.
106 case f @ Int of { r1 ->
107 case f @ Int of { r2 -> ...
108 Here we want to common-up the two uses of (f @ Int) so we can
109 remove one of the case expressions.
110
111 See also Note [Corner case for case expressions] for another
112 reason not to use SUBSTITUTE for all trivial expressions.
113
114 Notice that
115 - The SUBSTITUTE situation extends the substitution (cs_subst)
116 - The EXTEND situation extends the reverse mapping (cs_map)
117
118 Notice also that in the SUBSTITUTE case we leave behind a binding
119 x = y
120 even though we /also/ carry a substitution x -> y. Can we just drop
121 the binding instead? Well, not at top level! See SimplUtils
122 Note [Top level and postInlineUnconditionally]; and in any case CSE
123 applies only to the /bindings/ of the program, and we leave it to the
124 simplifier to propate effects to the RULES. Finally, it doesn't seem
125 worth the effort to discard the nested bindings because the simplifier
126 will do it next.
127
128 Note [CSE for case expressions]
129 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
130 Consider
131 case scrut_expr of x { ...alts... }
132 This is very like a strict let-binding
133 let !x = scrut_expr in ...
134 So we use (addBinding x scrut_expr) to process scrut_expr and x, and as a
135 result all the stuff under Note [CSE for bindings] applies directly.
136
137 For example:
138
139 * Trivial scrutinee
140 f = \x -> case x of wild {
141 (a:as) -> case a of wild1 {
142 (p,q) -> ...(wild1:as)...
143
144 Here, (wild1:as) is morally the same as (a:as) and hence equal to
145 wild. But that's not quite obvious. In the rest of the compiler we
146 want to keep it as (wild1:as), but for CSE purpose that's a bad
147 idea.
148
149 By using addBinding we add the binding (wild1 -> a) to the substitution,
150 which does exactly the right thing.
151
152 (Notice this is exactly backwards to what the simplifier does, which
153 is to try to replaces uses of 'a' with uses of 'wild1'.)
154
155 This is the main reason that addBinding is called with a trivial rhs.
156
157 * Non-trivial scrutinee
158 case (f x) of y { pat -> ...let z = f x in ... }
159
160 By using addBinding we'll add (f x :-> y) to the cs_map, and
161 thereby CSE the inner (f x) to y.
162
163 Note [CSE for INLINE and NOINLINE]
164 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
165 There are some subtle interactions of CSE with functions that the user
166 has marked as INLINE or NOINLINE. (Examples from Roman Leshchinskiy.)
167 Consider
168
169 yes :: Int {-# NOINLINE yes #-}
170 yes = undefined
171
172 no :: Int {-# NOINLINE no #-}
173 no = undefined
174
175 foo :: Int -> Int -> Int {-# NOINLINE foo #-}
176 foo m n = n
177
178 {-# RULES "foo/no" foo no = id #-}
179
180 bar :: Int -> Int
181 bar = foo yes
182
183 We do not expect the rule to fire. But if we do CSE, then we risk
184 getting yes=no, and the rule does fire. Actually, it won't because
185 NOINLINE means that 'yes' will never be inlined, not even if we have
186 yes=no. So that's fine (now; perhaps in the olden days, yes=no would
187 have substituted even if 'yes' was NOINLINE).
188
189 But we do need to take care. Consider
190
191 {-# NOINLINE bar #-}
192 bar = <rhs> -- Same rhs as foo
193
194 foo = <rhs>
195
196 If CSE produces
197 foo = bar
198 then foo will never be inlined to <rhs> (when it should be, if <rhs>
199 is small). The conclusion here is this:
200
201 We should not add
202 <rhs> :-> bar
203 to the CSEnv if 'bar' has any constraints on when it can inline;
204 that is, if its 'activation' not always active. Otherwise we
205 might replace <rhs> by 'bar', and then later be unable to see that it
206 really was <rhs>.
207
208 Note that we do not (currently) do CSE on the unfolding stored inside
209 an Id, even if is a 'stable' unfolding. That means that when an
210 unfolding happens, it is always faithful to what the stable unfolding
211 originally was.
212
213 Note [CSE for stable unfoldings]
214 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
215 Consider
216 {-# Unf = Stable (\pq. build blah) #-}
217 foo = x
218
219 Here 'foo' has a stable unfolding, but its (optimised) RHS is trivial.
220 (Turns out that this actually happens for the enumFromTo method of
221 the Integer instance of Enum in GHC.Enum.) Suppose moreover that foo's
222 stable unfolding originates from an INLINE or INLINEABLE pragma on foo.
223 Then we obviously do NOT want to extend the substitution with (foo->x),
224 because we promised to inline foo as what the user wrote. See similar
225 SimplUtils Note [Stable unfoldings and postInlineUnconditionally].
226
227 Nor do we want to change the reverse mapping. Suppose we have
228
229 {-# Unf = Stable (\pq. build blah) #-}
230 foo = <expr>
231 bar = <expr>
232
233 There could conceivably be merit in rewriting the RHS of bar:
234 bar = foo
235 but now bar's inlining behaviour will change, and importing
236 modules might see that. So it seems dodgy and we don't do it.
237
238 Stable unfoldings are also created during worker/wrapper when we decide
239 that a function's definition is so small that it should always inline.
240 In this case we still want to do CSE (#13340). Hence the use of
241 isAnyInlinePragma rather than isStableUnfolding.
242
243 Note [Corner case for case expressions]
244 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
245 Here is another reason that we do not use SUBSTITUTE for
246 all trivial expressions. Consider
247 case x |> co of (y::Array# Int) { ... }
248
249 We do not want to extend the substitution with (y -> x |> co); since y
250 is of unlifted type, this would destroy the let/app invariant if (x |>
251 co) was not ok-for-speculation.
252
253 But surely (x |> co) is ok-for-speculation, becasue it's a trivial
254 expression, and x's type is also unlifted, presumably. Well, maybe
255 not if you are using unsafe casts. I actually found a case where we
256 had
257 (x :: HValue) |> (UnsafeCo :: HValue ~ Array# Int)
258
259 Note [CSE for join points?]
260 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
261 We must not be naive about join points in CSE:
262 join j = e in
263 if b then jump j else 1 + e
264 The expression (1 + jump j) is not good (see Note [Invariants on join points] in
265 CoreSyn). This seems to come up quite seldom, but it happens (first seen
266 compiling ppHtml in Haddock.Backends.Xhtml).
267
268 We could try and be careful by tracking which join points are still valid at
269 each subexpression, but since join points aren't allocated or shared, there's
270 less to gain by trying to CSE them.
271
272 Note [CSE for recursive bindings]
273 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
274 Consider
275 f = \x ... f....
276 g = \y ... g ...
277 where the "..." are identical. Could we CSE them? In full generality
278 with mutual recursion it's quite hard; but for self-recursive bindings
279 (which are very common) it's rather easy:
280
281 * Maintain a separate cs_rec_map, that maps
282 (\f. (\x. ...f...) ) -> f
283 Note the \f in the domain of the mapping!
284
285 * When we come across the binding for 'g', look up (\g. (\y. ...g...))
286 Bingo we get a hit. So we can replace the 'g' binding with
287 g = f
288
289 We can't use cs_map for this, because the key isn't an expression of
290 the program; it's a kind of synthetic key for recursive bindings.
291
292
293 ************************************************************************
294 * *
295 \section{Common subexpression}
296 * *
297 ************************************************************************
298 -}
299
300 cseProgram :: CoreProgram -> CoreProgram
301 cseProgram binds = snd (mapAccumL (cseBind TopLevel) emptyCSEnv binds)
302
303 cseBind :: TopLevelFlag -> CSEnv -> CoreBind -> (CSEnv, CoreBind)
304 cseBind toplevel env (NonRec b e)
305 = (env2, NonRec b2 e2)
306 where
307 (env1, b1) = addBinder env b
308 (env2, (b2, e2)) = cse_bind toplevel env1 (b,e) b1
309
310 cseBind _ env (Rec [(in_id, rhs)])
311 | noCSE in_id
312 = (env1, Rec [(out_id, rhs')])
313
314 -- See Note [CSE for recursive bindings]
315 | Just previous <- lookupCSRecEnv env out_id rhs''
316 , let previous' = mkTicks ticks previous
317 = (extendCSSubst env1 in_id previous', NonRec out_id previous')
318
319 | otherwise
320 = (extendCSRecEnv env1 out_id rhs'' id_expr', Rec [(zapped_id, rhs')])
321
322 where
323 (env1, [out_id]) = addRecBinders env [in_id]
324 rhs' = cseExpr env1 rhs
325 rhs'' = stripTicksE tickishFloatable rhs'
326 ticks = stripTicksT tickishFloatable rhs'
327 id_expr' = varToCoreExpr out_id
328 zapped_id = zapIdUsageInfo out_id
329
330 cseBind toplevel env (Rec pairs)
331 = (env2, Rec pairs')
332 where
333 (env1, bndrs1) = addRecBinders env (map fst pairs)
334 (env2, pairs') = mapAccumL do_one env1 (zip pairs bndrs1)
335
336 do_one env (pr, b1) = cse_bind toplevel env pr b1
337
338 -- | Given a binding of @in_id@ to @in_rhs@, and a fresh name to refer
339 -- to @in_id@ (@out_id@, created from addBinder or addRecBinders),
340 -- first try to CSE @in_rhs@, and then add the resulting (possibly CSE'd)
341 -- binding to the 'CSEnv', so that we attempt to CSE any expressions
342 -- which are equal to @out_rhs@.
343 cse_bind :: TopLevelFlag -> CSEnv -> (InId, InExpr) -> OutId -> (CSEnv, (OutId, OutExpr))
344 cse_bind toplevel env (in_id, in_rhs) out_id
345 | isTopLevel toplevel, exprIsLiteralString in_rhs
346 -- See Note [Take care with literal strings]
347 = (env', (out_id, in_rhs))
348
349 | otherwise
350 = (env', (out_id', out_rhs))
351 where
352 out_rhs = tryForCSE env in_rhs
353 (env', out_id') = addBinding env in_id out_id out_rhs
354
355 addBinding :: CSEnv -- Includes InId->OutId cloning
356 -> InVar -- Could be a let-bound type
357 -> OutId -> OutExpr -- Processed binding
358 -> (CSEnv, OutId) -- Final env, final bndr
359 -- Extend the CSE env with a mapping [rhs -> out-id]
360 -- unless we can instead just substitute [in-id -> rhs]
361 --
362 -- It's possible for the binder to be a type variable (see
363 -- Note [Type-let] in CoreSyn), in which case we can just substitute.
364 addBinding env in_id out_id rhs'
365 | not (isId in_id) = (extendCSSubst env in_id rhs', out_id)
366 | noCSE in_id = (env, out_id)
367 | use_subst = (extendCSSubst env in_id rhs', out_id)
368 | otherwise = (extendCSEnv env rhs' id_expr', zapped_id)
369 where
370 id_expr' = varToCoreExpr out_id
371 zapped_id = zapIdUsageInfo out_id
372 -- Putting the Id into the cs_map makes it possible that
373 -- it'll become shared more than it is now, which would
374 -- invalidate (the usage part of) its demand info.
375 -- This caused Trac #100218.
376 -- Easiest thing is to zap the usage info; subsequently
377 -- performing late demand-analysis will restore it. Don't zap
378 -- the strictness info; it's not necessary to do so, and losing
379 -- it is bad for performance if you don't do late demand
380 -- analysis
381
382 -- Should we use SUBSTITUTE or EXTEND?
383 -- See Note [CSE for bindings]
384 use_subst = case rhs' of
385 Var {} -> True
386 _ -> False
387
388 noCSE :: InId -> Bool
389 noCSE id = not (isAlwaysActive (idInlineActivation id))
390 -- See Note [CSE for INLINE and NOINLINE]
391 || isAnyInlinePragma (idInlinePragma id)
392 -- See Note [CSE for stable unfoldings]
393 || isJoinId id
394 -- See Note [CSE for join points?]
395
396
397 {- Note [Take care with literal strings]
398 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
399 Consider this example:
400
401 x = "foo"#
402 y = "foo"#
403 ...x...y...x...y....
404
405 We would normally turn this into:
406
407 x = "foo"#
408 y = x
409 ...x...x...x...x....
410
411 But this breaks an invariant of Core, namely that the RHS of a top-level binding
412 of type Addr# must be a string literal, not another variable. See Note
413 [CoreSyn top-level string literals] in CoreSyn.
414
415 For this reason, we special case top-level bindings to literal strings and leave
416 the original RHS unmodified. This produces:
417
418 x = "foo"#
419 y = "foo"#
420 ...x...x...x...x....
421
422 Now 'y' will be discarded as dead code, and we are done.
423
424 The net effect is that for the y-binding we want to
425 - Use SUBSTITUTE, by extending the substitution with y :-> x
426 - but leave the original binding for y undisturbed
427
428 This is done by cse_bind. I got it wrong the first time (Trac #13367).
429 -}
430
431 tryForCSE :: CSEnv -> InExpr -> OutExpr
432 tryForCSE env expr
433 | Just e <- lookupCSEnv env expr'' = mkTicks ticks e
434 | otherwise = expr'
435 -- The varToCoreExpr is needed if we have
436 -- case e of xco { ...case e of yco { ... } ... }
437 -- Then CSE will substitute yco -> xco;
438 -- but these are /coercion/ variables
439 where
440 expr' = cseExpr env expr
441 expr'' = stripTicksE tickishFloatable expr'
442 ticks = stripTicksT tickishFloatable expr'
443 -- We don't want to lose the source notes when a common sub
444 -- expression gets eliminated. Hence we push all (!) of them on
445 -- top of the replaced sub-expression. This is probably not too
446 -- useful in practice, but upholds our semantics.
447
448 -- | Runs CSE on a single expression.
449 --
450 -- This entry point is not used in the compiler itself, but is provided
451 -- as a convenient entry point for users of the GHC API.
452 cseOneExpr :: InExpr -> OutExpr
453 cseOneExpr e = cseExpr env e
454 where env = emptyCSEnv {cs_subst = mkEmptySubst (mkInScopeSet (exprFreeVars e)) }
455
456 cseExpr :: CSEnv -> InExpr -> OutExpr
457 cseExpr env (Type t) = Type (substTy (csEnvSubst env) t)
458 cseExpr env (Coercion c) = Coercion (substCo (csEnvSubst env) c)
459 cseExpr _ (Lit lit) = Lit lit
460 cseExpr env (Var v) = lookupSubst env v
461 cseExpr env (App f a) = App (cseExpr env f) (tryForCSE env a)
462 cseExpr env (Tick t e) = Tick t (cseExpr env e)
463 cseExpr env (Cast e co) = Cast (tryForCSE env e) (substCo (csEnvSubst env) co)
464 cseExpr env (Lam b e) = let (env', b') = addBinder env b
465 in Lam b' (cseExpr env' e)
466 cseExpr env (Let bind e) = let (env', bind') = cseBind NotTopLevel env bind
467 in Let bind' (cseExpr env' e)
468 cseExpr env (Case e bndr ty alts) = cseCase env e bndr ty alts
469
470 cseCase :: CSEnv -> InExpr -> InId -> InType -> [InAlt] -> OutExpr
471 cseCase env scrut bndr ty alts
472 = Case scrut1 bndr3 ty' $
473 combineAlts alt_env (map cse_alt alts)
474 where
475 ty' = substTy (csEnvSubst env) ty
476 scrut1 = tryForCSE env scrut
477
478 bndr1 = zapIdOccInfo bndr
479 -- Zapping the OccInfo is needed because the extendCSEnv
480 -- in cse_alt may mean that a dead case binder
481 -- becomes alive, and Lint rejects that
482 (env1, bndr2) = addBinder env bndr1
483 (alt_env, bndr3) = addBinding env1 bndr bndr2 scrut1
484 -- addBinding: see Note [CSE for case expressions]
485
486 con_target :: OutExpr
487 con_target = lookupSubst alt_env bndr
488
489 arg_tys :: [OutType]
490 arg_tys = tyConAppArgs (idType bndr3)
491
492 -- Given case x of { K y z -> ...K y z... }
493 -- CSE K y z into x...
494 cse_alt (DataAlt con, args, rhs)
495 | not (null args)
496 -- ... but don't try CSE if there are no args; it just increases the number
497 -- of live vars. E.g.
498 -- case x of { True -> ....True.... }
499 -- Don't replace True by x!
500 -- Hence the 'null args', which also deal with literals and DEFAULT
501 = (DataAlt con, args', tryForCSE new_env rhs)
502 where
503 (env', args') = addBinders alt_env args
504 new_env = extendCSEnv env' con_expr con_target
505 con_expr = mkAltExpr (DataAlt con) args' arg_tys
506
507 cse_alt (con, args, rhs)
508 = (con, args', tryForCSE env' rhs)
509 where
510 (env', args') = addBinders alt_env args
511
512 combineAlts :: CSEnv -> [InAlt] -> [InAlt]
513 -- See Note [Combine case alternatives]
514 combineAlts env ((_,bndrs1,rhs1) : rest_alts)
515 | all isDeadBinder bndrs1
516 = (DEFAULT, [], rhs1) : filtered_alts
517 where
518 in_scope = substInScope (csEnvSubst env)
519 filtered_alts = filterOut identical rest_alts
520 identical (_con, bndrs, rhs) = all ok bndrs && eqExpr in_scope rhs1 rhs
521 ok bndr = isDeadBinder bndr || not (bndr `elemInScopeSet` in_scope)
522
523 combineAlts _ alts = alts -- Default case
524
525 {- Note [Combine case alternatives]
526 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
527 combineAlts is just a more heavyweight version of the use of
528 combineIdenticalAlts in SimplUtils.prepareAlts. The basic idea is
529 to transform
530
531 DEFAULT -> e1
532 K x -> e1
533 W y z -> e2
534 ===>
535 DEFAULT -> e1
536 W y z -> e2
537
538 In the simplifier we use cheapEqExpr, because it is called a lot.
539 But here in CSE we use the full eqExpr. After all, two alterantives usually
540 differ near the root, so it probably isn't expensive to compare the full
541 alternative. It seems like the the same kind of thing that CSE is supposed
542 to be doing, which is why I put it here.
543
544 I acutally saw some examples in the wild, where some inlining made e1 too
545 big for cheapEqExpr to catch it.
546
547
548 ************************************************************************
549 * *
550 \section{The CSE envt}
551 * *
552 ************************************************************************
553 -}
554
555 data CSEnv
556 = CS { cs_subst :: Subst -- Maps InBndrs to OutExprs
557 -- The substitution variables to
558 -- /trivial/ OutExprs, not arbitrary expressions
559
560 , cs_map :: CoreMap OutExpr -- The reverse mapping
561 -- Maps a OutExpr to a /trivial/ OutExpr
562 -- The key of cs_map is stripped of all Ticks
563
564 , cs_rec_map :: CoreMap OutExpr
565 -- See Note [CSE for recursive bindings]
566 }
567
568 emptyCSEnv :: CSEnv
569 emptyCSEnv = CS { cs_map = emptyCoreMap, cs_rec_map = emptyCoreMap
570 , cs_subst = emptySubst }
571
572 lookupCSEnv :: CSEnv -> OutExpr -> Maybe OutExpr
573 lookupCSEnv (CS { cs_map = csmap }) expr
574 = lookupCoreMap csmap expr
575
576 extendCSEnv :: CSEnv -> OutExpr -> OutExpr -> CSEnv
577 extendCSEnv cse expr triv_expr
578 = cse { cs_map = extendCoreMap (cs_map cse) sexpr triv_expr }
579 where
580 sexpr = stripTicksE tickishFloatable expr
581
582 extendCSRecEnv :: CSEnv -> OutId -> OutExpr -> OutExpr -> CSEnv
583 -- See Note [CSE for recursive bindings]
584 extendCSRecEnv cse bndr expr triv_expr
585 = cse { cs_rec_map = extendCoreMap (cs_rec_map cse) (Lam bndr expr) triv_expr }
586
587 lookupCSRecEnv :: CSEnv -> OutId -> OutExpr -> Maybe OutExpr
588 -- See Note [CSE for recursive bindings]
589 lookupCSRecEnv (CS { cs_rec_map = csmap }) bndr expr
590 = lookupCoreMap csmap (Lam bndr expr)
591
592 csEnvSubst :: CSEnv -> Subst
593 csEnvSubst = cs_subst
594
595 lookupSubst :: CSEnv -> Id -> OutExpr
596 lookupSubst (CS { cs_subst = sub}) x = lookupIdSubst (text "CSE.lookupSubst") sub x
597
598 extendCSSubst :: CSEnv -> Id -> CoreExpr -> CSEnv
599 extendCSSubst cse x rhs = cse { cs_subst = extendSubst (cs_subst cse) x rhs }
600
601 -- | Add clones to the substitution to deal with shadowing. See
602 -- Note [Shadowing] for more details. You should call this whenever
603 -- you go under a binder.
604 addBinder :: CSEnv -> Var -> (CSEnv, Var)
605 addBinder cse v = (cse { cs_subst = sub' }, v')
606 where
607 (sub', v') = substBndr (cs_subst cse) v
608
609 addBinders :: CSEnv -> [Var] -> (CSEnv, [Var])
610 addBinders cse vs = (cse { cs_subst = sub' }, vs')
611 where
612 (sub', vs') = substBndrs (cs_subst cse) vs
613
614 addRecBinders :: CSEnv -> [Id] -> (CSEnv, [Id])
615 addRecBinders cse vs = (cse { cs_subst = sub' }, vs')
616 where
617 (sub', vs') = substRecBndrs (cs_subst cse) vs