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