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