diff options
| author | simonpj@microsoft.com <unknown> | 2009-09-11 11:56:30 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2009-09-11 11:56:30 +0000 |
| commit | e04195659aa59e83af80790c0179dd87e956a8b6 (patch) | |
| tree | 23a750b6eb136f917733ebea7f56135e60f0a91b /compiler/profiling | |
| parent | 7d73a107dcdc2ff5141751d8352207ee8415d1ec (diff) | |
| download | haskell-e04195659aa59e83af80790c0179dd87e956a8b6.tar.gz | |
Improve optimisation of cost centres
This patch fixes test failures for the profiling way for drv001.
The problem was that the arity of a function was decreasing during
"optimisation" because of interaction with SCC annotations.
In particular
f = /\a. scc "f" (h x) -- where h had arity 2
and h gets inlined, led to
f = /\a. scc "f" let v = scc "f" x in \y. <blah>
Two main changes:
1. exprIsTrivial now says True for (scc "f" x)
See Note [SCCs are trivial] in CoreUtils
2. The simplifier eliminates nested pushing of the same cost centre:
scc "f" (...(scc "f" e)...)
==> scc "f" (...e...)
Diffstat (limited to 'compiler/profiling')
| -rw-r--r-- | compiler/profiling/CostCentre.lhs | 9 |
1 files changed, 8 insertions, 1 deletions
diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs index aff29d8109..444b8be112 100644 --- a/compiler/profiling/CostCentre.lhs +++ b/compiler/profiling/CostCentre.lhs @@ -21,7 +21,7 @@ module CostCentre ( noCostCentre, noCCAttached, noCCSAttached, isCurrentCCS, isSubsumedCCS, currentOrSubsumedCCS, isDerivedFromCurrentCCS, maybeSingletonCCS, - decomposeCCS, + decomposeCCS, pushCCisNop, mkUserCC, mkAutoCC, mkAllCafsCC, mkSingletonCCS, dupifyCC, pushCCOnCCS, @@ -209,6 +209,13 @@ currentOrSubsumedCCS _ = False maybeSingletonCCS :: CostCentreStack -> Maybe CostCentre maybeSingletonCCS (PushCC cc NoCCS) = Just cc maybeSingletonCCS _ = Nothing + +pushCCisNop :: CostCentre -> CostCentreStack -> Bool +-- (pushCCisNop cc ccs) = True => pushing cc on ccs is a no-op +-- It's safe to return False, but the optimiser can remove +-- redundant pushes if this function returns True. +pushCCisNop cc (PushCC cc' _) = cc == cc' +pushCCisNop _ _ = False \end{code} Building cost centres |