Improve Call Arity performance
[ghc.git] / compiler / simplCore / CallArity.hs
1 --
2 -- Copyright (c) 2014 Joachim Breitner
3 --
4
5 module CallArity
6 ( callArityAnalProgram
7 , callArityRHS -- for testing
8 ) where
9
10 import VarSet
11 import VarEnv
12 import DynFlags ( DynFlags )
13
14 import BasicTypes
15 import CoreSyn
16 import Id
17 import CoreArity ( typeArity )
18 import CoreUtils ( exprIsHNF )
19 --import Outputable
20 import UnVarGraph
21 import Demand
22
23 import Control.Arrow ( first, second )
24
25
26 {-
27 %************************************************************************
28 %* *
29 Call Arity Analyis
30 %* *
31 %************************************************************************
32
33 Note [Call Arity: The goal]
34 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
35
36 The goal of this analysis is to find out if we can eta-expand a local function,
37 based on how it is being called. The motivating example is this code,
38 which comes up when we implement foldl using foldr, and do list fusion:
39
40 let go = \x -> let d = case ... of
41 False -> go (x+1)
42 True -> id
43 in \z -> d (x + z)
44 in go 1 0
45
46 If we do not eta-expand `go` to have arity 2, we are going to allocate a lot of
47 partial function applications, which would be bad.
48
49 The function `go` has a type of arity two, but only one lambda is manifest.
50 Furthermore, an analysis that only looks at the RHS of go cannot be sufficient
51 to eta-expand go: If `go` is ever called with one argument (and the result used
52 multiple times), we would be doing the work in `...` multiple times.
53
54 So `callArityAnalProgram` looks at the whole let expression to figure out if
55 all calls are nice, i.e. have a high enough arity. It then stores the result in
56 the `calledArity` field of the `IdInfo` of `go`, which the next simplifier
57 phase will eta-expand.
58
59 The specification of the `calledArity` field is:
60
61 No work will be lost if you eta-expand me to the arity in `calledArity`.
62
63 What we want to know for a variable
64 -----------------------------------
65
66 For every let-bound variable we'd like to know:
67 1. A lower bound on the arity of all calls to the variable, and
68 2. whether the variable is being called at most once or possible multiple
69 times.
70
71 It is always ok to lower the arity, or pretend that there are multiple calls.
72 In particular, "Minimum arity 0 and possible called multiple times" is always
73 correct.
74
75
76 What we want to know from an expression
77 ---------------------------------------
78
79 In order to obtain that information for variables, we analyize expression and
80 obtain bits of information:
81
82 I. The arity analysis:
83 For every variable, whether it is absent, or called,
84 and if called, which what arity.
85
86 II. The Co-Called analysis:
87 For every two variables, whether there is a possibility that both are being
88 called.
89 We obtain as a special case: For every variables, whether there is a
90 possibility that it is being called twice.
91
92 For efficiency reasons, we gather this information only for a set of
93 *interesting variables*, to avoid spending time on, e.g., variables from pattern matches.
94
95 The two analysis are not completely independent, as a higher arity can improve
96 the information about what variables are being called once or multiple times.
97
98 Note [Analysis I: The arity analyis]
99 ------------------------------------
100
101 The arity analysis is quite straight forward: The information about an
102 expression is an
103 VarEnv Arity
104 where absent variables are bound to Nothing and otherwise to a lower bound to
105 their arity.
106
107 When we analyize an expression, we analyize it with a given context arity.
108 Lambdas decrease and applications increase the incoming arity. Analysizing a
109 variable will put that arity in the environment. In lets or cases all the
110 results from the various subexpressions are lubed, which takes the point-wise
111 minimum (considering Nothing an infinity).
112
113
114 Note [Analysis II: The Co-Called analysis]
115 ------------------------------------------
116
117 The second part is more sophisticated. For reasons explained below, it is not
118 sufficient to simply know how often an expression evalutes a variable. Instead
119 we need to know which variables are possibly called together.
120
121 The data structure here is an undirected graph of variables, which is provided
122 by the abstract
123 UnVarGraph
124
125 It is safe to return a larger graph, i.e. one with more edges. The worst case
126 (i.e. the least useful and always correct result) is the complete graph on all
127 free variables, which means that anything can be called together with anything
128 (including itself).
129
130 Notation for the following:
131 C(e) is the co-called result for e.
132 G₁∪G₂ is the union of two graphs
133 fv is the set of free variables (conveniently the domain of the arity analysis result)
134 S₁×S₂ is the complete bipartite graph { {a,b} | a ∈ S₁, b ∈ S₂ }
135 S² is the complete graph on the set of variables S, S² = S×S
136 C'(e) is a variant for bound expression:
137 If e is called at most once, or it is and stays a thunk (after the analysis),
138 it is simply C(e). Otherwise, the expression can be called multiple times
139 and we return (fv e)²
140
141 The interesting cases of the analysis:
142 * Var v:
143 No other variables are being called.
144 Return {} (the empty graph)
145 * Lambda v e, under arity 0:
146 This means that e can be evaluated many times and we cannot get
147 any useful co-call information.
148 Return (fv e)²
149 * Case alternatives alt₁,alt₂,...:
150 Only one can be execuded, so
151 Return (alt₁ ∪ alt₂ ∪...)
152 * App e₁ e₂ (and analogously Case scrut alts):
153 We get the results from both sides. Additionally, anything called by e₁ can
154 possibly be called with anything from e₂.
155 Return: C(e₁) ∪ C(e₂) ∪ (fv e₁) × (fv e₂)
156 * Let v = rhs in body:
157 In addition to the results from the subexpressions, add all co-calls from
158 everything that the body calls together with v to everthing that is called
159 by v.
160 Return: C'(rhs) ∪ C(body) ∪ (fv rhs) × {v'| {v,v'} ∈ C(body)}
161 * Letrec v₁ = rhs₁ ... vₙ = rhsₙ in body
162 Tricky.
163 We assume that it is really mutually recursive, i.e. that every variable
164 calls one of the others, and that this is strongly connected (otherwise we
165 return an over-approximation, so that's ok), see note [Recursion and fixpointing].
166
167 Let V = {v₁,...vₙ}.
168 Assume that the vs have been analysed with an incoming demand and
169 cardinality consistent with the final result (this is the fixed-pointing).
170 Again we can use the results from all subexpressions.
171 In addition, for every variable vᵢ, we need to find out what it is called
172 with (call this set Sᵢ). There are two cases:
173 * If vᵢ is a function, we need to go through all right-hand-sides and bodies,
174 and collect every variable that is called together with any variable from V:
175 Sᵢ = {v' | j ∈ {1,...,n}, {v',vⱼ} ∈ C'(rhs₁) ∪ ... ∪ C'(rhsₙ) ∪ C(body) }
176 * If vᵢ is a thunk, then its rhs is evaluated only once, so we need to
177 exclude it from this set:
178 Sᵢ = {v' | j ∈ {1,...,n}, j≠i, {v',vⱼ} ∈ C'(rhs₁) ∪ ... ∪ C'(rhsₙ) ∪ C(body) }
179 Finally, combine all this:
180 Return: C(body) ∪
181 C'(rhs₁) ∪ ... ∪ C'(rhsₙ) ∪
182 (fv rhs₁) × S₁) ∪ ... ∪ (fv rhsₙ) × Sₙ)
183
184 Using the result: Eta-Expansion
185 -------------------------------
186
187 We use the result of these two analyses to decide whether we can eta-expand the
188 rhs of a let-bound variable.
189
190 If the variable is already a function (exprIsHNF), and all calls to the
191 variables have a higher arity than the current manifest arity (i.e. the number
192 of lambdas), expand.
193
194 If the variable is a thunk we must be careful: Eta-Expansion will prevent
195 sharing of work, so this is only safe if there is at most one call to the
196 function. Therefore, we check whether {v,v} ∈ G.
197
198 Example:
199
200 let n = case .. of .. -- A thunk!
201 in n 0 + n 1
202
203 vs.
204
205 let n = case .. of ..
206 in case .. of T -> n 0
207 F -> n 1
208
209 We are only allowed to eta-expand `n` if it is going to be called at most
210 once in the body of the outer let. So we need to know, for each variable
211 individually, that it is going to be called at most once.
212
213
214 Why the co-call graph?
215 ----------------------
216
217 Why is it not sufficient to simply remember which variables are called once and
218 which are called multiple times? It would be in the previous example, but consider
219
220 let n = case .. of ..
221 in case .. of
222 True -> let go = \y -> case .. of
223 True -> go (y + n 1)
224 False > n
225 in go 1
226 False -> n
227
228 vs.
229
230 let n = case .. of ..
231 in case .. of
232 True -> let go = \y -> case .. of
233 True -> go (y+1)
234 False > n
235 in go 1
236 False -> n
237
238 In both cases, the body and the rhs of the inner let call n at most once.
239 But only in the second case that holds for the whole expression! The
240 crucial difference is that in the first case, the rhs of `go` can call
241 *both* `go` and `n`, and hence can call `n` multiple times as it recurses,
242 while in the second case find out that `go` and `n` are not called together.
243
244
245 Why co-call information for functions?
246 --------------------------------------
247
248 Although for eta-expansion we need the information only for thunks, we still
249 need to know whether functions are being called once or multiple times, and
250 together with what other functions.
251
252 Example:
253
254 let n = case .. of ..
255 f x = n (x+1)
256 in f 1 + f 2
257
258 vs.
259
260 let n = case .. of ..
261 f x = n (x+1)
262 in case .. of T -> f 0
263 F -> f 1
264
265 Here, the body of f calls n exactly once, but f itself is being called
266 multiple times, so eta-expansion is not allowed.
267
268
269 Note [Analysis type signature]
270 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
271
272 The work-hourse of the analysis is the function `callArityAnal`, with the
273 following type:
274
275 type CallArityRes = (UnVarGraph, VarEnv Arity)
276 callArityAnal ::
277 Arity -> -- The arity this expression is called with
278 VarSet -> -- The set of interesting variables
279 CoreExpr -> -- The expression to analyse
280 (CallArityRes, CoreExpr)
281
282 and the following specification:
283
284 ((coCalls, callArityEnv), expr') = callArityEnv arity interestingIds expr
285
286 <=>
287
288 Assume the expression `expr` is being passed `arity` arguments. Then it holds that
289 * The domain of `callArityEnv` is a subset of `interestingIds`.
290 * Any variable from `interestingIds` that is not mentioned in the `callArityEnv`
291 is absent, i.e. not called at all.
292 * Every call from `expr` to a variable bound to n in `callArityEnv` has at
293 least n value arguments.
294 * For two interesting variables `v1` and `v2`, they are not adjacent in `coCalls`,
295 then in no execution of `expr` both are being called.
296 Furthermore, expr' is expr with the callArity field of the `IdInfo` updated.
297
298
299 Note [Which variables are interesting]
300 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
301
302 The analysis would quickly become prohibitive expensive if we would analyse all
303 variables; for most variables we simply do not care about how often they are
304 called, i.e. variables bound in a pattern match. So interesting are variables that are
305 * top-level or let bound
306 * and possibly functions (typeArity > 0)
307
308 Note [Taking boring variables into account]
309 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
310
311 If we decide that the variable bound in `let x = e1 in e2` is not interesting,
312 the analysis of `e2` will not report anything about `x`. To ensure that
313 `callArityBind` does still do the right thing we have to take that into account
314 everytime we would be lookup up `x` in the analysis result of `e2`.
315 * Instead of calling lookupCallArityRes, we return (0, True), indicating
316 that this variable might be called many times with no variables.
317 * Instead of checking `calledWith x`, we assume that everything can be called
318 with it.
319 * In the recursive case, when calclulating the `cross_calls`, if there is
320 any boring variable in the recursive group, we ignore all co-call-results
321 and directly go to a very conservative assumption.
322
323 The last point has the nice side effect that the relatively expensive
324 integration of co-call results in a recursive groups is often skipped. This
325 helped to avoid the compile time blowup in some real-world code with large
326 recursive groups (#10293).
327
328 Note [Recursion and fixpointing]
329 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
330
331 For a mutually recursive let, we begin by
332 1. analysing the body, using the same incoming arity as for the whole expression.
333 2. Then we iterate, memoizing for each of the bound variables the last
334 analysis call, i.e. incoming arity, whether it is called once, and the CallArityRes.
335 3. We combine the analysis result from the body and the memoized results for
336 the arguments (if already present).
337 4. For each variable, we find out the incoming arity and whether it is called
338 once, based on the the current analysis result. If this differs from the
339 memoized results, we re-analyse the rhs and update the memoized table.
340 5. If nothing had to be reanalized, we are done.
341 Otherwise, repeat from step 3.
342
343
344 Note [Thunks in recursive groups]
345 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
346
347 We never eta-expand a thunk in a recursive group, on the grounds that if it is
348 part of a recursive group, then it will be called multipe times.
349
350 This is not necessarily true, e.g. it would be safe to eta-expand t2 (but not
351 t1) in the follwing code:
352
353 let go x = t1
354 t1 = if ... then t2 else ...
355 t2 = if ... then go 1 else ...
356 in go 0
357
358 Detecting this would require finding out what variables are only ever called
359 from thunks. While this is certainly possible, we yet have to see this to be
360 relevant in the wild.
361
362
363 Note [Analysing top-level binds]
364 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
365
366 We can eta-expand top-level-binds if they are not exported, as we see all calls
367 to them. The plan is as follows: Treat the top-level binds as nested lets around
368 a body representing “all external calls”, which returns a pessimistic
369 CallArityRes (the co-call graph is the complete graph, all arityies 0).
370
371 Note [Trimming arity]
372 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
373
374 In the Call Arity papers, we are working on an untyped lambda calculus with no
375 other id annotations, where eta-expansion is always possible. But this is not
376 the case for Core!
377 1. We need to ensure the invariant
378 callArity e <= typeArity (exprType e)
379 for the same reasons that exprArity needs this invariant (see Note
380 [exprArity invariant] in CoreArity).
381
382 If we are not doing that, a too-high arity annotation will be stored with
383 the id, confusing the simplifier later on.
384
385 2. Eta-expanding a right hand side might invalidate existing annotations. In
386 particular, if an id has a strictness annotation of <...><...>b, then
387 passing two arguments to it will definitely bottom out, so the simplifier
388 will throw away additional parameters. This conflicts with Call Arity! So
389 we ensure that we never eta-expand such a value beyond the number of
390 arguments mentioned in the strictness signature.
391 See #10176 for a real-world-example.
392
393 -}
394
395 -- Main entry point
396
397 callArityAnalProgram :: DynFlags -> CoreProgram -> CoreProgram
398 callArityAnalProgram _dflags binds = binds'
399 where
400 (_, binds') = callArityTopLvl [] emptyVarSet binds
401
402 -- See Note [Analysing top-level-binds]
403 callArityTopLvl :: [Var] -> VarSet -> [CoreBind] -> (CallArityRes, [CoreBind])
404 callArityTopLvl exported _ []
405 = ( calledMultipleTimes $ (emptyUnVarGraph, mkVarEnv $ [(v, 0) | v <- exported])
406 , [] )
407 callArityTopLvl exported int1 (b:bs)
408 = (ae2, b':bs')
409 where
410 int2 = bindersOf b
411 exported' = filter isExportedId int2 ++ exported
412 int' = int1 `addInterestingBinds` b
413 (ae1, bs') = callArityTopLvl exported' int' bs
414 (ae2, b') = callArityBind (boringBinds b) ae1 int1 b
415
416
417 callArityRHS :: CoreExpr -> CoreExpr
418 callArityRHS = snd . callArityAnal 0 emptyVarSet
419
420 -- The main analysis function. See Note [Analysis type signature]
421 callArityAnal ::
422 Arity -> -- The arity this expression is called with
423 VarSet -> -- The set of interesting variables
424 CoreExpr -> -- The expression to analyse
425 (CallArityRes, CoreExpr)
426 -- How this expression uses its interesting variables
427 -- and the expression with IdInfo updated
428
429 -- The trivial base cases
430 callArityAnal _ _ e@(Lit _)
431 = (emptyArityRes, e)
432 callArityAnal _ _ e@(Type _)
433 = (emptyArityRes, e)
434 callArityAnal _ _ e@(Coercion _)
435 = (emptyArityRes, e)
436 -- The transparent cases
437 callArityAnal arity int (Tick t e)
438 = second (Tick t) $ callArityAnal arity int e
439 callArityAnal arity int (Cast e co)
440 = second (\e -> Cast e co) $ callArityAnal arity int e
441
442 -- The interesting case: Variables, Lambdas, Lets, Applications, Cases
443 callArityAnal arity int e@(Var v)
444 | v `elemVarSet` int
445 = (unitArityRes v arity, e)
446 | otherwise
447 = (emptyArityRes, e)
448
449 -- Non-value lambdas are ignored
450 callArityAnal arity int (Lam v e) | not (isId v)
451 = second (Lam v) $ callArityAnal arity (int `delVarSet` v) e
452
453 -- We have a lambda that may be called multiple times, so its free variables
454 -- can all be co-called.
455 callArityAnal 0 int (Lam v e)
456 = (ae', Lam v e')
457 where
458 (ae, e') = callArityAnal 0 (int `delVarSet` v) e
459 ae' = calledMultipleTimes ae
460 -- We have a lambda that we are calling. decrease arity.
461 callArityAnal arity int (Lam v e)
462 = (ae, Lam v e')
463 where
464 (ae, e') = callArityAnal (arity - 1) (int `delVarSet` v) e
465
466 -- Application. Increase arity for the called expresion, nothing to know about
467 -- the second
468 callArityAnal arity int (App e (Type t))
469 = second (\e -> App e (Type t)) $ callArityAnal arity int e
470 callArityAnal arity int (App e1 e2)
471 = (final_ae, App e1' e2')
472 where
473 (ae1, e1') = callArityAnal (arity + 1) int e1
474 (ae2, e2') = callArityAnal 0 int e2
475 final_ae = ae1 `both` ae2
476
477 -- Case expression.
478 callArityAnal arity int (Case scrut bndr ty alts)
479 = -- pprTrace "callArityAnal:Case"
480 -- (vcat [ppr scrut, ppr final_ae])
481 (final_ae, Case scrut' bndr ty alts')
482 where
483 (alt_aes, alts') = unzip $ map go alts
484 go (dc, bndrs, e) = let (ae, e') = callArityAnal arity int e
485 in (ae, (dc, bndrs, e'))
486 alt_ae = lubRess alt_aes
487 (scrut_ae, scrut') = callArityAnal 0 int scrut
488 final_ae = scrut_ae `both` alt_ae
489
490 -- For lets, use callArityBind
491 callArityAnal arity int (Let bind e)
492 = -- pprTrace "callArityAnal:Let"
493 -- (vcat [ppr v, ppr arity, ppr n, ppr final_ae ])
494 (final_ae, Let bind' e')
495 where
496 int_body = int `addInterestingBinds` bind
497 (ae_body, e') = callArityAnal arity int_body e
498 (final_ae, bind') = callArityBind (boringBinds bind) ae_body int bind
499
500 -- Which bindings should we look at?
501 -- See Note [Which variables are interesting]
502 isInteresting :: Var -> Bool
503 isInteresting v = 0 < length (typeArity (idType v))
504
505 interestingBinds :: CoreBind -> [Var]
506 interestingBinds = filter isInteresting . bindersOf
507
508 boringBinds :: CoreBind -> VarSet
509 boringBinds = mkVarSet . filter (not . isInteresting) . bindersOf
510
511 addInterestingBinds :: VarSet -> CoreBind -> VarSet
512 addInterestingBinds int bind
513 = int `delVarSetList` bindersOf bind -- Possible shadowing
514 `extendVarSetList` interestingBinds bind
515
516 -- Used for both local and top-level binds
517 -- Second argument is the demand from the body
518 callArityBind :: VarSet -> CallArityRes -> VarSet -> CoreBind -> (CallArityRes, CoreBind)
519 -- Non-recursive let
520 callArityBind boring_vars ae_body int (NonRec v rhs)
521 | otherwise
522 = -- pprTrace "callArityBind:NonRec"
523 -- (vcat [ppr v, ppr ae_body, ppr int, ppr ae_rhs, ppr safe_arity])
524 (final_ae, NonRec v' rhs')
525 where
526 is_thunk = not (exprIsHNF rhs)
527 -- If v is boring, we will not find it in ae_body, but always assume (0, False)
528 boring = v `elemVarSet` boring_vars
529
530 (arity, called_once)
531 | boring = (0, False) -- See Note [Taking boring variables into account]
532 | otherwise = lookupCallArityRes ae_body v
533 safe_arity | called_once = arity
534 | is_thunk = 0 -- A thunk! Do not eta-expand
535 | otherwise = arity
536
537 -- See Note [Trimming arity]
538 trimmed_arity = trimArity v safe_arity
539
540 (ae_rhs, rhs') = callArityAnal trimmed_arity int rhs
541
542
543 ae_rhs'| called_once = ae_rhs
544 | safe_arity == 0 = ae_rhs -- If it is not a function, its body is evaluated only once
545 | otherwise = calledMultipleTimes ae_rhs
546
547 called_by_v = domRes ae_rhs'
548 called_with_v
549 | boring = domRes ae_body
550 | otherwise = calledWith ae_body v `delUnVarSet` v
551 final_ae = addCrossCoCalls called_by_v called_with_v $ ae_rhs' `lubRes` resDel v ae_body
552
553 v' = v `setIdCallArity` trimmed_arity
554
555
556 -- Recursive let. See Note [Recursion and fixpointing]
557 callArityBind boring_vars ae_body int b@(Rec binds)
558 = -- (if length binds > 300 then
559 -- pprTrace "callArityBind:Rec"
560 -- (vcat [ppr (Rec binds'), ppr ae_body, ppr int, ppr ae_rhs]) else id) $
561 (final_ae, Rec binds')
562 where
563 -- See Note [Taking boring variables into account]
564 any_boring = any (`elemVarSet` boring_vars) [ i | (i, _) <- binds]
565
566 int_body = int `addInterestingBinds` b
567 (ae_rhs, binds') = fix initial_binds
568 final_ae = bindersOf b `resDelList` ae_rhs
569
570 initial_binds = [(i,Nothing,e) | (i,e) <- binds]
571
572 fix :: [(Id, Maybe (Bool, Arity, CallArityRes), CoreExpr)] -> (CallArityRes, [(Id, CoreExpr)])
573 fix ann_binds
574 | -- pprTrace "callArityBind:fix" (vcat [ppr ann_binds, ppr any_change, ppr ae]) $
575 any_change
576 = fix ann_binds'
577 | otherwise
578 = (ae, map (\(i, _, e) -> (i, e)) ann_binds')
579 where
580 aes_old = [ (i,ae) | (i, Just (_,_,ae), _) <- ann_binds ]
581 ae = callArityRecEnv any_boring aes_old ae_body
582
583 rerun (i, mbLastRun, rhs)
584 | i `elemVarSet` int_body && not (i `elemUnVarSet` domRes ae)
585 -- No call to this yet, so do nothing
586 = (False, (i, Nothing, rhs))
587
588 | Just (old_called_once, old_arity, _) <- mbLastRun
589 , called_once == old_called_once
590 , new_arity == old_arity
591 -- No change, no need to re-analize
592 = (False, (i, mbLastRun, rhs))
593
594 | otherwise
595 -- We previously analized this with a different arity (or not at all)
596 = let is_thunk = not (exprIsHNF rhs)
597
598 safe_arity | is_thunk = 0 -- See Note [Thunks in recursive groups]
599 | otherwise = new_arity
600
601 -- See Note [Trimming arity]
602 trimmed_arity = trimArity i safe_arity
603
604 (ae_rhs, rhs') = callArityAnal trimmed_arity int_body rhs
605
606 ae_rhs' | called_once = ae_rhs
607 | safe_arity == 0 = ae_rhs -- If it is not a function, its body is evaluated only once
608 | otherwise = calledMultipleTimes ae_rhs
609
610 in (True, (i `setIdCallArity` trimmed_arity, Just (called_once, new_arity, ae_rhs'), rhs'))
611 where
612 -- See Note [Taking boring variables into account]
613 (new_arity, called_once) | i `elemVarSet` boring_vars = (0, False)
614 | otherwise = lookupCallArityRes ae i
615
616 (changes, ann_binds') = unzip $ map rerun ann_binds
617 any_change = or changes
618
619 -- Combining the results from body and rhs, (mutually) recursive case
620 -- See Note [Analysis II: The Co-Called analysis]
621 callArityRecEnv :: Bool -> [(Var, CallArityRes)] -> CallArityRes -> CallArityRes
622 callArityRecEnv any_boring ae_rhss ae_body
623 = -- (if length ae_rhss > 300 then pprTrace "callArityRecEnv" (vcat [ppr ae_rhss, ppr ae_body, ppr ae_new]) else id) $
624 ae_new
625 where
626 vars = map fst ae_rhss
627
628 ae_combined = lubRess (map snd ae_rhss) `lubRes` ae_body
629
630 cross_calls
631 -- See Note [Taking boring variables into account]
632 | any_boring = completeGraph (domRes ae_combined)
633 | otherwise = unionUnVarGraphs $ map cross_call ae_rhss
634 cross_call (v, ae_rhs) = completeBipartiteGraph called_by_v called_with_v
635 where
636 is_thunk = idCallArity v == 0
637 -- What rhs are relevant as happening before (or after) calling v?
638 -- If v is a thunk, everything from all the _other_ variables
639 -- If v is not a thunk, everything can happen.
640 ae_before_v | is_thunk = lubRess (map snd $ filter ((/= v) . fst) ae_rhss) `lubRes` ae_body
641 | otherwise = ae_combined
642 -- What do we want to know from these?
643 -- Which calls can happen next to any recursive call.
644 called_with_v
645 = unionUnVarSets $ map (calledWith ae_before_v) vars
646 called_by_v = domRes ae_rhs
647
648 ae_new = first (cross_calls `unionUnVarGraph`) ae_combined
649
650 -- See Note [Trimming arity]
651 trimArity :: Id -> Arity -> Arity
652 trimArity v a = minimum [a, max_arity_by_type, max_arity_by_strsig]
653 where
654 max_arity_by_type = length (typeArity (idType v))
655 max_arity_by_strsig
656 | isBotRes result_info = length demands
657 | otherwise = a
658
659 (demands, result_info) = splitStrictSig (idStrictness v)
660
661 ---------------------------------------
662 -- Functions related to CallArityRes --
663 ---------------------------------------
664
665 -- Result type for the two analyses.
666 -- See Note [Analysis I: The arity analyis]
667 -- and Note [Analysis II: The Co-Called analysis]
668 type CallArityRes = (UnVarGraph, VarEnv Arity)
669
670 emptyArityRes :: CallArityRes
671 emptyArityRes = (emptyUnVarGraph, emptyVarEnv)
672
673 unitArityRes :: Var -> Arity -> CallArityRes
674 unitArityRes v arity = (emptyUnVarGraph, unitVarEnv v arity)
675
676 resDelList :: [Var] -> CallArityRes -> CallArityRes
677 resDelList vs ae = foldr resDel ae vs
678
679 resDel :: Var -> CallArityRes -> CallArityRes
680 resDel v (g, ae) = (g `delNode` v, ae `delVarEnv` v)
681
682 domRes :: CallArityRes -> UnVarSet
683 domRes (_, ae) = varEnvDom ae
684
685 -- In the result, find out the minimum arity and whether the variable is called
686 -- at most once.
687 lookupCallArityRes :: CallArityRes -> Var -> (Arity, Bool)
688 lookupCallArityRes (g, ae) v
689 = case lookupVarEnv ae v of
690 Just a -> (a, not (v `elemUnVarSet` (neighbors g v)))
691 Nothing -> (0, False)
692
693 calledWith :: CallArityRes -> Var -> UnVarSet
694 calledWith (g, _) v = neighbors g v
695
696 addCrossCoCalls :: UnVarSet -> UnVarSet -> CallArityRes -> CallArityRes
697 addCrossCoCalls set1 set2 = first (completeBipartiteGraph set1 set2 `unionUnVarGraph`)
698
699 -- Replaces the co-call graph by a complete graph (i.e. no information)
700 calledMultipleTimes :: CallArityRes -> CallArityRes
701 calledMultipleTimes res = first (const (completeGraph (domRes res))) res
702
703 -- Used for application and cases
704 both :: CallArityRes -> CallArityRes -> CallArityRes
705 both r1 r2 = addCrossCoCalls (domRes r1) (domRes r2) $ r1 `lubRes` r2
706
707 -- Used when combining results from alternative cases; take the minimum
708 lubRes :: CallArityRes -> CallArityRes -> CallArityRes
709 lubRes (g1, ae1) (g2, ae2) = (g1 `unionUnVarGraph` g2, ae1 `lubArityEnv` ae2)
710
711 lubArityEnv :: VarEnv Arity -> VarEnv Arity -> VarEnv Arity
712 lubArityEnv = plusVarEnv_C min
713
714 lubRess :: [CallArityRes] -> CallArityRes
715 lubRess = foldl lubRes emptyArityRes