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