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