Call Arity : Note about 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 [Information about boring variables]
308 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
309
310 If we decide that the variable bound in `let x = e1 in e2` is not interesting,
311 the analysis of `e2` will not report anything about `x`. To ensure that
312 `callArityBind` does still do the right thing we have to extend the result from
313 `e2` with a safe approximation.
314
315 This is done using `fakeBoringCalls` and has the effect of analysing
316 x `seq` x `seq` e2
317 instead, i.e. with `both` the result from `e2` with the most conservative
318 result about the uninteresting value.
319
320 Note [Recursion and fixpointing]
321 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
322
323 For a mutually recursive let, we begin by
324 1. analysing the body, using the same incoming arity as for the whole expression.
325 2. Then we iterate, memoizing for each of the bound variables the last
326 analysis call, i.e. incoming arity, whether it is called once, and the CallArityRes.
327 3. We combine the analysis result from the body and the memoized results for
328 the arguments (if already present).
329 4. For each variable, we find out the incoming arity and whether it is called
330 once, based on the the current analysis result. If this differs from the
331 memoized results, we re-analyse the rhs and update the memoized table.
332 5. If nothing had to be reanalized, we are done.
333 Otherwise, repeat from step 3.
334
335 Note [Analysing top-level binds]
336 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
337
338 We can eta-expand top-level-binds if they are not exported, as we see all calls
339 to them. The plan is as follows: Treat the top-level binds as nested lets around
340 a body representing “all external calls”, which returns a pessimistic
341 CallArityRes (the co-call graph is the complete graph, all arityies 0).
342
343 -}
344
345 -- Main entry point
346
347 callArityAnalProgram :: DynFlags -> CoreProgram -> CoreProgram
348 callArityAnalProgram _dflags binds = binds'
349 where
350 (_, binds') = callArityTopLvl [] emptyVarSet binds
351
352 -- See Note [Analysing top-level-binds]
353 callArityTopLvl :: [Var] -> VarSet -> [CoreBind] -> (CallArityRes, [CoreBind])
354 callArityTopLvl exported _ []
355 = ( calledMultipleTimes $ (emptyUnVarGraph, mkVarEnv $ [(v, 0) | v <- exported])
356 , [] )
357 callArityTopLvl exported int1 (b:bs)
358 = (ae2, b':bs')
359 where
360 int2 = bindersOf b
361 exported' = filter isExportedId int2 ++ exported
362 int' = int1 `addInterestingBinds` b
363 (ae1, bs') = callArityTopLvl exported' int' bs
364 ae1' = fakeBoringCalls int' b ae1 -- See Note [Information about boring variables]
365 (ae2, b') = callArityBind ae1' int1 b
366
367
368 callArityRHS :: CoreExpr -> CoreExpr
369 callArityRHS = snd . callArityAnal 0 emptyVarSet
370
371 -- The main analysis function. See Note [Analysis type signature]
372 callArityAnal ::
373 Arity -> -- The arity this expression is called with
374 VarSet -> -- The set of interesting variables
375 CoreExpr -> -- The expression to analyse
376 (CallArityRes, CoreExpr)
377 -- How this expression uses its interesting variables
378 -- and the expression with IdInfo updated
379
380 -- The trivial base cases
381 callArityAnal _ _ e@(Lit _)
382 = (emptyArityRes, e)
383 callArityAnal _ _ e@(Type _)
384 = (emptyArityRes, e)
385 callArityAnal _ _ e@(Coercion _)
386 = (emptyArityRes, e)
387 -- The transparent cases
388 callArityAnal arity int (Tick t e)
389 = second (Tick t) $ callArityAnal arity int e
390 callArityAnal arity int (Cast e co)
391 = second (\e -> Cast e co) $ callArityAnal arity int e
392
393 -- The interesting case: Variables, Lambdas, Lets, Applications, Cases
394 callArityAnal arity int e@(Var v)
395 | v `elemVarSet` int
396 = (unitArityRes v arity, e)
397 | otherwise
398 = (emptyArityRes, e)
399
400 -- Non-value lambdas are ignored
401 callArityAnal arity int (Lam v e) | not (isId v)
402 = second (Lam v) $ callArityAnal arity (int `delVarSet` v) e
403
404 -- We have a lambda that may be called multiple times, so its free variables
405 -- can all be co-called.
406 callArityAnal 0 int (Lam v e)
407 = (ae', Lam v e')
408 where
409 (ae, e') = callArityAnal 0 (int `delVarSet` v) e
410 ae' = calledMultipleTimes ae
411 -- We have a lambda that we are calling. decrease arity.
412 callArityAnal arity int (Lam v e)
413 = (ae, Lam v e')
414 where
415 (ae, e') = callArityAnal (arity - 1) (int `delVarSet` v) e
416
417 -- Application. Increase arity for the called expresion, nothing to know about
418 -- the second
419 callArityAnal arity int (App e (Type t))
420 = second (\e -> App e (Type t)) $ callArityAnal arity int e
421 callArityAnal arity int (App e1 e2)
422 = (final_ae, App e1' e2')
423 where
424 (ae1, e1') = callArityAnal (arity + 1) int e1
425 (ae2, e2') = callArityAnal 0 int e2
426 -- See Note [Case and App: Which side to take?]
427 final_ae = ae1 `both` ae2
428
429 -- Case expression.
430 callArityAnal arity int (Case scrut bndr ty alts)
431 = -- pprTrace "callArityAnal:Case"
432 -- (vcat [ppr scrut, ppr final_ae])
433 (final_ae, Case scrut' bndr ty alts')
434 where
435 (alt_aes, alts') = unzip $ map go alts
436 go (dc, bndrs, e) = let (ae, e') = callArityAnal arity int e
437 in (ae, (dc, bndrs, e'))
438 alt_ae = lubRess alt_aes
439 (scrut_ae, scrut') = callArityAnal 0 int scrut
440 -- See Note [Case and App: Which side to take?]
441 final_ae = scrut_ae `both` alt_ae
442
443 -- For lets, use callArityBind
444 callArityAnal arity int (Let bind e)
445 = -- pprTrace "callArityAnal:Let"
446 -- (vcat [ppr v, ppr arity, ppr n, ppr final_ae ])
447 (final_ae, Let bind' e')
448 where
449 int_body = int `addInterestingBinds` bind
450 (ae_body, e') = callArityAnal arity int_body e
451 ae_body' = fakeBoringCalls int_body bind ae_body -- See Note [Information about boring variables]
452 (final_ae, bind') = callArityBind ae_body' int bind
453
454 -- This is a variant of callArityAnal that is additionally told whether
455 -- the expression is called once or multiple times, and treats thunks appropriately.
456 -- It also returns the actual arity that can be used for this expression.
457 callArityBound :: Bool -> Arity -> VarSet -> CoreExpr -> (CallArityRes, Arity, CoreExpr)
458 callArityBound called_once arity int e
459 = -- pprTrace "callArityBound" (vcat [ppr (called_once, arity), ppr is_thunk, ppr safe_arity]) $
460 (final_ae, safe_arity, e')
461 where
462 is_thunk = not (exprIsHNF e)
463
464 safe_arity | called_once = arity
465 | is_thunk = 0 -- A thunk! Do not eta-expand
466 | otherwise = arity
467
468 (ae, e') = callArityAnal safe_arity int e
469
470 final_ae | called_once = ae
471 | safe_arity == 0 = ae -- If it is not a function, its body is evaluated only once
472 | otherwise = calledMultipleTimes ae
473
474
475 -- Which bindings should we look at?
476 -- See Note [Which variables are interesting]
477 interestingBinds :: CoreBind -> [Var]
478 interestingBinds = filter go . bindersOf
479 where go v = 0 < length (typeArity (idType v))
480
481 addInterestingBinds :: VarSet -> CoreBind -> VarSet
482 addInterestingBinds int bind
483 = int `delVarSetList` bindersOf bind -- Possible shadowing
484 `extendVarSetList` interestingBinds bind
485
486 -- For every boring variable in the binder, add a safe approximation
487 -- See Note [Information about boring variables]
488 fakeBoringCalls :: VarSet -> CoreBind -> CallArityRes -> CallArityRes
489 fakeBoringCalls int bind res = boring `both` res
490 where
491 boring = calledMultipleTimes $
492 ( emptyUnVarGraph
493 , mkVarEnv [ (v, 0) | v <- bindersOf bind, not (v `elemVarSet` int)])
494
495
496 -- Used for both local and top-level binds
497 -- First argument is the demand from the body
498 callArityBind :: CallArityRes -> VarSet -> CoreBind -> (CallArityRes, CoreBind)
499 -- Non-recursive let
500 callArityBind ae_body int (NonRec v rhs)
501 | otherwise
502 = -- pprTrace "callArityBind:NonRec"
503 -- (vcat [ppr v, ppr ae_body, ppr int, ppr ae_rhs, ppr safe_arity])
504 (final_ae, NonRec v' rhs')
505 where
506 (arity, called_once) = lookupCallArityRes ae_body v
507 (ae_rhs, safe_arity, rhs') = callArityBound called_once arity int rhs
508 final_ae = callArityNonRecEnv v ae_rhs ae_body
509 v' = v `setIdCallArity` safe_arity
510
511 -- Recursive let. See Note [Recursion and fixpointing]
512 callArityBind ae_body int b@(Rec binds)
513 = -- pprTrace "callArityBind:Rec"
514 -- (vcat [ppr (Rec binds'), ppr ae_body, ppr int, ppr ae_rhs]) $
515 (final_ae, Rec binds')
516 where
517 int_body = int `addInterestingBinds` b
518 (ae_rhs, binds') = fix initial_binds
519 final_ae = bindersOf b `resDelList` ae_rhs
520
521 initial_binds = [(i,Nothing,e) | (i,e) <- binds]
522
523 fix :: [(Id, Maybe (Bool, Arity, CallArityRes), CoreExpr)] -> (CallArityRes, [(Id, CoreExpr)])
524 fix ann_binds
525 | -- pprTrace "callArityBind:fix" (vcat [ppr ann_binds, ppr any_change, ppr ae]) $
526 any_change
527 = fix ann_binds'
528 | otherwise
529 = (ae, map (\(i, _, e) -> (i, e)) ann_binds')
530 where
531 aes_old = [ (i,ae) | (i, Just (_,_,ae), _) <- ann_binds ]
532 ae = callArityRecEnv aes_old ae_body
533
534 rerun (i, mbLastRun, rhs)
535 | i `elemVarSet` int_body && not (i `elemUnVarSet` domRes ae)
536 -- No call to this yet, so do nothing
537 = (False, (i, Nothing, rhs))
538
539 | Just (old_called_once, old_arity, _) <- mbLastRun
540 , called_once == old_called_once
541 , new_arity == old_arity
542 -- No change, no need to re-analize
543 = (False, (i, mbLastRun, rhs))
544
545 | otherwise
546 -- We previously analized this with a different arity (or not at all)
547 = let (ae_rhs, safe_arity, rhs') = callArityBound called_once new_arity int_body rhs
548 in (True, (i `setIdCallArity` safe_arity, Just (called_once, new_arity, ae_rhs), rhs'))
549 where
550 (new_arity, called_once) = lookupCallArityRes ae i
551
552 (changes, ann_binds') = unzip $ map rerun ann_binds
553 any_change = or changes
554
555 -- Combining the results from body and rhs, non-recursive case
556 -- See Note [Analysis II: The Co-Called analysis]
557 callArityNonRecEnv :: Var -> CallArityRes -> CallArityRes -> CallArityRes
558 callArityNonRecEnv v ae_rhs ae_body
559 = addCrossCoCalls called_by_v called_with_v $ ae_rhs `lubRes` resDel v ae_body
560 where
561 called_by_v = domRes ae_rhs
562 called_with_v = calledWith ae_body v `delUnVarSet` v
563
564 -- Combining the results from body and rhs, (mutually) recursive case
565 -- See Note [Analysis II: The Co-Called analysis]
566 callArityRecEnv :: [(Var, CallArityRes)] -> CallArityRes -> CallArityRes
567 callArityRecEnv ae_rhss ae_body
568 = -- pprTrace "callArityRecEnv" (vcat [ppr ae_rhss, ppr ae_body, ppr ae_new])
569 ae_new
570 where
571 vars = map fst ae_rhss
572
573 ae_combined = lubRess (map snd ae_rhss) `lubRes` ae_body
574
575 cross_calls = unionUnVarGraphs $ map cross_call ae_rhss
576 cross_call (v, ae_rhs) = completeBipartiteGraph called_by_v called_with_v
577 where
578 is_thunk = idCallArity v == 0
579 -- What rhs are relevant as happening before (or after) calling v?
580 -- If v is a thunk, everything from all the _other_ variables
581 -- If v is not a thunk, everything can happen.
582 ae_before_v | is_thunk = lubRess (map snd $ filter ((/= v) . fst) ae_rhss) `lubRes` ae_body
583 | otherwise = ae_combined
584 -- What do we want to know from these?
585 -- Which calls can happen next to any recursive call.
586 called_with_v
587 = unionUnVarSets $ map (calledWith ae_before_v) vars
588 called_by_v = domRes ae_rhs
589
590 ae_new = first (cross_calls `unionUnVarGraph`) ae_combined
591
592 ---------------------------------------
593 -- Functions related to CallArityRes --
594 ---------------------------------------
595
596 -- Result type for the two analyses.
597 -- See Note [Analysis I: The arity analyis]
598 -- and Note [Analysis II: The Co-Called analysis]
599 type CallArityRes = (UnVarGraph, VarEnv Arity)
600
601 emptyArityRes :: CallArityRes
602 emptyArityRes = (emptyUnVarGraph, emptyVarEnv)
603
604 unitArityRes :: Var -> Arity -> CallArityRes
605 unitArityRes v arity = (emptyUnVarGraph, unitVarEnv v arity)
606
607 resDelList :: [Var] -> CallArityRes -> CallArityRes
608 resDelList vs ae = foldr resDel ae vs
609
610 resDel :: Var -> CallArityRes -> CallArityRes
611 resDel v (g, ae) = (g `delNode` v, ae `delVarEnv` v)
612
613 domRes :: CallArityRes -> UnVarSet
614 domRes (_, ae) = varEnvDom ae
615
616 -- In the result, find out the minimum arity and whether the variable is called
617 -- at most once.
618 lookupCallArityRes :: CallArityRes -> Var -> (Arity, Bool)
619 lookupCallArityRes (g, ae) v
620 = case lookupVarEnv ae v of
621 Just a -> (a, not (v `elemUnVarSet` (neighbors g v)))
622 Nothing -> (0, False)
623
624 calledWith :: CallArityRes -> Var -> UnVarSet
625 calledWith (g, _) v = neighbors g v
626
627 addCrossCoCalls :: UnVarSet -> UnVarSet -> CallArityRes -> CallArityRes
628 addCrossCoCalls set1 set2 = first (completeBipartiteGraph set1 set2 `unionUnVarGraph`)
629
630 -- Replaces the co-call graph by a complete graph (i.e. no information)
631 calledMultipleTimes :: CallArityRes -> CallArityRes
632 calledMultipleTimes res = first (const (completeGraph (domRes res))) res
633
634 -- Used for application and cases
635 both :: CallArityRes -> CallArityRes -> CallArityRes
636 both r1 r2 = addCrossCoCalls (domRes r1) (domRes r2) $ r1 `lubRes` r2
637
638 -- Used when combining results from alternative cases; take the minimum
639 lubRes :: CallArityRes -> CallArityRes -> CallArityRes
640 lubRes (g1, ae1) (g2, ae2) = (g1 `unionUnVarGraph` g2, ae1 `lubArityEnv` ae2)
641
642 lubArityEnv :: VarEnv Arity -> VarEnv Arity -> VarEnv Arity
643 lubArityEnv = plusVarEnv_C min
644
645 lubRess :: [CallArityRes] -> CallArityRes
646 lubRess = foldl lubRes emptyArityRes