never executed always true always false
1 {-# LANGUAGE TypeFamilies #-}
2
3 {-|
4 Note [CSE for Stg]
5 ~~~~~~~~~~~~~~~~~~
6
7 This module implements a simple common subexpression elimination pass for STG.
8 This is useful because there are expressions that we want to common up (because
9 they are operationally equivalent), but that we cannot common up in Core, because
10 their types differ.
11 This was originally reported as #9291.
12
13 There are two types of common code occurrences that we aim for, see
14 note [Case 1: CSEing allocated closures] and
15 note [Case 2: CSEing case binders] below.
16
17
18 Note [Case 1: CSEing allocated closures]
19 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
20
21 The first kind of CSE opportunity we aim for is generated by this Haskell code:
22
23 bar :: a -> (Either Int a, Either Bool a)
24 bar x = (Right x, Right x)
25
26 which produces this Core:
27
28 bar :: forall a. a -> (Either Int a, Either Bool a)
29 bar @a x = (Right @Int @a x, Right @Bool @a x)
30
31 where the two components of the tuple are different terms, and cannot be
32 commoned up (easily). On the STG level we have
33
34 bar [x] = let c1 = Right [x]
35 c2 = Right [x]
36 in (c1,c2)
37
38 and now it is obvious that we can write
39
40 bar [x] = let c1 = Right [x]
41 in (c1,c1)
42
43 instead.
44
45
46 Note [Case 2: CSEing case binders]
47 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
48
49 The second kind of CSE opportunity we aim for is more interesting, and
50 came up in #9291 and #5344: The Haskell code
51
52 foo :: Either Int a -> Either Bool a
53 foo (Right x) = Right x
54 foo _ = Left False
55
56 produces this Core
57
58 foo :: forall a. Either Int a -> Either Bool a
59 foo @a e = case e of b { Left n -> …
60 , Right x -> Right @Bool @a x }
61
62 where we cannot CSE `Right @Bool @a x` with the case binder `b` as they have
63 different types. But in STG we have
64
65 foo [e] = case e of b { Left [n] -> …
66 , Right [x] -> Right [x] }
67
68 and nothing stops us from transforming that to
69
70 foo [e] = case e of b { Left [n] -> …
71 , Right [x] -> b}
72
73
74 Note [StgCse after unarisation]
75 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
76
77 Consider two unboxed sum terms:
78
79 (# 1 | #) :: (# Int | Int# #)
80 (# 1 | #) :: (# Int | Int #)
81
82 These two terms are not equal as they unarise to different unboxed
83 tuples. However if we run StgCse before Unarise, it'll think the two
84 terms (# 1 | #) are equal, and replace one of these with a binder to
85 the other. That's bad -- #15300.
86
87 Solution: do unarise first.
88
89 -}
90
91 module GHC.Stg.CSE (stgCse) where
92
93 import GHC.Prelude
94
95 import GHC.Core.DataCon
96 import GHC.Types.Id
97 import GHC.Stg.Syntax
98 import GHC.Types.Basic (isWeakLoopBreaker)
99 import GHC.Types.Var.Env
100 import GHC.Core (AltCon(..))
101 import Data.List (mapAccumL)
102 import Data.Maybe (fromMaybe)
103 import GHC.Core.Map.Expr
104 import GHC.Data.TrieMap
105 import GHC.Types.Name.Env
106 import Control.Monad( (>=>) )
107
108 --------------
109 -- The Trie --
110 --------------
111
112 -- A lookup trie for data constructor applications, i.e.
113 -- keys of type `(DataCon, [StgArg])`, following the patterns in GHC.Data.TrieMap.
114
115 data StgArgMap a = SAM
116 { sam_var :: DVarEnv a
117 , sam_lit :: LiteralMap a
118 }
119
120 instance TrieMap StgArgMap where
121 type Key StgArgMap = StgArg
122 emptyTM = SAM { sam_var = emptyTM
123 , sam_lit = emptyTM }
124 lookupTM (StgVarArg var) = sam_var >.> lkDFreeVar var
125 lookupTM (StgLitArg lit) = sam_lit >.> lookupTM lit
126 alterTM (StgVarArg var) f m = m { sam_var = sam_var m |> xtDFreeVar var f }
127 alterTM (StgLitArg lit) f m = m { sam_lit = sam_lit m |> alterTM lit f }
128 foldTM k m = foldTM k (sam_var m) . foldTM k (sam_lit m)
129 mapTM f (SAM {sam_var = varm, sam_lit = litm}) =
130 SAM { sam_var = mapTM f varm, sam_lit = mapTM f litm }
131 filterTM f (SAM {sam_var = varm, sam_lit = litm}) =
132 SAM { sam_var = filterTM f varm, sam_lit = filterTM f litm }
133
134 newtype ConAppMap a = CAM { un_cam :: DNameEnv (ListMap StgArgMap a) }
135
136 instance TrieMap ConAppMap where
137 type Key ConAppMap = (DataCon, [StgArg])
138 emptyTM = CAM emptyTM
139 lookupTM (dataCon, args) = un_cam >.> lkDNamed dataCon >=> lookupTM args
140 alterTM (dataCon, args) f m =
141 m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f }
142 foldTM k = un_cam >.> foldTM (foldTM k)
143 mapTM f = un_cam >.> mapTM (mapTM f) >.> CAM
144 filterTM f = un_cam >.> mapTM (filterTM f) >.> CAM
145
146 -----------------
147 -- The CSE Env --
148 -----------------
149
150 -- | The CSE environment. See note [CseEnv Example]
151 data CseEnv = CseEnv
152 { ce_conAppMap :: ConAppMap OutId
153 -- ^ The main component of the environment is the trie that maps
154 -- data constructor applications (with their `OutId` arguments)
155 -- to an in-scope name that can be used instead.
156 -- This name is always either a let-bound variable or a case binder.
157 , ce_subst :: IdEnv OutId
158 -- ^ This substitution is applied to the code as we traverse it.
159 -- Entries have one of two reasons:
160 --
161 -- * The input might have shadowing (see Note [Shadowing]), so we have
162 -- to rename some binders as we traverse the tree.
163 -- * If we remove `let x = Con z` because `let y = Con z` is in scope,
164 -- we note this here as x ↦ y.
165 , ce_bndrMap :: IdEnv OutId
166 -- ^ If we come across a case expression case x as b of … with a trivial
167 -- binder, we add b ↦ x to this.
168 -- This map is *only* used when looking something up in the ce_conAppMap.
169 -- See Note [Trivial case scrutinee]
170 , ce_in_scope :: InScopeSet
171 -- ^ The third component is an in-scope set, to rename away any
172 -- shadowing binders
173 }
174
175 {-|
176 Note [CseEnv Example]
177 ~~~~~~~~~~~~~~~~~~~~~
178 The following tables shows how the CseEnvironment changes as code is traversed,
179 as well as the changes to that code.
180
181 InExpr OutExpr
182 conAppMap subst in_scope
183 ───────────────────────────────────────────────────────────
184 -- empty {} {}
185 case … as a of {Con x y -> case … as a of {Con x y ->
186 -- Con x y ↦ a {} {a,x,y}
187 let b = Con x y (removed)
188 -- Con x y ↦ a b↦a {a,x,y,b}
189 let c = Bar a let c = Bar a
190 -- Con x y ↦ a, Bar a ↦ c b↦a {a,x,y,b,c}
191 let c = some expression let c' = some expression
192 -- Con x y ↦ a, Bar a ↦ c b↦a, c↦c', {a,x,y,b,c,c'}
193 let d = Bar b (removed)
194 -- Con x y ↦ a, Bar a ↦ c b↦a, c↦c', d↦c {a,x,y,b,c,c',d}
195 (a, b, c d) (a, a, c' c)
196 -}
197
198 initEnv :: InScopeSet -> CseEnv
199 initEnv in_scope = CseEnv
200 { ce_conAppMap = emptyTM
201 , ce_subst = emptyVarEnv
202 , ce_bndrMap = emptyVarEnv
203 , ce_in_scope = in_scope
204 }
205
206 -------------------
207 normaliseConArgs :: CseEnv -> [OutStgArg] -> [OutStgArg]
208 -- See Note [Trivial case scrutinee]
209 normaliseConArgs env args
210 = map go args
211 where
212 bndr_map = ce_bndrMap env
213 go (StgVarArg v ) = StgVarArg (normaliseId bndr_map v)
214 go (StgLitArg lit) = StgLitArg lit
215
216 normaliseId :: IdEnv OutId -> OutId -> OutId
217 normaliseId bndr_map v = case lookupVarEnv bndr_map v of
218 Just v' -> v'
219 Nothing -> v
220
221 addTrivCaseBndr :: OutId -> OutId -> CseEnv -> CseEnv
222 -- See Note [Trivial case scrutinee]
223 addTrivCaseBndr from to env
224 = env { ce_bndrMap = extendVarEnv bndr_map from norm_to }
225 where
226 bndr_map = ce_bndrMap env
227 norm_to = normaliseId bndr_map to
228
229 envLookup :: DataCon -> [OutStgArg] -> CseEnv -> Maybe OutId
230 envLookup dataCon args env
231 = lookupTM (dataCon, normaliseConArgs env args)
232 (ce_conAppMap env)
233 -- normaliseConArgs: See Note [Trivial case scrutinee]
234
235 addDataCon :: OutId -> DataCon -> [OutStgArg] -> CseEnv -> CseEnv
236 -- Do not bother with nullary data constructors; they are static anyway
237 addDataCon _ _ [] env = env
238 addDataCon bndr dataCon args env
239 = env { ce_conAppMap = new_env }
240 where
241 new_env = insertTM (dataCon, normaliseConArgs env args)
242 bndr (ce_conAppMap env)
243 -- normaliseConArgs: See Note [Trivial case scrutinee]
244
245 -------------------
246 forgetCse :: CseEnv -> CseEnv
247 forgetCse env = env { ce_conAppMap = emptyTM }
248 -- See note [Free variables of an StgClosure]
249
250 addSubst :: OutId -> OutId -> CseEnv -> CseEnv
251 addSubst from to env
252 = env { ce_subst = extendVarEnv (ce_subst env) from to }
253
254 substArgs :: CseEnv -> [InStgArg] -> [OutStgArg]
255 substArgs env = map (substArg env)
256
257 substArg :: CseEnv -> InStgArg -> OutStgArg
258 substArg env (StgVarArg from) = StgVarArg (substVar env from)
259 substArg _ (StgLitArg lit) = StgLitArg lit
260
261 substVar :: CseEnv -> InId -> OutId
262 substVar env id = fromMaybe id $ lookupVarEnv (ce_subst env) id
263
264 -- Functions to enter binders
265
266 -- This is much simpler than the equivalent code in GHC.Core.Subst:
267 -- * We do not substitute type variables, and
268 -- * There is nothing relevant in GHC.Types.Id.Info at this stage
269 -- that needs substitutions.
270 -- Therefore, no special treatment for a recursive group is required.
271
272 substBndr :: CseEnv -> InId -> (CseEnv, OutId)
273 substBndr env old_id
274 = (new_env, new_id)
275 where
276 new_id = uniqAway (ce_in_scope env) old_id
277 no_change = new_id == old_id
278 env' = env { ce_in_scope = ce_in_scope env `extendInScopeSet` new_id }
279 new_env | no_change = env'
280 | otherwise = env' { ce_subst = extendVarEnv (ce_subst env) old_id new_id }
281
282 substBndrs :: CseEnv -> [InVar] -> (CseEnv, [OutVar])
283 substBndrs env bndrs = mapAccumL substBndr env bndrs
284
285 substPairs :: CseEnv -> [(InVar, a)] -> (CseEnv, [(OutVar, a)])
286 substPairs env bndrs = mapAccumL go env bndrs
287 where go env (id, x) = let (env', id') = substBndr env id
288 in (env', (id', x))
289
290 -- Main entry point
291
292 stgCse :: [InStgTopBinding] -> [OutStgTopBinding]
293 stgCse binds = snd $ mapAccumL stgCseTopLvl emptyInScopeSet binds
294
295 -- Top level bindings.
296 --
297 -- We do not CSE these, as top-level closures are allocated statically anyways.
298 -- Also, they might be exported.
299 -- But we still have to collect the set of in-scope variables, otherwise
300 -- uniqAway might shadow a top-level closure.
301
302 stgCseTopLvl :: InScopeSet -> InStgTopBinding -> (InScopeSet, OutStgTopBinding)
303 stgCseTopLvl in_scope t@(StgTopStringLit _ _) = (in_scope, t)
304 stgCseTopLvl in_scope (StgTopLifted (StgNonRec bndr rhs))
305 = (in_scope'
306 , StgTopLifted (StgNonRec bndr (stgCseTopLvlRhs in_scope rhs)))
307 where in_scope' = in_scope `extendInScopeSet` bndr
308
309 stgCseTopLvl in_scope (StgTopLifted (StgRec eqs))
310 = ( in_scope'
311 , StgTopLifted (StgRec [ (bndr, stgCseTopLvlRhs in_scope' rhs) | (bndr, rhs) <- eqs ]))
312 where in_scope' = in_scope `extendInScopeSetList` [ bndr | (bndr, _) <- eqs ]
313
314 stgCseTopLvlRhs :: InScopeSet -> InStgRhs -> OutStgRhs
315 stgCseTopLvlRhs in_scope (StgRhsClosure ext ccs upd args body)
316 = let body' = stgCseExpr (initEnv in_scope) body
317 in StgRhsClosure ext ccs upd args body'
318 stgCseTopLvlRhs _ (StgRhsCon ccs dataCon mu ticks args)
319 = StgRhsCon ccs dataCon mu ticks args
320
321 ------------------------------
322 -- The actual AST traversal --
323 ------------------------------
324
325 -- Trivial cases
326 stgCseExpr :: CseEnv -> InStgExpr -> OutStgExpr
327 stgCseExpr env (StgApp fun args)
328 = StgApp fun' args'
329 where fun' = substVar env fun
330 args' = substArgs env args
331 stgCseExpr _ (StgLit lit)
332 = StgLit lit
333 stgCseExpr env (StgOpApp op args tys)
334 = StgOpApp op args' tys
335 where args' = substArgs env args
336 stgCseExpr env (StgTick tick body)
337 = let body' = stgCseExpr env body
338 in StgTick tick body'
339 stgCseExpr env (StgCase scrut bndr ty alts)
340 = mkStgCase scrut' bndr' ty alts'
341 where
342 scrut' = stgCseExpr env scrut
343 (env1, bndr') = substBndr env bndr
344 env2 | StgApp trivial_scrut [] <- scrut'
345 = addTrivCaseBndr bndr trivial_scrut env1
346 -- See Note [Trivial case scrutinee]
347 | otherwise
348 = env1
349 alts' = map (stgCseAlt env2 ty bndr') alts
350
351
352 -- A constructor application.
353 -- To be removed by a variable use when found in the CSE environment
354 stgCseExpr env (StgConApp dataCon n args tys)
355 | Just bndr' <- envLookup dataCon args' env
356 = StgApp bndr' []
357 | otherwise
358 = StgConApp dataCon n args' tys
359 where args' = substArgs env args
360
361 -- Let bindings
362 -- The binding might be removed due to CSE (we do not want trivial bindings on
363 -- the STG level), so use the smart constructor `mkStgLet` to remove the binding
364 -- if empty.
365 stgCseExpr env (StgLet ext binds body)
366 = let (binds', env') = stgCseBind env binds
367 body' = stgCseExpr env' body
368 in mkStgLet (StgLet ext) binds' body'
369 stgCseExpr env (StgLetNoEscape ext binds body)
370 = let (binds', env') = stgCseBind env binds
371 body' = stgCseExpr env' body
372 in mkStgLet (StgLetNoEscape ext) binds' body'
373
374 -- Case alternatives
375 -- Extend the CSE environment
376 stgCseAlt :: CseEnv -> AltType -> OutId -> InStgAlt -> OutStgAlt
377 stgCseAlt env ty case_bndr (DataAlt dataCon, args, rhs)
378 = let (env1, args') = substBndrs env args
379 env2
380 -- To avoid dealing with unboxed sums StgCse runs after unarise and
381 -- should maintain invariants listed in Note [Post-unarisation
382 -- invariants]. One of the invariants is that some binders are not
383 -- used (unboxed tuple case binders) which is what we check with
384 -- `stgCaseBndrInScope` here. If the case binder is not in scope we
385 -- don't add it to the CSE env. See also #15300.
386 | stgCaseBndrInScope ty True -- CSE runs after unarise
387 = addDataCon case_bndr dataCon (map StgVarArg args') env1
388 | otherwise
389 = env1
390 -- see note [Case 2: CSEing case binders]
391 rhs' = stgCseExpr env2 rhs
392 in (DataAlt dataCon, args', rhs')
393 stgCseAlt env _ _ (altCon, args, rhs)
394 = let (env1, args') = substBndrs env args
395 rhs' = stgCseExpr env1 rhs
396 in (altCon, args', rhs')
397
398 -- Bindings
399 stgCseBind :: CseEnv -> InStgBinding -> (Maybe OutStgBinding, CseEnv)
400 stgCseBind env (StgNonRec b e)
401 = let (env1, b') = substBndr env b
402 in case stgCseRhs env1 b' e of
403 (Nothing, env2) -> (Nothing, env2)
404 (Just (b2,e'), env2) -> (Just (StgNonRec b2 e'), env2)
405 stgCseBind env (StgRec pairs)
406 = let (env1, pairs1) = substPairs env pairs
407 in case stgCsePairs env1 pairs1 of
408 ([], env2) -> (Nothing, env2)
409 (pairs2, env2) -> (Just (StgRec pairs2), env2)
410
411 stgCsePairs :: CseEnv -> [(OutId, InStgRhs)] -> ([(OutId, OutStgRhs)], CseEnv)
412 stgCsePairs env [] = ([], env)
413 stgCsePairs env0 ((b,e):pairs)
414 = let (pairMB, env1) = stgCseRhs env0 b e
415 (pairs', env2) = stgCsePairs env1 pairs
416 in (pairMB `mbCons` pairs', env2)
417 where
418 mbCons = maybe id (:)
419
420 -- The RHS of a binding.
421 -- If it is a constructor application, either short-cut it or extend the environment
422 stgCseRhs :: CseEnv -> OutId -> InStgRhs -> (Maybe (OutId, OutStgRhs), CseEnv)
423 stgCseRhs env bndr (StgRhsCon ccs dataCon mu ticks args)
424 | Just other_bndr <- envLookup dataCon args' env
425 , not (isWeakLoopBreaker (idOccInfo bndr)) -- See Note [Care with loop breakers]
426 = let env' = addSubst bndr other_bndr env
427 in (Nothing, env')
428 | otherwise
429 = let env' = addDataCon bndr dataCon args' env
430 -- see note [Case 1: CSEing allocated closures]
431 pair = (bndr, StgRhsCon ccs dataCon mu ticks args')
432 in (Just pair, env')
433 where args' = substArgs env args
434
435 stgCseRhs env bndr (StgRhsClosure ext ccs upd args body)
436 = let (env1, args') = substBndrs env args
437 env2 = forgetCse env1 -- See note [Free variables of an StgClosure]
438 body' = stgCseExpr env2 body
439 in (Just (substVar env bndr, StgRhsClosure ext ccs upd args' body'), env)
440
441
442 mkStgCase :: StgExpr -> OutId -> AltType -> [StgAlt] -> StgExpr
443 mkStgCase scrut bndr ty alts | all isBndr alts = scrut
444 | otherwise = StgCase scrut bndr ty alts
445
446 where
447 -- see Note [All alternatives are the binder]
448 isBndr (_, _, StgApp f []) = f == bndr
449 isBndr _ = False
450
451
452 {- Note [Care with loop breakers]
453 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
454 When doing CSE on a letrec we must be careful about loop
455 breakers. Consider
456 rec { y = K z
457 ; z = K z }
458 Now if, somehow (and wrongly)), y and z are both marked as
459 loop-breakers, we do *not* want to drop the (z = K z) binding
460 in favour of a substitution (z :-> y).
461
462 I think this bug will only show up if the loop-breaker-ness is done
463 wrongly (itself a bug), but it still seems better to do the right
464 thing regardless.
465 -}
466
467 -- Utilities
468
469 -- | This function short-cuts let-bindings that are now obsolete
470 mkStgLet :: (a -> b -> b) -> Maybe a -> b -> b
471 mkStgLet _ Nothing body = body
472 mkStgLet stgLet (Just binds) body = stgLet binds body
473
474
475 {-
476 Note [All alternatives are the binder]
477 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
478
479 When all alternatives simply refer to the case binder, then we do not have
480 to bother with the case expression at all (#13588). CoreSTG does this as well,
481 but sometimes, types get into the way:
482
483 newtype T = MkT Int
484 f :: (Int, Int) -> (T, Int)
485 f (x, y) = (MkT x, y)
486
487 Core cannot just turn this into
488
489 f p = p
490
491 as this would not be well-typed. But to STG, where MkT is no longer in the way,
492 we can.
493
494 Note [Trivial case scrutinee]
495 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
496 We want to be able to CSE nested reconstruction of constructors as in
497
498 nested :: Either Int (Either Int a) -> Either Bool (Either Bool a)
499 nested (Right (Right v)) = Right (Right v)
500 nested _ = Left True
501
502 We want the RHS of the first branch to be just the original argument.
503 The RHS of 'nested' will look like
504 case x of r1
505 Right a -> case a of r2
506 Right b -> let v = Right b
507 in Right v
508 Then:
509 * We create the ce_conAppMap [Right a :-> r1, Right b :-> r2].
510 * When we encounter v = Right b, we'll drop the binding and extend
511 the substitution with [v :-> r2]
512 * But now when we see (Right v), we'll substitute to get (Right r2)...and
513 fail to find that in the ce_conAppMap!
514
515 Solution:
516
517 * When passing (case x of bndr { alts }), where 'x' is a variable, we
518 add [bndr :-> x] to the ce_bndrMap. In our example the ce_bndrMap will
519 be [r1 :-> x, r2 :-> a]. This is done in addTrivCaseBndr.
520
521 * Before doing the /lookup/ in ce_conAppMap, we "normalise" the
522 arguments with the ce_bndrMap. In our example, we normalise
523 (Right r2) to (Right a), and then find it in the map. Normalisation
524 is done by normaliseConArgs.
525
526 * Similarly before /inserting/ in ce_conAppMap, we normalise the arguments.
527 This is a bit more subtle. Suppose we have
528 case x of y
529 DEFAULT -> let a = Just y
530 let b = Just y
531 in ...
532 We'll have [y :-> x] in the ce_bndrMap. When looking up (Just y) in
533 the map, we'll normalise it to (Just x). So we'd better normalise
534 the (Just y) in the defn of 'a', before inserting it!
535
536 * When inserting into cs_bndrMap, we must normalise that too!
537 case x of y
538 DEFAULT -> case y of z
539 DEFAULT -> ...
540 We want the cs_bndrMap to be [y :-> x, z :-> x]!
541 Hence the call to normaliseId in addTrivCaseBinder.
542
543 All this is a bit tricky. Why does it not occur for the Core version
544 of CSE? See Note [CSE for bindings] in GHC.Core.Opt.CSE. The reason
545 is this: in Core CSE we augment the /main substitution/ with [y :-> x]
546 etc, so as a side consequence we transform
547 case x of y ===> case x of y
548 pat -> ...y... pat -> ...x...
549 That is, the /exact reverse/ of the binder-swap transformation done by
550 the occurrence analyser. However, it's easy for CSE to do on-the-fly,
551 and it completely solves the above tricky problem, using only two maps:
552 the main reverse-map, and the substitution. The occurrence analyser
553 puts it back the way it should be, the next time it runs.
554
555 However in STG there is no occurrence analyser, and we don't want to
556 require another pass. So the ce_bndrMap is a little swizzle that we
557 apply just when manipulating the ce_conAppMap, but that does not
558 affect the output program.
559
560
561 Note [Free variables of an StgClosure]
562 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
563 StgClosures (function and thunks) have an explicit list of free variables:
564
565 foo [x] =
566 let not_a_free_var = Left [x]
567 let a_free_var = Right [x]
568 let closure = \[x a_free_var] -> \[y] -> bar y (Left [x]) a_free_var
569 in closure
570
571 If we were to CSE `Left [x]` in the body of `closure` with `not_a_free_var`,
572 then the list of free variables would be wrong, so for now, we do not CSE
573 across such a closure, simply because I (Joachim) was not sure about possible
574 knock-on effects. If deemed safe and worth the slight code complication of
575 re-calculating this list during or after this pass, this can surely be done.
576 -}