Squash some spelling issues
[ghc.git] / compiler / simplCore / OccurAnal.lhs
1
2 %
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5 %************************************************************************
6 %*                                                                      *
7 \section[OccurAnal]{Occurrence analysis pass}
8 %*                                                                      *
9 %************************************************************************
10
11 The occurrence analyser re-typechecks a core expression, returning a new
12 core expression with (hopefully) improved usage information.
13
14 \begin{code}
15 {-# LANGUAGE BangPatterns #-}
16 module OccurAnal (
17         occurAnalysePgm, occurAnalyseExpr, occurAnalyseExpr_NoBinderSwap
18     ) where
19
20 #include "HsVersions.h"
21
22 import CoreSyn
23 import CoreFVs
24 import CoreUtils        ( exprIsTrivial, isDefaultAlt, isExpandableApp )
25 import Id
26 import Name( localiseName )
27 import BasicTypes
28 import Module( Module )
29 import Coercion
30
31 import VarSet
32 import VarEnv
33 import Var
34 import Demand           ( argOneShots, argsOneShots )
35 import Maybes           ( orElse )
36 import Digraph          ( SCC(..), stronglyConnCompFromEdgedVerticesR )
37 import Unique
38 import UniqFM
39 import Util
40 import Outputable
41 import FastString
42 import Data.List
43 \end{code}
44
45
46 %************************************************************************
47 %*                                                                      *
48 \subsection[OccurAnal-main]{Counting occurrences: main function}
49 %*                                                                      *
50 %************************************************************************
51
52 Here's the externally-callable interface:
53
54 \begin{code}
55 occurAnalysePgm :: Module       -- Used only in debug output
56                 -> (Activation -> Bool) 
57                 -> [CoreRule] -> [CoreVect] -> VarSet
58                 -> CoreProgram -> CoreProgram
59 occurAnalysePgm this_mod active_rule imp_rules vects vectVars binds
60   | isEmptyVarEnv final_usage
61   = binds'
62   | otherwise   -- See Note [Glomming]
63   = WARN( True, hang (text "Glomming in" <+> ppr this_mod <> colon)
64                    2 (ppr final_usage ) )
65     [Rec (flattenBinds binds')]
66   where
67     (final_usage, binds') = go (initOccEnv active_rule) binds
68
69     initial_uds = addIdOccs emptyDetails 
70                             (rulesFreeVars imp_rules `unionVarSet` 
71                              vectsFreeVars vects `unionVarSet`
72                              vectVars)
73     -- The RULES and VECTORISE declarations keep things alive! (For VECTORISE declarations,
74     -- we only get them *until* the vectoriser runs. Afterwards, these dependencies are
75     -- reflected in 'vectors' — see Note [Vectorisation declarations and occurrences].)
76
77     -- Note [Preventing loops due to imported functions rules]
78     imp_rules_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv
79                             [ mapVarEnv (const maps_to) (exprFreeIds arg `delVarSetList` ru_bndrs imp_rule)
80                             | imp_rule <- imp_rules
81                             , let maps_to = exprFreeIds (ru_rhs imp_rule)
82                                              `delVarSetList` ru_bndrs imp_rule
83                             , arg <- ru_args imp_rule ]
84
85     go :: OccEnv -> [CoreBind] -> (UsageDetails, [CoreBind])
86     go _ []
87         = (initial_uds, [])
88     go env (bind:binds)
89         = (final_usage, bind' ++ binds')
90         where
91            (bs_usage, binds')   = go env binds
92            (final_usage, bind') = occAnalBind env env imp_rules_edges bind bs_usage
93
94 occurAnalyseExpr :: CoreExpr -> CoreExpr
95         -- Do occurrence analysis, and discard occurrence info returned
96 occurAnalyseExpr = occurAnalyseExpr' True -- do binder swap
97
98 occurAnalyseExpr_NoBinderSwap :: CoreExpr -> CoreExpr
99 occurAnalyseExpr_NoBinderSwap = occurAnalyseExpr' False -- do not do binder swap
100
101 occurAnalyseExpr' :: Bool -> CoreExpr -> CoreExpr
102 occurAnalyseExpr' enable_binder_swap expr
103   = snd (occAnal env expr)
104   where
105     env = (initOccEnv all_active_rules) {occ_binder_swap = enable_binder_swap}
106     -- To be conservative, we say that all inlines and rules are active
107     all_active_rules = \_ -> True
108 \end{code}
109
110
111 %************************************************************************
112 %*                                                                      *
113 \subsection[OccurAnal-main]{Counting occurrences: main function}
114 %*                                                                      *
115 %************************************************************************
116
117 Bindings
118 ~~~~~~~~
119
120 \begin{code}
121 occAnalBind :: OccEnv           -- The incoming OccEnv
122             -> OccEnv           -- Same, but trimmed by (binderOf bind)
123             -> IdEnv IdSet      -- Mapping from FVs of imported RULE LHSs to RHS FVs
124             -> CoreBind
125             -> UsageDetails             -- Usage details of scope
126             -> (UsageDetails,           -- Of the whole let(rec)
127                 [CoreBind])
128
129 occAnalBind env _ imp_rules_edges (NonRec binder rhs) body_usage
130   | isTyVar binder      -- A type let; we don't gather usage info
131   = (body_usage, [NonRec binder rhs])
132
133   | not (binder `usedIn` body_usage)    -- It's not mentioned
134   = (body_usage, [])
135
136   | otherwise                   -- It's mentioned in the body
137   = (body_usage' +++ rhs_usage4, [NonRec tagged_binder rhs'])
138   where
139     (body_usage', tagged_binder) = tagBinder body_usage binder
140     (rhs_usage1, rhs')           = occAnalNonRecRhs env tagged_binder rhs
141     rhs_usage2 = addIdOccs rhs_usage1 (idUnfoldingVars binder)
142     rhs_usage3 = addIdOccs rhs_usage2 (idRuleVars binder)
143        -- See Note [Rules are extra RHSs] and Note [Rule dependency info]
144     rhs_usage4 = maybe rhs_usage3 (addIdOccs rhs_usage3) $ lookupVarEnv imp_rules_edges binder
145        -- See Note [Preventing loops due to imported functions rules]
146
147 occAnalBind _ env imp_rules_edges (Rec pairs) body_usage
148   = foldr occAnalRec (body_usage, []) sccs
149         -- For a recursive group, we
150         --      * occ-analyse all the RHSs
151         --      * compute strongly-connected components
152         --      * feed those components to occAnalRec
153   where
154     bndr_set = mkVarSet (map fst pairs)
155
156     sccs :: [SCC (Node Details)]
157     sccs = {-# SCC "occAnalBind.scc" #-} stronglyConnCompFromEdgedVerticesR nodes
158
159     nodes :: [Node Details]
160     nodes = {-# SCC "occAnalBind.assoc" #-} map (makeNode env imp_rules_edges bndr_set) pairs
161 \end{code}
162
163 Note [Dead code]
164 ~~~~~~~~~~~~~~~~
165 Dropping dead code for a cyclic Strongly Connected Component is done
166 in a very simple way:
167
168         the entire SCC is dropped if none of its binders are mentioned
169         in the body; otherwise the whole thing is kept.
170
171 The key observation is that dead code elimination happens after
172 dependency analysis: so 'occAnalBind' processes SCCs instead of the
173 original term's binding groups.
174
175 Thus 'occAnalBind' does indeed drop 'f' in an example like
176
177         letrec f = ...g...
178                g = ...(...g...)...
179         in
180            ...g...
181
182 when 'g' no longer uses 'f' at all (eg 'f' does not occur in a RULE in
183 'g'). 'occAnalBind' first consumes 'CyclicSCC g' and then it consumes
184 'AcyclicSCC f', where 'body_usage' won't contain 'f'.
185
186 ------------------------------------------------------------
187 Note [Forming Rec groups]
188 ~~~~~~~~~~~~~~~~~~~~~~~~~
189 We put bindings {f = ef; g = eg } in a Rec group if "f uses g"
190 and "g uses f", no matter how indirectly.  We do a SCC analysis
191 with an edge f -> g if "f uses g".
192
193 More precisely, "f uses g" iff g should be in scope wherever f is.
194 That is, g is free in:
195   a) the rhs 'ef'
196   b) or the RHS of a rule for f (Note [Rules are extra RHSs])
197   c) or the LHS or a rule for f (Note [Rule dependency info])
198
199 These conditions apply regardless of the activation of the RULE (eg it might be
200 inactive in this phase but become active later).  Once a Rec is broken up
201 it can never be put back together, so we must be conservative.
202
203 The principle is that, regardless of rule firings, every variable is
204 always in scope.
205
206   * Note [Rules are extra RHSs]
207     ~~~~~~~~~~~~~~~~~~~~~~~~~~~
208     A RULE for 'f' is like an extra RHS for 'f'. That way the "parent"
209     keeps the specialised "children" alive.  If the parent dies
210     (because it isn't referenced any more), then the children will die
211     too (unless they are already referenced directly).
212
213     To that end, we build a Rec group for each cyclic strongly
214     connected component,
215         *treating f's rules as extra RHSs for 'f'*.
216     More concretely, the SCC analysis runs on a graph with an edge
217     from f -> g iff g is mentioned in
218         (a) f's rhs
219         (b) f's RULES
220     These are rec_edges.
221
222     Under (b) we include variables free in *either* LHS *or* RHS of
223     the rule.  The former might seems silly, but see Note [Rule
224     dependency info].  So in Example [eftInt], eftInt and eftIntFB
225     will be put in the same Rec, even though their 'main' RHSs are
226     both non-recursive.
227
228   * Note [Rule dependency info]
229     ~~~~~~~~~~~~~~~~~~~~~~~~~~~
230     The VarSet in a SpecInfo is used for dependency analysis in the
231     occurrence analyser.  We must track free vars in *both* lhs and rhs.
232     Hence use of idRuleVars, rather than idRuleRhsVars in occAnalBind.
233     Why both? Consider
234         x = y
235         RULE f x = v+4
236     Then if we substitute y for x, we'd better do so in the
237     rule's LHS too, so we'd better ensure the RULE appears to mention 'x'
238     as well as 'v'
239
240   * Note [Rules are visible in their own rec group]
241     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
242     We want the rules for 'f' to be visible in f's right-hand side.
243     And we'd like them to be visible in other functions in f's Rec
244     group.  E.g. in Note [Specialisation rules] we want f' rule
245     to be visible in both f's RHS, and fs's RHS.
246
247     This means that we must simplify the RULEs first, before looking
248     at any of the definitions.  This is done by Simplify.simplRecBind,
249     when it calls addLetIdInfo.
250
251 ------------------------------------------------------------
252 Note [Choosing loop breakers]
253 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
254 Loop breaking is surprisingly subtle.  First read the section 4 of
255 "Secrets of the GHC inliner".  This describes our basic plan.
256 We avoid infinite inlinings by choosing loop breakers, and
257 ensuring that a loop breaker cuts each loop.
258
259 Fundamentally, we do SCC analysis on a graph.  For each recursive
260 group we choose a loop breaker, delete all edges to that node,
261 re-analyse the SCC, and iterate.
262
263 But what is the graph?  NOT the same graph as was used for Note
264 [Forming Rec groups]!  In particular, a RULE is like an equation for
265 'f' that is *always* inlined if it is applicable.  We do *not* disable
266 rules for loop-breakers.  It's up to whoever makes the rules to make
267 sure that the rules themselves always terminate.  See Note [Rules for
268 recursive functions] in Simplify.lhs
269
270 Hence, if
271     f's RHS (or its INLINE template if it has one) mentions g, and
272     g has a RULE that mentions h, and
273     h has a RULE that mentions f
274
275 then we *must* choose f to be a loop breaker.  Example: see Note
276 [Specialisation rules].
277
278 In general, take the free variables of f's RHS, and augment it with
279 all the variables reachable by RULES from those starting points.  That
280 is the whole reason for computing rule_fv_env in occAnalBind.  (Of
281 course we only consider free vars that are also binders in this Rec
282 group.)  See also Note [Finding rule RHS free vars]
283
284 Note that when we compute this rule_fv_env, we only consider variables
285 free in the *RHS* of the rule, in contrast to the way we build the
286 Rec group in the first place (Note [Rule dependency info])
287
288 Note that if 'g' has RHS that mentions 'w', we should add w to
289 g's loop-breaker edges.  More concretely there is an edge from f -> g
290 iff
291         (a) g is mentioned in f's RHS `xor` f's INLINE rhs
292             (see Note [Inline rules])
293         (b) or h is mentioned in f's RHS, and
294             g appears in the RHS of an active RULE of h
295             or a transitive sequence of active rules starting with h
296
297 Why "active rules"?  See Note [Finding rule RHS free vars]
298
299 Note that in Example [eftInt], *neither* eftInt *nor* eftIntFB is
300 chosen as a loop breaker, because their RHSs don't mention each other.
301 And indeed both can be inlined safely.
302
303 Note again that the edges of the graph we use for computing loop breakers
304 are not the same as the edges we use for computing the Rec blocks.
305 That's why we compute
306
307 - rec_edges          for the Rec block analysis
308 - loop_breaker_edges for the loop breaker analysis
309
310   * Note [Finding rule RHS free vars]
311     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
312     Consider this real example from Data Parallel Haskell
313          tagZero :: Array Int -> Array Tag
314          {-# INLINE [1] tagZeroes #-}
315          tagZero xs = pmap (\x -> fromBool (x==0)) xs
316
317          {-# RULES "tagZero" [~1] forall xs n.
318              pmap fromBool <blah blah> = tagZero xs #-}
319     So tagZero's RHS mentions pmap, and pmap's RULE mentions tagZero.
320     However, tagZero can only be inlined in phase 1 and later, while
321     the RULE is only active *before* phase 1.  So there's no problem.
322
323     To make this work, we look for the RHS free vars only for
324     *active* rules. That's the reason for the occ_rule_act field
325     of the OccEnv.
326
327   * Note [Weak loop breakers]
328     ~~~~~~~~~~~~~~~~~~~~~~~~~
329     There is a last nasty wrinkle.  Suppose we have
330
331         Rec { f = f_rhs
332               RULE f [] = g
333
334               h = h_rhs
335               g = h
336               ...more...
337         }
338
339     Remember that we simplify the RULES before any RHS (see Note
340     [Rules are visible in their own rec group] above).
341
342     So we must *not* postInlineUnconditionally 'g', even though
343     its RHS turns out to be trivial.  (I'm assuming that 'g' is
344     not choosen as a loop breaker.)  Why not?  Because then we
345     drop the binding for 'g', which leaves it out of scope in the
346     RULE!
347
348     Here's a somewhat different example of the same thing
349         Rec { g = h
350             ; h = ...f...
351             ; f = f_rhs
352               RULE f [] = g }
353     Here the RULE is "below" g, but we *still* can't postInlineUnconditionally
354     g, because the RULE for f is active throughout.  So the RHS of h
355     might rewrite to     h = ...g...
356     So g must remain in scope in the output program!
357
358     We "solve" this by:
359
360         Make g a "weak" loop breaker (OccInfo = IAmLoopBreaker True)
361         iff g is a "missing free variable" of the Rec group
362
363     A "missing free variable" x is one that is mentioned in an RHS or
364     INLINE or RULE of a binding in the Rec group, but where the
365     dependency on x may not show up in the loop_breaker_edges (see
366     note [Choosing loop breakers} above).
367
368     A normal "strong" loop breaker has IAmLoopBreaker False.  So
369
370                                 Inline  postInlineUnconditionally
371         IAmLoopBreaker False    no      no
372         IAmLoopBreaker True     yes     no
373         other                   yes     yes
374
375     The **sole** reason for this kind of loop breaker is so that
376     postInlineUnconditionally does not fire.  Ugh.  (Typically it'll
377     inline via the usual callSiteInline stuff, so it'll be dead in the
378     next pass, so the main Ugh is the tiresome complication.)
379
380 Note [Rules for imported functions]
381 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
382 Consider this
383    f = /\a. B.g a
384    RULE B.g Int = 1 + f Int
385 Note that
386   * The RULE is for an imported function.
387   * f is non-recursive
388 Now we
389 can get
390    f Int --> B.g Int      Inlining f
391          --> 1 + f Int    Firing RULE
392 and so the simplifier goes into an infinite loop. This
393 would not happen if the RULE was for a local function,
394 because we keep track of dependencies through rules.  But
395 that is pretty much impossible to do for imported Ids.  Suppose
396 f's definition had been
397    f = /\a. C.h a
398 where (by some long and devious process), C.h eventually inlines to
399 B.g.  We could only spot such loops by exhaustively following
400 unfoldings of C.h etc, in case we reach B.g, and hence (via the RULE)
401 f.
402
403 Note that RULES for imported functions are important in practice; they
404 occur a lot in the libraries.
405
406 We regard this potential infinite loop as a *programmer* error.
407 It's up the programmer not to write silly rules like
408      RULE f x = f x
409 and the example above is just a more complicated version.
410
411 Note [Preventing loops due to imported functions rules]
412 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
413 Consider:
414   import GHC.Base (foldr)
415
416   {-# RULES "filterList" forall p. foldr (filterFB (:) p) [] = filter p #-}
417   filter p xs = build (\c n -> foldr (filterFB c p) n xs)
418   filterFB c p = ...
419
420   f = filter p xs
421
422 Note that filter is not a loop-breaker, so what happens is:
423   f =          filter p xs
424     = {inline} build (\c n -> foldr (filterFB c p) n xs)
425     = {inline} foldr (filterFB (:) p) [] xs
426     = {RULE}   filter p xs
427
428 We are in an infinite loop.
429
430 A more elaborate example (that I actually saw in practice when I went to
431 mark GHC.List.filter as INLINABLE) is as follows. Say I have this module:
432   {-# LANGUAGE RankNTypes #-}
433   module GHCList where
434
435   import Prelude hiding (filter)
436   import GHC.Base (build)
437
438   {-# INLINABLE filter #-}
439   filter :: (a -> Bool) -> [a] -> [a]
440   filter p [] = []
441   filter p (x:xs) = if p x then x : filter p xs else filter p xs
442
443   {-# NOINLINE [0] filterFB #-}
444   filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b
445   filterFB c p x r | p x       = x `c` r
446                    | otherwise = r
447
448   {-# RULES
449   "filter"     [~1] forall p xs.  filter p xs = build (\c n -> foldr
450   (filterFB c p) n xs)
451   "filterList" [1]  forall p.     foldr (filterFB (:) p) [] = filter p
452    #-}
453
454 Then (because RULES are applied inside INLINABLE unfoldings, but inlinings
455 are not), the unfolding given to "filter" in the interface file will be:
456   filter p []     = []
457   filter p (x:xs) = if p x then x : build (\c n -> foldr (filterFB c p) n xs)
458                            else     build (\c n -> foldr (filterFB c p) n xs
459
460 Note that because this unfolding does not mention "filter", filter is not
461 marked as a strong loop breaker. Therefore at a use site in another module:
462   filter p xs
463     = {inline}
464       case xs of []     -> []
465                  (x:xs) -> if p x then x : build (\c n -> foldr (filterFB c p) n xs)
466                                   else     build (\c n -> foldr (filterFB c p) n xs)
467
468   build (\c n -> foldr (filterFB c p) n xs)
469     = {inline} foldr (filterFB (:) p) [] xs
470     = {RULE}   filter p xs
471
472 And we are in an infinite loop again, except that this time the loop is producing an
473 infinitely large *term* (an unrolling of filter) and so the simplifier finally
474 dies with "ticks exhausted"
475
476 Because of this problem, we make a small change in the occurrence analyser
477 designed to mark functions like "filter" as strong loop breakers on the basis that:
478   1. The RHS of filter mentions the local function "filterFB"
479   2. We have a rule which mentions "filterFB" on the LHS and "filter" on the RHS
480
481 So for each RULE for an *imported* function we are going to add
482 dependency edges between the *local* FVS of the rule LHS and the
483 *local* FVS of the rule RHS. We don't do anything special for RULES on
484 local functions because the standard occurrence analysis stuff is
485 pretty good at getting loop-breakerness correct there.
486
487 It is important to note that even with this extra hack we aren't always going to get
488 things right. For example, it might be that the rule LHS mentions an imported Id,
489 and another module has a RULE that can rewrite that imported Id to one of our local
490 Ids.
491
492 Note [Specialising imported functions]
493 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
494 BUT for *automatically-generated* rules, the programmer can't be
495 responsible for the "programmer error" in Note [Rules for imported
496 functions].  In paricular, consider specialising a recursive function
497 defined in another module.  If we specialise a recursive function B.g,
498 we get
499          g_spec = .....(B.g Int).....
500          RULE B.g Int = g_spec
501 Here, g_spec doesn't look recursive, but when the rule fires, it
502 becomes so.  And if B.g was mutually recursive, the loop might
503 not be as obvious as it is here.
504
505 To avoid this,
506  * When specialising a function that is a loop breaker,
507    give a NOINLINE pragma to the specialised function
508
509 Note [Glomming]
510 ~~~~~~~~~~~~~~~
511 RULES for imported Ids can make something at the top refer to something at the bottom:
512         f = \x -> B.g (q x)
513         h = \y -> 3
514
515         RULE:  B.g (q x) = h x
516
517 Applying this rule makes f refer to h, although f doesn't appear to
518 depend on h.  (And, as in Note [Rules for imported functions], the
519 dependency might be more indirect. For example, f might mention C.t
520 rather than B.g, where C.t eventually inlines to B.g.)
521
522 NOTICE that this cannot happen for rules whose head is a
523 locally-defined function, because we accurately track dependencies
524 through RULES.  It only happens for rules whose head is an imported
525 function (B.g in the example above).
526
527 Solution:
528   - When simplifying, bring all top level identifiers into
529     scope at the start, ignoring the Rec/NonRec structure, so
530     that when 'h' pops up in f's rhs, we find it in the in-scope set
531     (as the simplifier generally expects). This happens in simplTopBinds.
532
533   - In the occurrence analyser, if there are any out-of-scope
534     occurrences that pop out of the top, which will happen after
535     firing the rule:      f = \x -> h x
536                           h = \y -> 3
537     then just glom all the bindings into a single Rec, so that
538     the *next* iteration of the occurrence analyser will sort
539     them all out.   This part happens in occurAnalysePgm.
540
541 ------------------------------------------------------------
542 Note [Inline rules]
543 ~~~~~~~~~~~~~~~~~~~
544 None of the above stuff about RULES applies to Inline Rules,
545 stored in a CoreUnfolding.  The unfolding, if any, is simplified
546 at the same time as the regular RHS of the function (ie *not* like
547 Note [Rules are visible in their own rec group]), so it should be
548 treated *exactly* like an extra RHS.
549
550 Or, rather, when computing loop-breaker edges,
551   * If f has an INLINE pragma, and it is active, we treat the
552     INLINE rhs as f's rhs
553   * If it's inactive, we treat f as having no rhs
554   * If it has no INLINE pragma, we look at f's actual rhs
555
556
557 There is a danger that we'll be sub-optimal if we see this
558      f = ...f...
559      [INLINE f = ..no f...]
560 where f is recursive, but the INLINE is not. This can just about
561 happen with a sufficiently odd set of rules; eg
562
563         foo :: Int -> Int
564         {-# INLINE [1] foo #-}
565         foo x = x+1
566
567         bar :: Int -> Int
568         {-# INLINE [1] bar #-}
569         bar x = foo x + 1
570
571         {-# RULES "foo" [~1] forall x. foo x = bar x #-}
572
573 Here the RULE makes bar recursive; but it's INLINE pragma remains
574 non-recursive. It's tempting to then say that 'bar' should not be
575 a loop breaker, but an attempt to do so goes wrong in two ways:
576    a) We may get
577          $df = ...$cfoo...
578          $cfoo = ...$df....
579          [INLINE $cfoo = ...no-$df...]
580       But we want $cfoo to depend on $df explicitly so that we
581       put the bindings in the right order to inline $df in $cfoo
582       and perhaps break the loop altogether.  (Maybe this
583    b)
584
585
586 Example [eftInt]
587 ~~~~~~~~~~~~~~~
588 Example (from GHC.Enum):
589
590   eftInt :: Int# -> Int# -> [Int]
591   eftInt x y = ...(non-recursive)...
592
593   {-# INLINE [0] eftIntFB #-}
594   eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r
595   eftIntFB c n x y = ...(non-recursive)...
596
597   {-# RULES
598   "eftInt"  [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
599   "eftIntList"  [1] eftIntFB  (:) [] = eftInt
600    #-}
601
602 Note [Specialisation rules]
603 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
604 Consider this group, which is typical of what SpecConstr builds:
605
606    fs a = ....f (C a)....
607    f  x = ....f (C a)....
608    {-# RULE f (C a) = fs a #-}
609
610 So 'f' and 'fs' are in the same Rec group (since f refers to fs via its RULE).
611
612 But watch out!  If 'fs' is not chosen as a loop breaker, we may get an infinite loop:
613   - the RULE is applied in f's RHS (see Note [Self-recursive rules] in Simplify
614   - fs is inlined (say it's small)
615   - now there's another opportunity to apply the RULE
616
617 This showed up when compiling Control.Concurrent.Chan.getChanContents.
618
619
620 \begin{code}
621 type Node details = (details, Unique, [Unique]) -- The Ints are gotten from the Unique,
622                                                 -- which is gotten from the Id.
623 data Details
624   = ND { nd_bndr :: Id          -- Binder
625        , nd_rhs  :: CoreExpr    -- RHS, already occ-analysed
626
627        , nd_uds  :: UsageDetails  -- Usage from RHS, and RULES, and InlineRule unfolding
628                                   -- ignoring phase (ie assuming all are active)
629                                   -- See Note [Forming Rec groups]
630
631        , nd_inl  :: IdSet       -- Free variables of
632                                 --   the InlineRule (if present and active)
633                                 --   or the RHS (ir no InlineRule)
634                                 -- but excluding any RULES
635                                 -- This is the IdSet that may be used if the Id is inlined
636
637        , nd_weak :: IdSet       -- Binders of this Rec that are mentioned in nd_uds
638                                 -- but are *not* in nd_inl.  These are the ones whose
639                                 -- dependencies might not be respected by loop_breaker_edges
640                                 -- See Note [Weak loop breakers]
641
642        , nd_active_rule_fvs :: IdSet   -- Free variables of the RHS of active RULES
643   }
644
645 instance Outputable Details where
646    ppr nd = ptext (sLit "ND") <> braces
647              (sep [ ptext (sLit "bndr =") <+> ppr (nd_bndr nd)
648                   , ptext (sLit "uds =") <+> ppr (nd_uds nd)
649                   , ptext (sLit "inl =") <+> ppr (nd_inl nd)
650                   , ptext (sLit "weak =") <+> ppr (nd_weak nd)
651                   , ptext (sLit "rule =") <+> ppr (nd_active_rule_fvs nd)
652              ])
653
654 makeNode :: OccEnv -> IdEnv IdSet -> VarSet -> (Var, CoreExpr) -> Node Details
655 makeNode env imp_rules_edges bndr_set (bndr, rhs)
656   = (details, varUnique bndr, keysUFM node_fvs)
657   where
658     details = ND { nd_bndr = bndr
659                  , nd_rhs  = rhs'
660                  , nd_uds  = rhs_usage3
661                  , nd_weak = node_fvs `minusVarSet` inl_fvs
662                  , nd_inl  = inl_fvs
663                  , nd_active_rule_fvs = active_rule_fvs }
664
665     -- Constructing the edges for the main Rec computation
666     -- See Note [Forming Rec groups]
667     (rhs_usage1, rhs') = occAnalRecRhs env rhs
668     rhs_usage2 = addIdOccs rhs_usage1 all_rule_fvs   -- Note [Rules are extra RHSs]
669                                                      -- Note [Rule dependency info]
670     rhs_usage3 = case mb_unf_fvs of
671                    Just unf_fvs -> addIdOccs rhs_usage2 unf_fvs
672                    Nothing      -> rhs_usage2
673     node_fvs = udFreeVars bndr_set rhs_usage3
674
675     -- Finding the free variables of the rules
676     is_active = occ_rule_act env :: Activation -> Bool
677     rules = filterOut isBuiltinRule (idCoreRules bndr)
678     rules_w_fvs :: [(Activation, VarSet)]    -- Find the RHS fvs
679     rules_w_fvs = maybe id (\ids -> ((AlwaysActive, ids):)) (lookupVarEnv imp_rules_edges bndr)
680                    -- See Note [Preventing loops due to imported functions rules]
681                   [ (ru_act rule, fvs)
682                   | rule <- rules
683                   , let fvs = exprFreeVars (ru_rhs rule)
684                               `delVarSetList` ru_bndrs rule
685                   , not (isEmptyVarSet fvs) ]
686     all_rule_fvs = foldr (unionVarSet . snd) rule_lhs_fvs rules_w_fvs
687     rule_lhs_fvs = foldr (unionVarSet . (\ru -> exprsFreeVars (ru_args ru)
688                                                 `delVarSetList` ru_bndrs ru))
689                          emptyVarSet rules
690     active_rule_fvs = unionVarSets [fvs | (a,fvs) <- rules_w_fvs, is_active a]
691
692     -- Finding the free variables of the INLINE pragma (if any)
693     unf        = realIdUnfolding bndr     -- Ignore any current loop-breaker flag
694     mb_unf_fvs = stableUnfoldingVars unf
695
696     -- Find the "nd_inl" free vars; for the loop-breaker phase
697     inl_fvs = case mb_unf_fvs of
698                 Nothing -> udFreeVars bndr_set rhs_usage1 -- No INLINE, use RHS
699                 Just unf_fvs -> unf_fvs
700                       -- We could check for an *active* INLINE (returning
701                       -- emptyVarSet for an inactive one), but is_active
702                       -- isn't the right thing (it tells about
703                       -- RULE activation), so we'd need more plumbing
704
705 -----------------------------
706 occAnalRec :: SCC (Node Details)
707            -> (UsageDetails, [CoreBind])
708            -> (UsageDetails, [CoreBind])
709
710         -- The NonRec case is just like a Let (NonRec ...) above
711 occAnalRec (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = rhs, nd_uds = rhs_uds}, _, _))
712            (body_uds, binds)
713   | not (bndr `usedIn` body_uds)
714   = (body_uds, binds)           -- See Note [Dead code]
715
716   | otherwise                   -- It's mentioned in the body
717   = (body_uds' +++ rhs_uds,
718      NonRec tagged_bndr rhs : binds)
719   where
720     (body_uds', tagged_bndr) = tagBinder body_uds bndr
721
722         -- The Rec case is the interesting one
723         -- See Note [Loop breaking]
724 occAnalRec (CyclicSCC nodes) (body_uds, binds)
725   | not (any (`usedIn` body_uds) bndrs) -- NB: look at body_uds, not total_uds
726   = (body_uds, binds)                   -- See Note [Dead code]
727
728   | otherwise   -- At this point we always build a single Rec
729   = -- pprTrace "occAnalRec" (vcat
730     --   [ text "tagged nodes" <+> ppr tagged_nodes
731     --   , text "lb edges" <+> ppr loop_breaker_edges])
732     (final_uds, Rec pairs : binds)
733
734   where
735     bndrs    = [b | (ND { nd_bndr = b }, _, _) <- nodes]
736     bndr_set = mkVarSet bndrs
737
738         ----------------------------
739         -- Tag the binders with their occurrence info
740     tagged_nodes = map tag_node nodes
741     total_uds = foldl add_uds body_uds nodes
742     final_uds = total_uds `minusVarEnv` bndr_set
743     add_uds usage_so_far (nd, _, _) = usage_so_far +++ nd_uds nd
744
745     tag_node :: Node Details -> Node Details
746     tag_node (details@ND { nd_bndr = bndr }, k, ks)
747       = (details { nd_bndr = setBinderOcc total_uds bndr }, k, ks)
748
749     ---------------------------
750     -- Now reconstruct the cycle
751     pairs :: [(Id,CoreExpr)]
752     pairs | isEmptyVarSet weak_fvs = reOrderNodes   0 bndr_set weak_fvs tagged_nodes       []
753           | otherwise              = loopBreakNodes 0 bndr_set weak_fvs loop_breaker_edges []
754           -- If weak_fvs is empty, the loop_breaker_edges will include all
755           -- the edges in tagged_nodes, so there isn't any point in doing
756           -- a fresh SCC computation that will yield a single CyclicSCC result.
757
758     weak_fvs :: VarSet
759     weak_fvs = foldr (unionVarSet . nd_weak . fstOf3) emptyVarSet nodes
760
761         -- See Note [Choosing loop breakers] for loop_breaker_edges
762     loop_breaker_edges = map mk_node tagged_nodes
763     mk_node (details@(ND { nd_inl = inl_fvs }), k, _)
764       = (details, k, keysUFM (extendFvs_ rule_fv_env inl_fvs))
765
766     ------------------------------------
767     rule_fv_env :: IdEnv IdSet
768         -- Maps a variable f to the variables from this group
769         --      mentioned in RHS of active rules for f
770         -- Domain is *subset* of bound vars (others have no rule fvs)
771     rule_fv_env = transClosureFV (mkVarEnv init_rule_fvs)
772     init_rule_fvs   -- See Note [Finding rule RHS free vars]
773       = [ (b, trimmed_rule_fvs)
774         | (ND { nd_bndr = b, nd_active_rule_fvs = rule_fvs },_,_) <- nodes
775         , let trimmed_rule_fvs = rule_fvs `intersectVarSet` bndr_set
776         , not (isEmptyVarSet trimmed_rule_fvs)]
777 \end{code}
778
779 @loopBreakSCC@ is applied to the list of (binder,rhs) pairs for a cyclic
780 strongly connected component (there's guaranteed to be a cycle).  It returns the
781 same pairs, but
782         a) in a better order,
783         b) with some of the Ids having a IAmALoopBreaker pragma
784
785 The "loop-breaker" Ids are sufficient to break all cycles in the SCC.  This means
786 that the simplifier can guarantee not to loop provided it never records an inlining
787 for these no-inline guys.
788
789 Furthermore, the order of the binds is such that if we neglect dependencies
790 on the no-inline Ids then the binds are topologically sorted.  This means
791 that the simplifier will generally do a good job if it works from top bottom,
792 recording inlinings for any Ids which aren't marked as "no-inline" as it goes.
793
794 \begin{code}
795 type Binding = (Id,CoreExpr)
796
797 mk_loop_breaker :: Node Details -> Binding
798 mk_loop_breaker (ND { nd_bndr = bndr, nd_rhs = rhs}, _, _)
799   = (setIdOccInfo bndr strongLoopBreaker, rhs)
800
801 mk_non_loop_breaker :: VarSet -> Node Details -> Binding
802 -- See Note [Weak loop breakers]
803 mk_non_loop_breaker used_in_rules (ND { nd_bndr = bndr, nd_rhs = rhs}, _, _)
804   | bndr `elemVarSet` used_in_rules = (setIdOccInfo bndr weakLoopBreaker, rhs)
805   | otherwise                       = (bndr, rhs)
806
807 udFreeVars :: VarSet -> UsageDetails -> VarSet
808 -- Find the subset of bndrs that are mentioned in uds
809 udFreeVars bndrs uds = intersectUFM_C (\b _ -> b) bndrs uds
810
811 loopBreakNodes :: Int
812                -> VarSet        -- All binders
813                -> VarSet        -- Binders whose dependencies may be "missing"
814                                 -- See Note [Weak loop breakers]
815                -> [Node Details]
816                -> [Binding]             -- Append these to the end
817                -> [Binding]
818 -- Return the bindings sorted into a plausible order, and marked with loop breakers.
819 loopBreakNodes depth bndr_set weak_fvs nodes binds
820   = go (stronglyConnCompFromEdgedVerticesR nodes) binds
821   where
822     go []         binds = binds
823     go (scc:sccs) binds = loop_break_scc scc (go sccs binds)
824
825     loop_break_scc scc binds
826       = case scc of
827           AcyclicSCC node  -> mk_non_loop_breaker weak_fvs node : binds
828           CyclicSCC [node] -> mk_loop_breaker node : binds
829           CyclicSCC nodes  -> reOrderNodes depth bndr_set weak_fvs nodes binds
830
831 reOrderNodes :: Int -> VarSet -> VarSet -> [Node Details] -> [Binding] -> [Binding]
832     -- Choose a loop breaker, mark it no-inline,
833     -- do SCC analysis on the rest, and recursively sort them out
834 reOrderNodes _ _ _ [] _  = panic "reOrderNodes"
835 reOrderNodes depth bndr_set weak_fvs (node : nodes) binds
836   = -- pprTrace "reOrderNodes" (text "unchosen" <+> ppr unchosen $$
837     --                           text "chosen" <+> ppr chosen_nodes) $
838     loopBreakNodes new_depth bndr_set weak_fvs unchosen $
839     (map mk_loop_breaker chosen_nodes ++ binds)
840   where
841     (chosen_nodes, unchosen) = choose_loop_breaker (score node) [node] [] nodes
842
843     approximate_loop_breaker = depth >= 2
844     new_depth | approximate_loop_breaker = 0
845               | otherwise                = depth+1
846         -- After two iterations (d=0, d=1) give up
847         -- and approximate, returning to d=0
848
849     choose_loop_breaker :: Int                  -- Best score so far
850                         -> [Node Details]       -- Nodes with this score
851                         -> [Node Details]       -- Nodes with higher scores
852                         -> [Node Details]       -- Unprocessed nodes
853                         -> ([Node Details], [Node Details])
854         -- This loop looks for the bind with the lowest score
855         -- to pick as the loop  breaker.  The rest accumulate in
856     choose_loop_breaker _ loop_nodes acc []
857         = (loop_nodes, acc)        -- Done
858
859         -- If approximate_loop_breaker is True, we pick *all*
860         -- nodes with lowest score, else just one
861         -- See Note [Complexity of loop breaking]
862     choose_loop_breaker loop_sc loop_nodes acc (node : nodes)
863         | sc < loop_sc  -- Lower score so pick this new one
864         = choose_loop_breaker sc [node] (loop_nodes ++ acc) nodes
865
866         | approximate_loop_breaker && sc == loop_sc
867         = choose_loop_breaker loop_sc (node : loop_nodes) acc nodes
868
869         | otherwise     -- Higher score so don't pick it
870         = choose_loop_breaker loop_sc loop_nodes (node : acc) nodes
871         where
872           sc = score node
873
874     score :: Node Details -> Int        -- Higher score => less likely to be picked as loop breaker
875     score (ND { nd_bndr = bndr, nd_rhs = rhs }, _, _)
876         | not (isId bndr) = 100     -- A type or cercion variable is never a loop breaker
877
878         | isDFunId bndr = 9   -- Never choose a DFun as a loop breaker
879                               -- Note [DFuns should not be loop breakers]
880
881         | Just _ <- isStableCoreUnfolding_maybe (idUnfolding bndr)
882         = 3    -- Note [INLINE pragmas]
883                -- Data structures are more important than INLINE pragmas
884                -- so that dictionary/method recursion unravels
885                -- Note that this case hits all InlineRule things, so we
886                -- never look at 'rhs' for InlineRule stuff. That's right, because
887                -- 'rhs' is irrelevant for inlining things with an InlineRule
888
889         | is_con_app rhs = 5  -- Data types help with cases: Note [Constructor applications]
890
891         | exprIsTrivial rhs = 10  -- Practically certain to be inlined
892                 -- Used to have also: && not (isExportedId bndr)
893                 -- But I found this sometimes cost an extra iteration when we have
894                 --      rec { d = (a,b); a = ...df...; b = ...df...; df = d }
895                 -- where df is the exported dictionary. Then df makes a really
896                 -- bad choice for loop breaker
897
898
899 -- If an Id is marked "never inline" then it makes a great loop breaker
900 -- The only reason for not checking that here is that it is rare
901 -- and I've never seen a situation where it makes a difference,
902 -- so it probably isn't worth the time to test on every binder
903 --      | isNeverActive (idInlinePragma bndr) = -10
904
905         | isOneOcc (idOccInfo bndr) = 2  -- Likely to be inlined
906
907         | canUnfold (realIdUnfolding bndr) = 1
908                 -- The Id has some kind of unfolding
909                 -- Ignore loop-breaker-ness here because that is what we are setting!
910
911         | otherwise = 0
912
913         -- Checking for a constructor application
914         -- Cheap and cheerful; the simplifer moves casts out of the way
915         -- The lambda case is important to spot x = /\a. C (f a)
916         -- which comes up when C is a dictionary constructor and
917         -- f is a default method.
918         -- Example: the instance for Show (ST s a) in GHC.ST
919         --
920         -- However we *also* treat (\x. C p q) as a con-app-like thing,
921         --      Note [Closure conversion]
922     is_con_app (Var v)    = isConLikeId v
923     is_con_app (App f _)  = is_con_app f
924     is_con_app (Lam _ e)  = is_con_app e
925     is_con_app (Tick _ e) = is_con_app e
926     is_con_app _          = False
927 \end{code}
928
929 Note [Complexity of loop breaking]
930 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
931 The loop-breaking algorithm knocks out one binder at a time, and
932 performs a new SCC analysis on the remaining binders.  That can
933 behave very badly in tightly-coupled groups of bindings; in the
934 worst case it can be (N**2)*log N, because it does a full SCC
935 on N, then N-1, then N-2 and so on.
936
937 To avoid this, we switch plans after 2 (or whatever) attempts:
938   Plan A: pick one binder with the lowest score, make it
939           a loop breaker, and try again
940   Plan B: pick *all* binders with the lowest score, make them
941           all loop breakers, and try again
942 Since there are only a small finite number of scores, this will
943 terminate in a constant number of iterations, rather than O(N)
944 iterations.
945
946 You might thing that it's very unlikely, but RULES make it much
947 more likely.  Here's a real example from Trac #1969:
948   Rec { $dm = \d.\x. op d
949         {-# RULES forall d. $dm Int d  = $s$dm1
950                   forall d. $dm Bool d = $s$dm2 #-}
951
952         dInt = MkD .... opInt ...
953         dInt = MkD .... opBool ...
954         opInt  = $dm dInt
955         opBool = $dm dBool
956
957         $s$dm1 = \x. op dInt
958         $s$dm2 = \x. op dBool }
959 The RULES stuff means that we can't choose $dm as a loop breaker
960 (Note [Choosing loop breakers]), so we must choose at least (say)
961 opInt *and* opBool, and so on.  The number of loop breakders is
962 linear in the number of instance declarations.
963
964 Note [INLINE pragmas]
965 ~~~~~~~~~~~~~~~~~~~~~
966 Avoid choosing a function with an INLINE pramga as the loop breaker!
967 If such a function is mutually-recursive with a non-INLINE thing,
968 then the latter should be the loop-breaker.
969
970    ----> Historical note, dating from when strictness wrappers
971    were generated from the strictness signatures:
972
973       Usually this is just a question of optimisation. But a particularly
974       bad case is wrappers generated by the demand analyser: if you make
975       then into a loop breaker you may get an infinite inlining loop.  For
976       example:
977         rec {
978               $wfoo x = ....foo x....
979
980               {-loop brk-} foo x = ...$wfoo x...
981         }
982       The interface file sees the unfolding for $wfoo, and sees that foo is
983       strict (and hence it gets an auto-generated wrapper).  Result: an
984       infinite inlining in the importing scope.  So be a bit careful if you
985       change this.  A good example is Tree.repTree in
986       nofib/spectral/minimax. If the repTree wrapper is chosen as the loop
987       breaker then compiling Game.hs goes into an infinite loop.  This
988       happened when we gave is_con_app a lower score than inline candidates:
989
990         Tree.repTree
991           = __inline_me (/\a. \w w1 w2 ->
992                          case Tree.$wrepTree @ a w w1 w2 of
993                           { (# ww1, ww2 #) -> Branch @ a ww1 ww2 })
994         Tree.$wrepTree
995           = /\a w w1 w2 ->
996             (# w2_smP, map a (Tree a) (Tree.repTree a w1 w) (w w2) #)
997
998       Here we do *not* want to choose 'repTree' as the loop breaker.
999
1000    -----> End of historical note
1001
1002 Note [DFuns should not be loop breakers]
1003 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1004 It's particularly bad to make a DFun into a loop breaker.  See
1005 Note [How instance declarations are translated] in TcInstDcls
1006
1007 We give DFuns a higher score than ordinary CONLIKE things because
1008 if there's a choice we want the DFun to be the non-looop breker. Eg
1009
1010 rec { sc = /\ a \$dC. $fBWrap (T a) ($fCT @ a $dC)
1011
1012       $fCT :: forall a_afE. (Roman.C a_afE) => Roman.C (Roman.T a_afE)
1013       {-# DFUN #-}
1014       $fCT = /\a \$dC. MkD (T a) ((sc @ a $dC) |> blah) ($ctoF @ a $dC)
1015     }
1016
1017 Here 'sc' (the superclass) looks CONLIKE, but we'll never get to it
1018 if we can't unravel the DFun first.
1019
1020 Note [Constructor applications]
1021 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1022 It's really really important to inline dictionaries.  Real
1023 example (the Enum Ordering instance from GHC.Base):
1024
1025      rec     f = \ x -> case d of (p,q,r) -> p x
1026              g = \ x -> case d of (p,q,r) -> q x
1027              d = (v, f, g)
1028
1029 Here, f and g occur just once; but we can't inline them into d.
1030 On the other hand we *could* simplify those case expressions if
1031 we didn't stupidly choose d as the loop breaker.
1032 But we won't because constructor args are marked "Many".
1033 Inlining dictionaries is really essential to unravelling
1034 the loops in static numeric dictionaries, see GHC.Float.
1035
1036 Note [Closure conversion]
1037 ~~~~~~~~~~~~~~~~~~~~~~~~~
1038 We treat (\x. C p q) as a high-score candidate in the letrec scoring algorithm.
1039 The immediate motivation came from the result of a closure-conversion transformation
1040 which generated code like this:
1041
1042     data Clo a b = forall c. Clo (c -> a -> b) c
1043
1044     ($:) :: Clo a b -> a -> b
1045     Clo f env $: x = f env x
1046
1047     rec { plus = Clo plus1 ()
1048
1049         ; plus1 _ n = Clo plus2 n
1050
1051         ; plus2 Zero     n = n
1052         ; plus2 (Succ m) n = Succ (plus $: m $: n) }
1053
1054 If we inline 'plus' and 'plus1', everything unravels nicely.  But if
1055 we choose 'plus1' as the loop breaker (which is entirely possible
1056 otherwise), the loop does not unravel nicely.
1057
1058
1059 @occAnalRhs@ deals with the question of bindings where the Id is marked
1060 by an INLINE pragma.  For these we record that anything which occurs
1061 in its RHS occurs many times.  This pessimistically assumes that ths
1062 inlined binder also occurs many times in its scope, but if it doesn't
1063 we'll catch it next time round.  At worst this costs an extra simplifier pass.
1064 ToDo: try using the occurrence info for the inline'd binder.
1065
1066 [March 97] We do the same for atomic RHSs.  Reason: see notes with loopBreakSCC.
1067 [June 98, SLPJ]  I've undone this change; I don't understand it.  See notes with loopBreakSCC.
1068
1069
1070 \begin{code}
1071 occAnalRecRhs :: OccEnv -> CoreExpr    -- Rhs
1072            -> (UsageDetails, CoreExpr)
1073               -- Returned usage details covers only the RHS,
1074               -- and *not* the RULE or INLINE template for the Id
1075 occAnalRecRhs env rhs = occAnal (rhsCtxt env) rhs
1076
1077 occAnalNonRecRhs :: OccEnv
1078                  -> Id -> CoreExpr    -- Binder and rhs
1079                      -- Binder is already tagged with occurrence info
1080                  -> (UsageDetails, CoreExpr)
1081               -- Returned usage details covers only the RHS,
1082               -- and *not* the RULE or INLINE template for the Id
1083 occAnalNonRecRhs env bndr rhs
1084   = occAnal rhs_env rhs
1085   where
1086     -- See Note [Use one-shot info]
1087     env1 = env { occ_one_shots = argOneShots OneShotLam dmd }
1088
1089     -- See Note [Cascading inlines]
1090     rhs_env | certainly_inline = env1
1091             | otherwise        = rhsCtxt env1
1092
1093     certainly_inline -- See Note [Cascading inlines]
1094       = case idOccInfo bndr of
1095           OneOcc in_lam one_br _ -> not in_lam && one_br && active && not_stable
1096           _                      -> False
1097
1098     dmd        = idDemandInfo bndr
1099     active     = isAlwaysActive (idInlineActivation bndr)
1100     not_stable = not (isStableUnfolding (idUnfolding bndr))
1101
1102 addIdOccs :: UsageDetails -> VarSet -> UsageDetails
1103 addIdOccs usage id_set = foldVarSet add usage id_set
1104   where
1105     add v u | isId v    = addOneOcc u v NoOccInfo
1106             | otherwise = u
1107         -- Give a non-committal binder info (i.e NoOccInfo) because
1108         --   a) Many copies of the specialised thing can appear
1109         --   b) We don't want to substitute a BIG expression inside a RULE
1110         --      even if that's the only occurrence of the thing
1111         --      (Same goes for INLINE.)
1112 \end{code}
1113
1114 Note [Cascading inlines]
1115 ~~~~~~~~~~~~~~~~~~~~~~~~
1116 By default we use an rhsCtxt for the RHS of a binding.  This tells the
1117 occ anal n that it's looking at an RHS, which has an effect in
1118 occAnalApp.  In particular, for constructor applications, it makes
1119 the arguments appear to have NoOccInfo, so that we don't inline into
1120 them. Thus    x = f y
1121               k = Just x
1122 we do not want to inline x.
1123
1124 But there's a problem.  Consider
1125      x1 = a0 : []
1126      x2 = a1 : x1
1127      x3 = a2 : x2
1128      g  = f x3
1129 First time round, it looks as if x1 and x2 occur as an arg of a
1130 let-bound constructor ==> give them a many-occurrence.
1131 But then x3 is inlined (unconditionally as it happens) and
1132 next time round, x2 will be, and the next time round x1 will be
1133 Result: multiple simplifier iterations.  Sigh.
1134
1135 So, when analysing the RHS of x3 we notice that x3 will itself
1136 definitely inline the next time round, and so we analyse x3's rhs in
1137 an ordinary context, not rhsCtxt.  Hence the "certainly_inline" stuff.
1138
1139 Annoyingly, we have to approximate SimplUtils.preInlineUnconditionally.
1140 If we say "yes" when preInlineUnconditionally says "no" the simplifier iterates
1141 indefinitely:
1142         x = f y
1143         k = Just x
1144 inline ==>
1145         k = Just (f y)
1146 float ==>
1147         x1 = f y
1148         k = Just x1
1149
1150 This is worse than the slow cascade, so we only want to say "certainly_inline"
1151 if it really is certain.  Look at the note with preInlineUnconditionally
1152 for the various clauses.
1153
1154 Expressions
1155 ~~~~~~~~~~~
1156 \begin{code}
1157 occAnal :: OccEnv
1158         -> CoreExpr
1159         -> (UsageDetails,       -- Gives info only about the "interesting" Ids
1160             CoreExpr)
1161
1162 occAnal _   expr@(Type _) = (emptyDetails,         expr)
1163 occAnal _   expr@(Lit _)  = (emptyDetails,         expr)
1164 occAnal env expr@(Var v)  = (mkOneOcc env v False, expr)
1165     -- At one stage, I gathered the idRuleVars for v here too,
1166     -- which in a way is the right thing to do.
1167     -- But that went wrong right after specialisation, when
1168     -- the *occurrences* of the overloaded function didn't have any
1169     -- rules in them, so the *specialised* versions looked as if they
1170     -- weren't used at all.
1171
1172 occAnal _ (Coercion co)
1173   = (addIdOccs emptyDetails (coVarsOfCo co), Coercion co)
1174         -- See Note [Gather occurrences of coercion veriables]
1175 \end{code}
1176
1177 Note [Gather occurrences of coercion veriables]
1178 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1179 We need to gather info about what coercion variables appear, so that
1180 we can sort them into the right place when doing dependency analysis.
1181
1182 \begin{code}
1183 occAnal env (Tick tickish body)
1184   | Breakpoint _ ids <- tickish
1185   = (mapVarEnv markInsideSCC usage
1186          +++ mkVarEnv (zip ids (repeat NoOccInfo)), Tick tickish body')
1187     -- never substitute for any of the Ids in a Breakpoint
1188
1189   | tickishScoped tickish
1190   = (mapVarEnv markInsideSCC usage, Tick tickish body')
1191
1192   | otherwise
1193   = (usage, Tick tickish body')
1194   where
1195     !(usage,body') = occAnal env body
1196
1197 occAnal env (Cast expr co)
1198   = case occAnal env expr of { (usage, expr') ->
1199     let usage1 = markManyIf (isRhsEnv env) usage
1200         usage2 = addIdOccs usage1 (coVarsOfCo co)
1201           -- See Note [Gather occurrences of coercion veriables]
1202     in (usage2, Cast expr' co)
1203         -- If we see let x = y `cast` co
1204         -- then mark y as 'Many' so that we don't
1205         -- immediately inline y again.
1206     }
1207 \end{code}
1208
1209 \begin{code}
1210 occAnal env app@(App _ _)
1211   = occAnalApp env (collectArgs app)
1212
1213 -- Ignore type variables altogether
1214 --   (a) occurrences inside type lambdas only not marked as InsideLam
1215 --   (b) type variables not in environment
1216
1217 occAnal env (Lam x body) | isTyVar x
1218   = case occAnal env body of { (body_usage, body') ->
1219     (body_usage, Lam x body')
1220     }
1221
1222 -- For value lambdas we do a special hack.  Consider
1223 --      (\x. \y. ...x...)
1224 -- If we did nothing, x is used inside the \y, so would be marked
1225 -- as dangerous to dup.  But in the common case where the abstraction
1226 -- is applied to two arguments this is over-pessimistic.
1227 -- So instead, we just mark each binder with its occurrence
1228 -- info in the *body* of the multiple lambda.
1229 -- Then, the simplifier is careful when partially applying lambdas.
1230
1231 occAnal env expr@(Lam _ _)
1232   = case occAnal env_body body of { (body_usage, body') ->
1233     let
1234         (final_usage, tagged_binders) = tagLamBinders body_usage binders'
1235                       -- Use binders' to put one-shot info on the lambdas
1236
1237         really_final_usage
1238           | all isOneShotBndr binders' = final_usage
1239           | otherwise = mapVarEnv markInsideLam final_usage
1240     in
1241     (really_final_usage, mkLams tagged_binders body') }
1242   where
1243     (binders, body)      = collectBinders expr
1244     (env_body, binders') = oneShotGroup env binders
1245
1246 occAnal env (Case scrut bndr ty alts)
1247   = case occ_anal_scrut scrut alts     of { (scrut_usage, scrut') ->
1248     case mapAndUnzip occ_anal_alt alts of { (alts_usage_s, alts')   ->
1249     let
1250         alts_usage  = foldr combineAltsUsageDetails emptyDetails alts_usage_s
1251         (alts_usage1, tagged_bndr) = tag_case_bndr alts_usage bndr
1252         total_usage = scrut_usage +++ alts_usage1
1253     in
1254     total_usage `seq` (total_usage, Case scrut' tagged_bndr ty alts') }}
1255   where
1256         -- Note [Case binder usage]
1257         -- ~~~~~~~~~~~~~~~~~~~~~~~~
1258         -- The case binder gets a usage of either "many" or "dead", never "one".
1259         -- Reason: we like to inline single occurrences, to eliminate a binding,
1260         -- but inlining a case binder *doesn't* eliminate a binding.
1261         -- We *don't* want to transform
1262         --      case x of w { (p,q) -> f w }
1263         -- into
1264         --      case x of w { (p,q) -> f (p,q) }
1265     tag_case_bndr usage bndr
1266       = case lookupVarEnv usage bndr of
1267           Nothing -> (usage,                  setIdOccInfo bndr IAmDead)
1268           Just _  -> (usage `delVarEnv` bndr, setIdOccInfo bndr NoOccInfo)
1269
1270     alt_env = mkAltEnv env scrut bndr
1271     occ_anal_alt = occAnalAlt alt_env bndr
1272
1273     occ_anal_scrut (Var v) (alt1 : other_alts)
1274         | not (null other_alts) || not (isDefaultAlt alt1)
1275         = (mkOneOcc env v True, Var v)  -- The 'True' says that the variable occurs
1276                                         -- in an interesting context; the case has
1277                                         -- at least one non-default alternative
1278     occ_anal_scrut scrut _alts
1279         = occAnal (vanillaCtxt env) scrut    -- No need for rhsCtxt
1280
1281 occAnal env (Let bind body)
1282   = case occAnal env body                                of { (body_usage, body') ->
1283     case occAnalBind env env emptyVarEnv bind body_usage of { (final_usage, new_binds) ->
1284        (final_usage, mkLets new_binds body') }}
1285
1286 occAnalArgs :: OccEnv -> [CoreExpr] -> [OneShots] -> (UsageDetails, [CoreExpr])
1287 occAnalArgs _ [] _ 
1288   = (emptyDetails, [])
1289
1290 occAnalArgs env (arg:args) one_shots
1291   | isTypeArg arg
1292   = case occAnalArgs env args one_shots of { (uds, args') ->
1293     (uds, arg:args') }
1294
1295   | otherwise
1296   = case argCtxt env one_shots           of { (arg_env, one_shots') ->
1297     case occAnal arg_env arg             of { (uds1, arg') ->
1298     case occAnalArgs env args one_shots' of { (uds2, args') ->
1299     (uds1 +++ uds2, arg':args') }}}
1300 \end{code}
1301
1302 Applications are dealt with specially because we want
1303 the "build hack" to work.
1304
1305 Note [Arguments of let-bound constructors]
1306 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1307 Consider
1308     f x = let y = expensive x in
1309           let z = (True,y) in
1310           (case z of {(p,q)->q}, case z of {(p,q)->q})
1311 We feel free to duplicate the WHNF (True,y), but that means
1312 that y may be duplicated thereby.
1313
1314 If we aren't careful we duplicate the (expensive x) call!
1315 Constructors are rather like lambdas in this way.
1316
1317 \begin{code}
1318 occAnalApp :: OccEnv
1319            -> (Expr CoreBndr, [Arg CoreBndr])
1320            -> (UsageDetails, Expr CoreBndr)
1321 occAnalApp env (Var fun, args)
1322   = case args_stuff of { (args_uds, args') ->
1323     let
1324        final_args_uds = markManyIf (isRhsEnv env && is_exp) args_uds
1325           -- We mark the free vars of the argument of a constructor or PAP
1326           -- as "many", if it is the RHS of a let(rec).
1327           -- This means that nothing gets inlined into a constructor argument
1328           -- position, which is what we want.  Typically those constructor
1329           -- arguments are just variables, or trivial expressions.
1330           --
1331           -- This is the *whole point* of the isRhsEnv predicate
1332           -- See Note [Arguments of let-bound constructors]
1333     in
1334     (fun_uds +++ final_args_uds, mkApps (Var fun) args') }
1335   where
1336     n_val_args = valArgCount args
1337     fun_uds    = mkOneOcc env fun (n_val_args > 0)
1338     is_exp     = isExpandableApp fun n_val_args
1339            -- See Note [CONLIKE pragma] in BasicTypes
1340            -- The definition of is_exp should match that in
1341            -- Simplify.prepareRhs
1342
1343     one_shots  = argsOneShots (idStrictness fun) n_val_args
1344                  -- See Note [Use one-shot info]
1345
1346     args_stuff = occAnalArgs env args one_shots
1347
1348                         -- (foldr k z xs) may call k many times, but it never
1349                         -- shares a partial application of k; hence [False,True]
1350                         -- This means we can optimise
1351                         --      foldr (\x -> let v = ...x... in \y -> ...v...) z xs
1352                         -- by floating in the v
1353
1354 occAnalApp env (fun, args)
1355   = case occAnal (addAppCtxt env args) fun of   { (fun_uds, fun') ->
1356         -- The addAppCtxt is a bit cunning.  One iteration of the simplifier
1357         -- often leaves behind beta redexs like
1358         --      (\x y -> e) a1 a2
1359         -- Here we would like to mark x,y as one-shot, and treat the whole
1360         -- thing much like a let.  We do this by pushing some True items
1361         -- onto the context stack.
1362
1363     case occAnalArgs env args [] of        { (args_uds, args') ->
1364     (fun_uds +++ args_uds, mkApps fun' args') }}
1365
1366
1367 markManyIf :: Bool              -- If this is true
1368            -> UsageDetails      -- Then do markMany on this
1369            -> UsageDetails
1370 markManyIf True  uds = mapVarEnv markMany uds
1371 markManyIf False uds = uds
1372 \end{code}
1373
1374 Note [Use one-shot information]
1375 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1376 The occurrrence analyser propagates one-shot-lambda information in two situation
1377   * Applications:  eg   build (\cn -> blah)
1378     Propagate one-shot info from the strictness signature of 'build' to
1379     the \cn
1380
1381   * Let-bindings:  eg   let f = \c. let ... in \n -> blah 
1382                         in (build f, build f)
1383     Propagate one-shot info from the demanand-info on 'f' to the
1384     lambdas in its RHS (which may not be syntactically at the top)
1385
1386 Some of this is done by the demand analyser, but this way it happens
1387 much earlier, taking advantage of the strictness signature of 
1388 imported functions.
1389
1390 Note [Binders in case alternatives]
1391 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1392 Consider
1393     case x of y { (a,b) -> f y }
1394 We treat 'a', 'b' as dead, because they don't physically occur in the
1395 case alternative.  (Indeed, a variable is dead iff it doesn't occur in
1396 its scope in the output of OccAnal.)  It really helps to know when
1397 binders are unused.  See esp the call to isDeadBinder in
1398 Simplify.mkDupableAlt
1399
1400 In this example, though, the Simplifier will bring 'a' and 'b' back to
1401 life, beause it binds 'y' to (a,b) (imagine got inlined and
1402 scrutinised y).
1403
1404 \begin{code}
1405 occAnalAlt :: (OccEnv, Maybe (Id, CoreExpr))
1406            -> CoreBndr
1407            -> CoreAlt
1408            -> (UsageDetails, Alt IdWithOccInfo)
1409 occAnalAlt (env, scrut_bind) case_bndr (con, bndrs, rhs)
1410   = case occAnal env rhs of { (rhs_usage1, rhs1) ->
1411     let
1412         (rhs_usage2, rhs2) =
1413           wrapProxy (occ_binder_swap env) scrut_bind case_bndr rhs_usage1 rhs1 
1414         (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage2 bndrs
1415         bndrs' = tagged_bndrs      -- See Note [Binders in case alternatives]
1416     in
1417     (alt_usg, (con, bndrs', rhs2)) }
1418
1419 wrapProxy :: Bool -> Maybe (Id, CoreExpr) -> Id -> UsageDetails -> CoreExpr -> (UsageDetails, CoreExpr)
1420 wrapProxy enable_binder_swap (Just (scrut_var, rhs)) case_bndr body_usg body
1421   | enable_binder_swap,
1422     scrut_var `usedIn` body_usg
1423   = ( body_usg' +++ unitVarEnv case_bndr NoOccInfo
1424     , Let (NonRec tagged_scrut_var rhs) body )
1425   where
1426     (body_usg', tagged_scrut_var) = tagBinder body_usg scrut_var
1427     
1428 wrapProxy _ _ _ body_usg body 
1429   = (body_usg, body)
1430 \end{code}
1431
1432
1433 %************************************************************************
1434 %*                                                                      *
1435                     OccEnv
1436 %*                                                                      *
1437 %************************************************************************
1438
1439 \begin{code}
1440 data OccEnv
1441   = OccEnv { occ_encl       :: !OccEncl      -- Enclosing context information
1442            , occ_one_shots  :: !OneShots     -- Tells about linearity
1443            , occ_gbl_scrut  :: GlobalScruts
1444            , occ_rule_act   :: Activation -> Bool   -- Which rules are active
1445              -- See Note [Finding rule RHS free vars]
1446            , occ_binder_swap :: !Bool -- enable the binder_swap
1447              -- See CorePrep Note [Dead code in CorePrep]
1448     }
1449
1450 type GlobalScruts = IdSet   -- See Note [Binder swap on GlobalId scrutinees]
1451
1452 -----------------------------
1453 -- OccEncl is used to control whether to inline into constructor arguments
1454 -- For example:
1455 --      x = (p,q)               -- Don't inline p or q
1456 --      y = /\a -> (p a, q a)   -- Still don't inline p or q
1457 --      z = f (p,q)             -- Do inline p,q; it may make a rule fire
1458 -- So OccEncl tells enought about the context to know what to do when
1459 -- we encounter a contructor application or PAP.
1460
1461 data OccEncl
1462   = OccRhs              -- RHS of let(rec), albeit perhaps inside a type lambda
1463                         -- Don't inline into constructor args here
1464   | OccVanilla          -- Argument of function, body of lambda, scruintee of case etc.
1465                         -- Do inline into constructor args here
1466
1467 instance Outputable OccEncl where
1468   ppr OccRhs     = ptext (sLit "occRhs")
1469   ppr OccVanilla = ptext (sLit "occVanilla")
1470
1471 type OneShots = [OneShotInfo]
1472         -- []           No info
1473         --
1474         -- one_shot_info:ctxt    Analysing a function-valued expression that
1475         --                       will be applied as described by one_shot_info
1476
1477 initOccEnv :: (Activation -> Bool) -> OccEnv
1478 initOccEnv active_rule
1479   = OccEnv { occ_encl      = OccVanilla
1480            , occ_one_shots = []
1481            , occ_gbl_scrut = emptyVarSet --  PE emptyVarEnv emptyVarSet
1482            , occ_rule_act  = active_rule
1483            , occ_binder_swap = True }
1484
1485 vanillaCtxt :: OccEnv -> OccEnv
1486 vanillaCtxt env = env { occ_encl = OccVanilla, occ_one_shots = [] }
1487
1488 rhsCtxt :: OccEnv -> OccEnv
1489 rhsCtxt env = env { occ_encl = OccRhs, occ_one_shots = [] }
1490
1491 argCtxt :: OccEnv -> [OneShots] -> (OccEnv, [OneShots])
1492 argCtxt env [] 
1493   = (env { occ_encl = OccVanilla, occ_one_shots = [] }, [])
1494 argCtxt env (one_shots:one_shots_s) 
1495   = (env { occ_encl = OccVanilla, occ_one_shots = one_shots }, one_shots_s)
1496
1497 isRhsEnv :: OccEnv -> Bool
1498 isRhsEnv (OccEnv { occ_encl = OccRhs })     = True
1499 isRhsEnv (OccEnv { occ_encl = OccVanilla }) = False
1500
1501 oneShotGroup :: OccEnv -> [CoreBndr] 
1502              -> ( OccEnv
1503                 , [CoreBndr] )
1504         -- The result binders have one-shot-ness set that they might not have had originally.
1505         -- This happens in (build (\cn -> e)).  Here the occurrence analyser
1506         -- linearity context knows that c,n are one-shot, and it records that fact in
1507         -- the binder. This is useful to guide subsequent float-in/float-out tranformations
1508
1509 oneShotGroup env@(OccEnv { occ_one_shots = ctxt }) bndrs
1510   = go ctxt bndrs []
1511   where
1512     go ctxt [] rev_bndrs
1513       = ( env { occ_one_shots = ctxt, occ_encl = OccVanilla }
1514         , reverse rev_bndrs )
1515
1516     go [] bndrs rev_bndrs
1517       = ( env { occ_one_shots = [], occ_encl = OccVanilla }
1518         , reverse rev_bndrs ++ bndrs )
1519
1520     go ctxt (bndr:bndrs) rev_bndrs
1521       | isId bndr
1522       
1523       = case ctxt of
1524           []                -> go []   bndrs (bndr : rev_bndrs)
1525           (one_shot : ctxt) -> go ctxt bndrs (bndr': rev_bndrs)
1526                             where
1527                                bndr' = updOneShotInfo bndr one_shot
1528        | otherwise
1529       = go ctxt bndrs (bndr:rev_bndrs)
1530
1531 addAppCtxt :: OccEnv -> [Arg CoreBndr] -> OccEnv
1532 addAppCtxt env@(OccEnv { occ_one_shots = ctxt }) args
1533   = env { occ_one_shots = replicate (valArgCount args) OneShotLam ++ ctxt }
1534 \end{code}
1535
1536
1537 \begin{code}
1538 transClosureFV :: UniqFM VarSet -> UniqFM VarSet
1539 -- If (f,g), (g,h) are in the input, then (f,h) is in the output
1540 --                                   as well as (f,g), (g,h)
1541 transClosureFV env
1542   | no_change = env
1543   | otherwise = transClosureFV (listToUFM new_fv_list)
1544   where
1545     (no_change, new_fv_list) = mapAccumL bump True (ufmToList env)
1546     bump no_change (b,fvs)
1547       | no_change_here = (no_change, (b,fvs))
1548       | otherwise      = (False,     (b,new_fvs))
1549       where
1550         (new_fvs, no_change_here) = extendFvs env fvs
1551
1552 -------------
1553 extendFvs_ :: UniqFM VarSet -> VarSet -> VarSet
1554 extendFvs_ env s = fst (extendFvs env s)   -- Discard the Bool flag
1555
1556 extendFvs :: UniqFM VarSet -> VarSet -> (VarSet, Bool)
1557 -- (extendFVs env s) returns
1558 --     (s `union` env(s), env(s) `subset` s)
1559 extendFvs env s
1560   | isNullUFM env
1561   = (s, True)
1562   | otherwise
1563   = (s `unionVarSet` extras, extras `subVarSet` s)
1564   where
1565     extras :: VarSet    -- env(s)
1566     extras = foldUFM unionVarSet emptyVarSet $
1567              intersectUFM_C (\x _ -> x) env s
1568 \end{code}
1569
1570
1571 %************************************************************************
1572 %*                                                                      *
1573                     Binder swap
1574 %*                                                                      *
1575 %************************************************************************
1576
1577 Note [Binder swap]
1578 ~~~~~~~~~~~~~~~~~~
1579 We do these two transformations right here:
1580
1581  (1)   case x of b { pi -> ri }
1582     ==>
1583       case x of b { pi -> let x=b in ri }
1584
1585  (2)  case (x |> co) of b { pi -> ri }
1586     ==>
1587       case (x |> co) of b { pi -> let x = b |> sym co in ri }
1588
1589     Why (2)?  See Note [Case of cast]
1590
1591 In both cases, in a particular alternative (pi -> ri), we only
1592 add the binding if
1593   (a) x occurs free in (pi -> ri)
1594         (ie it occurs in ri, but is not bound in pi)
1595   (b) the pi does not bind b (or the free vars of co)
1596 We need (a) and (b) for the inserted binding to be correct.
1597
1598 For the alternatives where we inject the binding, we can transfer
1599 all x's OccInfo to b.  And that is the point.
1600
1601 Notice that
1602   * The deliberate shadowing of 'x'.
1603   * That (a) rapidly becomes false, so no bindings are injected.
1604
1605 The reason for doing these transformations here is because it allows
1606 us to adjust the OccInfo for 'x' and 'b' as we go.
1607
1608   * Suppose the only occurrences of 'x' are the scrutinee and in the
1609     ri; then this transformation makes it occur just once, and hence
1610     get inlined right away.
1611
1612   * If we do this in the Simplifier, we don't know whether 'x' is used
1613     in ri, so we are forced to pessimistically zap b's OccInfo even
1614     though it is typically dead (ie neither it nor x appear in the
1615     ri).  There's nothing actually wrong with zapping it, except that
1616     it's kind of nice to know which variables are dead.  My nose
1617     tells me to keep this information as robustly as possible.
1618
1619 The Maybe (Id,CoreExpr) passed to occAnalAlt is the extra let-binding
1620 {x=b}; it's Nothing if the binder-swap doesn't happen.
1621
1622 There is a danger though.  Consider
1623       let v = x +# y
1624       in case (f v) of w -> ...v...v...
1625 And suppose that (f v) expands to just v.  Then we'd like to
1626 use 'w' instead of 'v' in the alternative.  But it may be too
1627 late; we may have substituted the (cheap) x+#y for v in the
1628 same simplifier pass that reduced (f v) to v.
1629
1630 I think this is just too bad.  CSE will recover some of it.
1631
1632 Note [Case of cast]
1633 ~~~~~~~~~~~~~~~~~~~
1634 Consider        case (x `cast` co) of b { I# ->
1635                 ... (case (x `cast` co) of {...}) ...
1636 We'd like to eliminate the inner case.  That is the motivation for
1637 equation (2) in Note [Binder swap].  When we get to the inner case, we
1638 inline x, cancel the casts, and away we go.
1639
1640 Note [Binder swap on GlobalId scrutinees]
1641 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1642 When the scrutinee is a GlobalId we must take care in two ways
1643
1644  i) In order to *know* whether 'x' occurs free in the RHS, we need its
1645     occurrence info. BUT, we don't gather occurrence info for
1646     GlobalIds.  That's the reason for the (small) occ_gbl_scrut env in 
1647     OccEnv is for: it says "gather occurrence info for these".
1648
1649  ii) We must call localiseId on 'x' first, in case it's a GlobalId, or
1650      has an External Name. See, for example, SimplEnv Note [Global Ids in
1651      the substitution].
1652
1653 Note [Zap case binders in proxy bindings]
1654 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1655 From the original
1656      case x of cb(dead) { p -> ...x... }
1657 we will get
1658      case x of cb(live) { p -> let x = cb in ...x... }
1659
1660 Core Lint never expects to find an *occurrence* of an Id marked
1661 as Dead, so we must zap the OccInfo on cb before making the
1662 binding x = cb.  See Trac #5028.
1663
1664 Historical note [no-case-of-case]
1665 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1666 We *used* to suppress the binder-swap in case expressions when
1667 -fno-case-of-case is on.  Old remarks:
1668     "This happens in the first simplifier pass,
1669     and enhances full laziness.  Here's the bad case:
1670             f = \ y -> ...(case x of I# v -> ...(case x of ...) ... )
1671     If we eliminate the inner case, we trap it inside the I# v -> arm,
1672     which might prevent some full laziness happening.  I've seen this
1673     in action in spectral/cichelli/Prog.hs:
1674              [(m,n) | m <- [1..max], n <- [1..max]]
1675     Hence the check for NoCaseOfCase."
1676 However, now the full-laziness pass itself reverses the binder-swap, so this
1677 check is no longer necessary.
1678
1679 Historical note [Suppressing the case binder-swap]
1680 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1681 This old note describes a problem that is also fixed by doing the
1682 binder-swap in OccAnal:
1683
1684     There is another situation when it might make sense to suppress the
1685     case-expression binde-swap. If we have
1686
1687         case x of w1 { DEFAULT -> case x of w2 { A -> e1; B -> e2 }
1688                        ...other cases .... }
1689
1690     We'll perform the binder-swap for the outer case, giving
1691
1692         case x of w1 { DEFAULT -> case w1 of w2 { A -> e1; B -> e2 }
1693                        ...other cases .... }
1694
1695     But there is no point in doing it for the inner case, because w1 can't
1696     be inlined anyway.  Furthermore, doing the case-swapping involves
1697     zapping w2's occurrence info (see paragraphs that follow), and that
1698     forces us to bind w2 when doing case merging.  So we get
1699
1700         case x of w1 { A -> let w2 = w1 in e1
1701                        B -> let w2 = w1 in e2
1702                        ...other cases .... }
1703
1704     This is plain silly in the common case where w2 is dead.
1705
1706     Even so, I can't see a good way to implement this idea.  I tried
1707     not doing the binder-swap if the scrutinee was already evaluated
1708     but that failed big-time:
1709
1710             data T = MkT !Int
1711
1712             case v of w  { MkT x ->
1713             case x of x1 { I# y1 ->
1714             case x of x2 { I# y2 -> ...
1715
1716     Notice that because MkT is strict, x is marked "evaluated".  But to
1717     eliminate the last case, we must either make sure that x (as well as
1718     x1) has unfolding MkT y1.  THe straightforward thing to do is to do
1719     the binder-swap.  So this whole note is a no-op.
1720
1721 It's fixed by doing the binder-swap in OccAnal because we can do the
1722 binder-swap unconditionally and still get occurrence analysis
1723 information right.
1724
1725 \begin{code}
1726 mkAltEnv :: OccEnv -> CoreExpr -> Id -> (OccEnv, Maybe (Id, CoreExpr))
1727 -- Does two things: a) makes the occ_one_shots = OccVanilla
1728 --                  b) extends the GlobalScruts if possible
1729 --                  c) returns a proxy mapping, binding the scrutinee
1730 --                     to the case binder, if possible
1731 mkAltEnv env@(OccEnv { occ_gbl_scrut = pe }) scrut case_bndr
1732   = case scrut of
1733       Var v           -> add_scrut v case_bndr'
1734       Cast (Var v) co -> add_scrut v (Cast case_bndr' (mkSymCo co))
1735                           -- See Note [Case of cast]
1736       _               -> (env { occ_encl = OccVanilla }, Nothing)
1737
1738   where
1739     add_scrut v rhs = ( env { occ_encl = OccVanilla, occ_gbl_scrut = pe `extendVarSet` v }
1740                       , Just (localise v, rhs) )
1741
1742     case_bndr' = Var (zapIdOccInfo case_bndr) -- See Note [Zap case binders in proxy bindings]
1743     localise scrut_var = mkLocalId (localiseName (idName scrut_var)) (idType scrut_var)
1744         -- Localise the scrut_var before shadowing it; we're making a
1745         -- new binding for it, and it might have an External Name, or
1746         -- even be a GlobalId; Note [Binder swap on GlobalId scrutinees]
1747         -- Also we don't want any INLINE or NOINLINE pragmas!
1748 \end{code}
1749
1750
1751 %************************************************************************
1752 %*                                                                      *
1753 \subsection[OccurAnal-types]{OccEnv}
1754 %*                                                                      *
1755 %************************************************************************
1756
1757 \begin{code}
1758 type UsageDetails = IdEnv OccInfo       -- A finite map from ids to their usage
1759                 -- INVARIANT: never IAmDead
1760                 -- (Deadness is signalled by not being in the map at all)
1761
1762 (+++), combineAltsUsageDetails
1763         :: UsageDetails -> UsageDetails -> UsageDetails
1764
1765 (+++) usage1 usage2
1766   = plusVarEnv_C addOccInfo usage1 usage2
1767
1768 combineAltsUsageDetails usage1 usage2
1769   = plusVarEnv_C orOccInfo usage1 usage2
1770
1771 addOneOcc :: UsageDetails -> Id -> OccInfo -> UsageDetails
1772 addOneOcc usage id info
1773   = plusVarEnv_C addOccInfo usage (unitVarEnv id info)
1774         -- ToDo: make this more efficient
1775
1776 emptyDetails :: UsageDetails
1777 emptyDetails = (emptyVarEnv :: UsageDetails)
1778
1779 usedIn :: Id -> UsageDetails -> Bool
1780 v `usedIn` details = isExportedId v || v `elemVarEnv` details
1781
1782 type IdWithOccInfo = Id
1783
1784 tagLamBinders :: UsageDetails          -- Of scope
1785               -> [Id]                  -- Binders
1786               -> (UsageDetails,        -- Details with binders removed
1787                  [IdWithOccInfo])    -- Tagged binders
1788 -- Used for lambda and case binders
1789 -- It copes with the fact that lambda bindings can have InlineRule
1790 -- unfoldings, used for join points
1791 tagLamBinders usage binders = usage' `seq` (usage', bndrs')
1792   where
1793     (usage', bndrs') = mapAccumR tag_lam usage binders
1794     tag_lam usage bndr = (usage2, setBinderOcc usage bndr)
1795       where
1796         usage1 = usage `delVarEnv` bndr
1797         usage2 | isId bndr = addIdOccs usage1 (idUnfoldingVars bndr)
1798                | otherwise = usage1
1799
1800 tagBinder :: UsageDetails           -- Of scope
1801           -> Id                     -- Binders
1802           -> (UsageDetails,         -- Details with binders removed
1803               IdWithOccInfo)        -- Tagged binders
1804
1805 tagBinder usage binder
1806  = let
1807      usage'  = usage `delVarEnv` binder
1808      binder' = setBinderOcc usage binder
1809    in
1810    usage' `seq` (usage', binder')
1811
1812 setBinderOcc :: UsageDetails -> CoreBndr -> CoreBndr
1813 setBinderOcc usage bndr
1814   | isTyVar bndr      = bndr
1815   | isExportedId bndr = case idOccInfo bndr of
1816                           NoOccInfo -> bndr
1817                           _         -> setIdOccInfo bndr NoOccInfo
1818             -- Don't use local usage info for visible-elsewhere things
1819             -- BUT *do* erase any IAmALoopBreaker annotation, because we're
1820             -- about to re-generate it and it shouldn't be "sticky"
1821
1822   | otherwise = setIdOccInfo bndr occ_info
1823   where
1824     occ_info = lookupVarEnv usage bndr `orElse` IAmDead
1825 \end{code}
1826
1827
1828 %************************************************************************
1829 %*                                                                      *
1830 \subsection{Operations over OccInfo}
1831 %*                                                                      *
1832 %************************************************************************
1833
1834 \begin{code}
1835 mkOneOcc :: OccEnv -> Id -> InterestingCxt -> UsageDetails
1836 mkOneOcc env id int_cxt
1837   | isLocalId id
1838   = unitVarEnv id (OneOcc False True int_cxt)
1839
1840   | id `elemVarEnv` occ_gbl_scrut env
1841   = unitVarEnv id NoOccInfo
1842
1843   | otherwise
1844   = emptyDetails
1845
1846 markMany, markInsideLam, markInsideSCC :: OccInfo -> OccInfo
1847
1848 markMany _  = NoOccInfo
1849
1850 markInsideSCC occ = markInsideLam occ
1851   -- inside an SCC, we can inline lambdas only.
1852
1853 markInsideLam (OneOcc _ one_br int_cxt) = OneOcc True one_br int_cxt
1854 markInsideLam occ                       = occ
1855
1856 addOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo
1857
1858 addOccInfo a1 a2  = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) )
1859                     NoOccInfo   -- Both branches are at least One
1860                                 -- (Argument is never IAmDead)
1861
1862 -- (orOccInfo orig new) is used
1863 -- when combining occurrence info from branches of a case
1864
1865 orOccInfo (OneOcc in_lam1 _ int_cxt1)
1866           (OneOcc in_lam2 _ int_cxt2)
1867   = OneOcc (in_lam1 || in_lam2)
1868            False        -- False, because it occurs in both branches
1869            (int_cxt1 && int_cxt2)
1870 orOccInfo a1 a2 = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) )
1871                   NoOccInfo
1872 \end{code}