Improve optimisation of cost centres

[ghc-hetmet.git] / compiler / profiling / CostCentre.lhs

diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs
index aff29d8..444b8be 100644 (file)
--- 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