X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprofiling%2FCostCentre.lhs;fp=compiler%2Fprofiling%2FCostCentre.lhs;h=444b8be1127528de9ec1d54c41f0652e727102a4;hp=aff29d810954ed950a81ef9cbccb0207348009e5;hb=e04195659aa59e83af80790c0179dd87e956a8b6;hpb=7d73a107dcdc2ff5141751d8352207ee8415d1ec

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