Allow CSE'ing of work-wrapped bindings (#14186)
[ghc.git] / compiler / stranal / WorkWrap.hs
1 {-
2 (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
3
4 \section[WorkWrap]{Worker/wrapper-generating back-end of strictness analyser}
5 -}
6
7 {-# LANGUAGE CPP #-}
8 module WorkWrap ( wwTopBinds ) where
9
10 import CoreSyn
11 import CoreUnfold ( certainlyWillInline, mkWwInlineRule, mkWorkerUnfolding )
12 import CoreUtils ( exprType, exprIsHNF )
13 import CoreFVs ( exprFreeVars )
14 import Var
15 import Id
16 import IdInfo
17 import Type
18 import UniqSupply
19 import BasicTypes
20 import DynFlags
21 import Demand
22 import WwLib
23 import Util
24 import Outputable
25 import FamInstEnv
26 import MonadUtils
27
28 #include "HsVersions.h"
29
30 {-
31 We take Core bindings whose binders have:
32
33 \begin{enumerate}
34
35 \item Strictness attached (by the front-end of the strictness
36 analyser), and / or
37
38 \item Constructed Product Result information attached by the CPR
39 analysis pass.
40
41 \end{enumerate}
42
43 and we return some ``plain'' bindings which have been
44 worker/wrapper-ified, meaning:
45
46 \begin{enumerate}
47
48 \item Functions have been split into workers and wrappers where
49 appropriate. If a function has both strictness and CPR properties
50 then only one worker/wrapper doing both transformations is produced;
51
52 \item Binders' @IdInfos@ have been updated to reflect the existence of
53 these workers/wrappers (this is where we get STRICTNESS and CPR pragma
54 info for exported values).
55 \end{enumerate}
56 -}
57
58 wwTopBinds :: DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram
59
60 wwTopBinds dflags fam_envs us top_binds
61 = initUs_ us $ do
62 top_binds' <- mapM (wwBind dflags fam_envs) top_binds
63 return (concat top_binds')
64
65 {-
66 ************************************************************************
67 * *
68 \subsection[wwBind-wwExpr]{@wwBind@ and @wwExpr@}
69 * *
70 ************************************************************************
71
72 @wwBind@ works on a binding, trying each \tr{(binder, expr)} pair in
73 turn. Non-recursive case first, then recursive...
74 -}
75
76 wwBind :: DynFlags
77 -> FamInstEnvs
78 -> CoreBind
79 -> UniqSM [CoreBind] -- returns a WwBinding intermediate form;
80 -- the caller will convert to Expr/Binding,
81 -- as appropriate.
82
83 wwBind dflags fam_envs (NonRec binder rhs) = do
84 new_rhs <- wwExpr dflags fam_envs rhs
85 new_pairs <- tryWW dflags fam_envs NonRecursive binder new_rhs
86 return [NonRec b e | (b,e) <- new_pairs]
87 -- Generated bindings must be non-recursive
88 -- because the original binding was.
89
90 wwBind dflags fam_envs (Rec pairs)
91 = return . Rec <$> concatMapM do_one pairs
92 where
93 do_one (binder, rhs) = do new_rhs <- wwExpr dflags fam_envs rhs
94 tryWW dflags fam_envs Recursive binder new_rhs
95
96 {-
97 @wwExpr@ basically just walks the tree, looking for appropriate
98 annotations that can be used. Remember it is @wwBind@ that does the
99 matching by looking for strict arguments of the correct type.
100 @wwExpr@ is a version that just returns the ``Plain'' Tree.
101 -}
102
103 wwExpr :: DynFlags -> FamInstEnvs -> CoreExpr -> UniqSM CoreExpr
104
105 wwExpr _ _ e@(Type {}) = return e
106 wwExpr _ _ e@(Coercion {}) = return e
107 wwExpr _ _ e@(Lit {}) = return e
108 wwExpr _ _ e@(Var {}) = return e
109
110 wwExpr dflags fam_envs (Lam binder expr)
111 = Lam new_binder <$> wwExpr dflags fam_envs expr
112 where new_binder | isId binder = zapIdUsedOnceInfo binder
113 | otherwise = binder
114 -- See Note [Zapping Used Once info in WorkWrap]
115
116 wwExpr dflags fam_envs (App f a)
117 = App <$> wwExpr dflags fam_envs f <*> wwExpr dflags fam_envs a
118
119 wwExpr dflags fam_envs (Tick note expr)
120 = Tick note <$> wwExpr dflags fam_envs expr
121
122 wwExpr dflags fam_envs (Cast expr co) = do
123 new_expr <- wwExpr dflags fam_envs expr
124 return (Cast new_expr co)
125
126 wwExpr dflags fam_envs (Let bind expr)
127 = mkLets <$> wwBind dflags fam_envs bind <*> wwExpr dflags fam_envs expr
128
129 wwExpr dflags fam_envs (Case expr binder ty alts) = do
130 new_expr <- wwExpr dflags fam_envs expr
131 new_alts <- mapM ww_alt alts
132 let new_binder = zapIdUsedOnceInfo binder
133 -- See Note [Zapping Used Once info in WorkWrap]
134 return (Case new_expr new_binder ty new_alts)
135 where
136 ww_alt (con, binders, rhs) = do
137 new_rhs <- wwExpr dflags fam_envs rhs
138 let new_binders = [ if isId b then zapIdUsedOnceInfo b else b
139 | b <- binders ]
140 -- See Note [Zapping Used Once info in WorkWrap]
141 return (con, new_binders, new_rhs)
142
143 {-
144 ************************************************************************
145 * *
146 \subsection[tryWW]{@tryWW@: attempt a worker/wrapper pair}
147 * *
148 ************************************************************************
149
150 @tryWW@ just accumulates arguments, converts strictness info from the
151 front-end into the proper form, then calls @mkWwBodies@ to do
152 the business.
153
154 The only reason this is monadised is for the unique supply.
155
156 Note [Don't w/w INLINE things]
157 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
158 It's very important to refrain from w/w-ing an INLINE function (ie one
159 with a stable unfolding) because the wrapper will then overwrite the
160 old stable unfolding with the wrapper code.
161
162 Furthermore, if the programmer has marked something as INLINE,
163 we may lose by w/w'ing it.
164
165 If the strictness analyser is run twice, this test also prevents
166 wrappers (which are INLINEd) from being re-done. (You can end up with
167 several liked-named Ids bouncing around at the same time---absolute
168 mischief.)
169
170 Notice that we refrain from w/w'ing an INLINE function even if it is
171 in a recursive group. It might not be the loop breaker. (We could
172 test for loop-breaker-hood, but I'm not sure that ever matters.)
173
174 Note [Worker-wrapper for INLINABLE functions]
175 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
176 If we have
177 {-# INLINABLE f #-}
178 f :: Ord a => [a] -> Int -> a
179 f x y = ....f....
180
181 where f is strict in y, we might get a more efficient loop by w/w'ing
182 f. But that would make a new unfolding which would overwrite the old
183 one! So the function would no longer be ININABLE, and in particular
184 will not be specialised at call sites in other modules.
185
186 This comes in practice (Trac #6056).
187
188 Solution: do the w/w for strictness analysis, but transfer the Stable
189 unfolding to the *worker*. So we will get something like this:
190
191 {-# INLINE[0] f #-}
192 f :: Ord a => [a] -> Int -> a
193 f d x y = case y of I# y' -> fw d x y'
194
195 {-# INLINABLE[0] fw #-}
196 fw :: Ord a => [a] -> Int# -> a
197 fw d x y' = let y = I# y' in ...f...
198
199 How do we "transfer the unfolding"? Easy: by using the old one, wrapped
200 in work_fn! See CoreUnfold.mkWorkerUnfolding.
201
202 Note [Worker-wrapper for NOINLINE functions]
203 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
204 We used to disable worker/wrapper for NOINLINE things, but it turns out
205 this can cause unnecessary reboxing of values. Consider
206
207 {-# NOINLINE f #-}
208 f :: Int -> a
209 f x = error (show x)
210
211 g :: Bool -> Bool -> Int -> Int
212 g True True p = f p
213 g False True p = p + 1
214 g b False p = g b True p
215
216 the strictness analysis will discover f and g are strict, but because f
217 has no wrapper, the worker for g will rebox p. So we get
218
219 $wg x y p# =
220 let p = I# p# in -- Yikes! Reboxing!
221 case x of
222 False ->
223 case y of
224 False -> $wg False True p#
225 True -> +# p# 1#
226 True ->
227 case y of
228 False -> $wg True True p#
229 True -> case f p of { }
230
231 g x y p = case p of (I# p#) -> $wg x y p#
232
233 Now, in this case the reboxing will float into the True branch, an so
234 the allocation will only happen on the error path. But it won't float
235 inwards if there are multiple branches that call (f p), so the reboxing
236 will happen on every call of g. Disaster.
237
238 Solution: do worker/wrapper even on NOINLINE things; but move the
239 NOINLINE pragma to the worker.
240
241 (See Trac #13143 for a real-world example.)
242
243 Note [Activation for workers]
244 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
245 Follows on from Note [Worker-wrapper for INLINABLE functions]
246
247 It is *vital* that if the worker gets an INLINABLE pragma (from the
248 original function), then the worker has the same phase activation as
249 the wrapper (or later). That is necessary to allow the wrapper to
250 inline into the worker's unfolding: see SimplUtils
251 Note [Simplifying inside stable unfoldings].
252
253 If the original is NOINLINE, it's important that the work inherit the
254 original activation. Consider
255
256 {-# NOINLINE expensive #-}
257 expensive x = x + 1
258
259 f y = let z = expensive y in ...
260
261 If expensive's worker inherits the wrapper's activation, we'll get
262
263 {-# NOINLINE[0] $wexpensive #-}
264 $wexpensive x = x + 1
265 {-# INLINE[0] expensive #-}
266 expensive x = $wexpensive x
267
268 f y = let z = expensive y in ...
269
270 and $wexpensive will be immediately inlined into expensive, followed by
271 expensive into f. This effectively removes the original NOINLINE!
272
273 Otherwise, nothing is lost by giving the worker the same activation as the
274 wrapper, because the worker won't have any chance of inlining until the
275 wrapper does; there's no point in giving it an earlier activation.
276
277 Note [Don't w/w inline small non-loop-breaker things]
278 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
279 In general, we refrain from w/w-ing *small* functions, which are not
280 loop breakers, because they'll inline anyway. But we must take care:
281 it may look small now, but get to be big later after other inlining
282 has happened. So we take the precaution of adding an INLINE pragma to
283 any such functions.
284
285 I made this change when I observed a big function at the end of
286 compilation with a useful strictness signature but no w-w. (It was
287 small during demand analysis, we refrained from w/w, and then got big
288 when something was inlined in its rhs.) When I measured it on nofib,
289 it didn't make much difference; just a few percent improved allocation
290 on one benchmark (bspt/Euclid.space). But nothing got worse.
291
292 There is an infelicity though. We may get something like
293 f = g val
294 ==>
295 g x = case gw x of r -> I# r
296
297 f {- InlineStable, Template = g val -}
298 f = case gw x of r -> I# r
299
300 The code for f duplicates that for g, without any real benefit. It
301 won't really be executed, because calls to f will go via the inlining.
302
303 Note [Don't CPR join points]
304 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
305
306 There's no point in doing CPR on a join point. If the whole function is getting
307 CPR'd, then the case expression around the worker function will get pushed into
308 the join point by the simplifier, which will have the same effect that CPR would
309 have - the result will be returned in an unboxed tuple.
310
311 f z = let join j x y = (x+1, y+1)
312 in case z of A -> j 1 2
313 B -> j 2 3
314
315 =>
316
317 f z = case $wf z of (# a, b #) -> (a, b)
318 $wf z = case (let join j x y = (x+1, y+1)
319 in case z of A -> j 1 2
320 B -> j 2 3) of (a, b) -> (# a, b #)
321
322 =>
323
324 f z = case $wf z of (# a, b #) -> (a, b)
325 $wf z = let join j x y = (# x+1, y+1 #)
326 in case z of A -> j 1 2
327 B -> j 2 3
328
329 Doing CPR on a join point would be tricky anyway, as the worker could not be
330 a join point because it would not be tail-called. However, doing the *argument*
331 part of W/W still works for join points, since the wrapper body will make a tail
332 call:
333
334 f z = let join j x y = x + y
335 in ...
336
337 =>
338
339 f z = let join $wj x# y# = x# +# y#
340 j x y = case x of I# x# ->
341 case y of I# y# ->
342 $wj x# y#
343 in ...
344
345 Note [Wrapper activation]
346 ~~~~~~~~~~~~~~~~~~~~~~~~~
347 When should the wrapper inlining be active? It must not be active
348 earlier than the current Activation of the Id (eg it might have a
349 NOINLINE pragma). But in fact strictness analysis happens fairly
350 late in the pipeline, and we want to prioritise specialisations over
351 strictness. Eg if we have
352 module Foo where
353 f :: Num a => a -> Int -> a
354 f n 0 = n -- Strict in the Int, hence wrapper
355 f n x = f (n+n) (x-1)
356
357 g :: Int -> Int
358 g x = f x x -- Provokes a specialisation for f
359
360 module Bar where
361 import Foo
362
363 h :: Int -> Int
364 h x = f 3 x
365
366 Then we want the specialisation for 'f' to kick in before the wrapper does.
367
368 Now in fact the 'gentle' simplification pass encourages this, by
369 having rules on, but inlinings off. But that's kind of lucky. It seems
370 more robust to give the wrapper an Activation of (ActiveAfter 0),
371 so that it becomes active in an importing module at the same time that
372 it appears in the first place in the defining module.
373
374 At one stage I tried making the wrapper inlining always-active, and
375 that had a very bad effect on nofib/imaginary/x2n1; a wrapper was
376 inlined before the specialisation fired.
377
378 The use an inl_inline of NoUserInline to distinguish this pragma from one
379 that was given by the user. In particular, CSE will not happen if there is a
380 user-specified pragma, but should happen for w/w’ed things (#14186).
381 -}
382
383 tryWW :: DynFlags
384 -> FamInstEnvs
385 -> RecFlag
386 -> Id -- The fn binder
387 -> CoreExpr -- The bound rhs; its innards
388 -- are already ww'd
389 -> UniqSM [(Id, CoreExpr)] -- either *one* or *two* pairs;
390 -- if one, then no worker (only
391 -- the orig "wrapper" lives on);
392 -- if two, then a worker and a
393 -- wrapper.
394 tryWW dflags fam_envs is_rec fn_id rhs
395 -- See Note [Worker-wrapper for NOINLINE functions]
396
397 | Just stable_unf <- certainlyWillInline dflags fn_info
398 = return [ (fn_id `setIdUnfolding` stable_unf, rhs) ]
399 -- See Note [Don't w/w INLINE things]
400 -- See Note [Don't w/w inline small non-loop-breaker things]
401
402 | is_fun
403 = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds res_info rhs
404
405 | is_thunk -- See Note [Thunk splitting]
406 = splitThunk dflags fam_envs is_rec new_fn_id rhs
407
408 | otherwise
409 = return [ (new_fn_id, rhs) ]
410
411 where
412 fn_info = idInfo fn_id
413 (wrap_dmds, res_info) = splitStrictSig (strictnessInfo fn_info)
414
415 new_fn_id = zapIdUsedOnceInfo (zapIdUsageEnvInfo fn_id)
416 -- See Note [Zapping DmdEnv after Demand Analyzer] and
417 -- See Note [Zapping Used Once info in WorkWrap]
418
419 is_fun = notNull wrap_dmds || isJoinId fn_id
420 is_thunk = not is_fun && not (exprIsHNF rhs) && not (isJoinId fn_id)
421 && not (isUnliftedType (idType fn_id))
422
423 {-
424 Note [Zapping DmdEnv after Demand Analyzer]
425 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
426 In the worker-wrapper pass we zap the DmdEnv. Why?
427 (a) it is never used again
428 (b) it wastes space
429 (c) it becomes incorrect as things are cloned, because
430 we don't push the substitution into it
431
432 Why here?
433 * Because we don’t want to do it in the Demand Analyzer, as we never know
434 there when we are doing the last pass.
435 * We want them to be still there at the end of DmdAnal, so that
436 -ddump-str-anal contains them.
437 * We don’t want a second pass just for that.
438 * WorkWrap looks at all bindings anyway.
439
440 We also need to do it in TidyCore.tidyLetBndr to clean up after the
441 final, worker/wrapper-less run of the demand analyser (see
442 Note [Final Demand Analyser run] in DmdAnal).
443
444 Note [Zapping Used Once info in WorkWrap]
445 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
446 In the worker-wrapper pass we zap the used once info in demands and in
447 strictness signatures.
448
449 Why?
450 * The simplifier may happen to transform code in a way that invalidates the
451 data (see #11731 for an example).
452 * It is not used in later passes, up to code generation.
453
454 So as the data is useless and possibly wrong, we want to remove it. The most
455 convenient place to do that is the worker wrapper phase, as it runs after every
456 run of the demand analyser besides the very last one (which is the one where we
457 want to _keep_ the info for the code generator).
458
459 We do not do it in the demand analyser for the same reasons outlined in
460 Note [Zapping DmdEnv after Demand Analyzer] above.
461 -}
462
463
464 ---------------------
465 splitFun :: DynFlags -> FamInstEnvs -> Id -> IdInfo -> [Demand] -> DmdResult -> CoreExpr
466 -> UniqSM [(Id, CoreExpr)]
467 splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs
468 = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) ) do
469 -- The arity should match the signature
470 stuff <- mkWwBodies dflags fam_envs rhs_fvs mb_join_arity fun_ty
471 wrap_dmds use_res_info
472 case stuff of
473 Just (work_demands, join_arity, wrap_fn, work_fn) -> do
474 work_uniq <- getUniqueM
475 let work_rhs = work_fn rhs
476 work_inline = inl_inline inl_prag
477 work_act = case work_inline of
478 -- See Note [Activation for workers]
479 NoInline -> inl_act inl_prag
480 _ -> wrap_act
481 work_prag = InlinePragma { inl_src = SourceText "{-# INLINE"
482 , inl_inline = work_inline
483 , inl_sat = Nothing
484 , inl_act = work_act
485 , inl_rule = FunLike }
486 -- idl_inline: copy from fn_id; see Note [Worker-wrapper for INLINABLE functions]
487 -- idl_act: see Note [Activation for workers]
488 -- inl_rule: it does not make sense for workers to be constructorlike.
489 work_join_arity | isJoinId fn_id = Just join_arity
490 | otherwise = Nothing
491 -- worker is join point iff wrapper is join point
492 -- (see Note [Don't CPR join points])
493 work_id = mkWorkerId work_uniq fn_id (exprType work_rhs)
494 `setIdOccInfo` occInfo fn_info
495 -- Copy over occurrence info from parent
496 -- Notably whether it's a loop breaker
497 -- Doesn't matter much, since we will simplify next, but
498 -- seems right-er to do so
499
500 `setInlinePragma` work_prag
501
502 `setIdUnfolding` mkWorkerUnfolding dflags work_fn (unfoldingInfo fn_info)
503 -- See Note [Worker-wrapper for INLINABLE functions]
504
505 `setIdStrictness` mkClosedStrictSig work_demands work_res_info
506 -- Even though we may not be at top level,
507 -- it's ok to give it an empty DmdEnv
508
509 `setIdDemandInfo` worker_demand
510
511 `setIdArity` work_arity
512 -- Set the arity so that the Core Lint check that the
513 -- arity is consistent with the demand type goes
514 -- through
515 `asJoinId_maybe` work_join_arity
516
517 work_arity = length work_demands
518
519 -- See Note [Demand on the Worker]
520 single_call = saturatedByOneShots arity (demandInfo fn_info)
521 worker_demand | single_call = mkWorkerDemand work_arity
522 | otherwise = topDmd
523
524
525 wrap_act = ActiveAfter NoSourceText 0
526 wrap_rhs = wrap_fn work_id
527 wrap_prag = InlinePragma { inl_src = SourceText "{-# INLINE"
528 , inl_inline = NoUserInline
529 , inl_sat = Nothing
530 , inl_act = wrap_act
531 , inl_rule = rule_match_info }
532 -- See Note [Wrapper activation]
533 -- The RuleMatchInfo is (and must be) unaffected
534
535 wrap_id = fn_id `setIdUnfolding` mkWwInlineRule wrap_rhs arity
536 `setInlinePragma` wrap_prag
537 `setIdOccInfo` noOccInfo
538 -- Zap any loop-breaker-ness, to avoid bleating from Lint
539 -- about a loop breaker with an INLINE rule
540
541
542
543 return $ [(work_id, work_rhs), (wrap_id, wrap_rhs)]
544 -- Worker first, because wrapper mentions it
545
546 Nothing -> return [(fn_id, rhs)]
547 where
548 mb_join_arity = isJoinId_maybe fn_id
549 rhs_fvs = exprFreeVars rhs
550 fun_ty = idType fn_id
551 inl_prag = inlinePragInfo fn_info
552 rule_match_info = inlinePragmaRuleMatchInfo inl_prag
553 arity = arityInfo fn_info
554 -- The arity is set by the simplifier using exprEtaExpandArity
555 -- So it may be more than the number of top-level-visible lambdas
556
557 use_res_info | isJoinId fn_id = topRes -- Note [Don't CPR join points]
558 | otherwise = res_info
559 work_res_info | isJoinId fn_id = res_info -- Worker remains CPR-able
560 | otherwise
561 = case returnsCPR_maybe res_info of
562 Just _ -> topRes -- Cpr stuff done by wrapper; kill it here
563 Nothing -> res_info -- Preserve exception/divergence
564
565
566 {-
567 Note [Demand on the worker]
568 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
569
570 If the original function is called once, according to its demand info, then
571 so is the worker. This is important so that the occurrence analyser can
572 attach OneShot annotations to the worker’s lambda binders.
573
574
575 Example:
576
577 -- Original function
578 f [Demand=<L,1*C1(U)>] :: (a,a) -> a
579 f = \p -> ...
580
581 -- Wrapper
582 f [Demand=<L,1*C1(U)>] :: a -> a -> a
583 f = \p -> case p of (a,b) -> $wf a b
584
585 -- Worker
586 $wf [Demand=<L,1*C1(C1(U))>] :: Int -> Int
587 $wf = \a b -> ...
588
589 We need to check whether the original function is called once, with
590 sufficiently many arguments. This is done using saturatedByOneShots, which
591 takes the arity of the original function (resp. the wrapper) and the demand on
592 the original function.
593
594 The demand on the worker is then calculated using mkWorkerDemand, and always of
595 the form [Demand=<L,1*(C1(...(C1(U))))>]
596
597
598 Note [Do not split void functions]
599 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
600 Consider this rather common form of binding:
601 $j = \x:Void# -> ...no use of x...
602
603 Since x is not used it'll be marked as absent. But there is no point
604 in w/w-ing because we'll simply add (\y:Void#), see WwLib.mkWorerArgs.
605
606 If x has a more interesting type (eg Int, or Int#), there *is* a point
607 in w/w so that we don't pass the argument at all.
608
609 Note [Thunk splitting]
610 ~~~~~~~~~~~~~~~~~~~~~~
611 Suppose x is used strictly (never mind whether it has the CPR
612 property).
613
614 let
615 x* = x-rhs
616 in body
617
618 splitThunk transforms like this:
619
620 let
621 x* = case x-rhs of { I# a -> I# a }
622 in body
623
624 Now simplifier will transform to
625
626 case x-rhs of
627 I# a -> let x* = I# a
628 in body
629
630 which is what we want. Now suppose x-rhs is itself a case:
631
632 x-rhs = case e of { T -> I# a; F -> I# b }
633
634 The join point will abstract over a, rather than over (which is
635 what would have happened before) which is fine.
636
637 Notice that x certainly has the CPR property now!
638
639 In fact, splitThunk uses the function argument w/w splitting
640 function, so that if x's demand is deeper (say U(U(L,L),L))
641 then the splitting will go deeper too.
642 -}
643
644 -- See Note [Thunk splitting]
645 -- splitThunk converts the *non-recursive* binding
646 -- x = e
647 -- into
648 -- x = let x = e
649 -- in case x of
650 -- I# y -> let x = I# y in x }
651 -- See comments above. Is it not beautifully short?
652 -- Moreover, it works just as well when there are
653 -- several binders, and if the binders are lifted
654 -- E.g. x = e
655 -- --> x = let x = e in
656 -- case x of (a,b) -> let x = (a,b) in x
657
658 splitThunk :: DynFlags -> FamInstEnvs -> RecFlag -> Var -> Expr Var -> UniqSM [(Var, Expr Var)]
659 splitThunk dflags fam_envs is_rec fn_id rhs
660 = ASSERT(not (isJoinId fn_id))
661 do { (useful,_, wrap_fn, work_fn) <- mkWWstr dflags fam_envs [fn_id]
662 ; let res = [ (fn_id, Let (NonRec fn_id rhs) (wrap_fn (work_fn (Var fn_id)))) ]
663 ; if useful then ASSERT2( isNonRec is_rec, ppr fn_id ) -- The thunk must be non-recursive
664 return res
665 else return [(fn_id, rhs)] }