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