X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fprofiling%2FCostCentre.lhs;h=aff29d810954ed950a81ef9cbccb0207348009e5;hb=7bb3d1fc79521d591cd9f824893963141a7997b6;hp=5ccdaf86e21fb474d6165f8ebf6b2a836d57aaab;hpb=9cc7aff02271366e6ebeb5fac52336d0723fe496;p=ghc-hetmet.git

diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs
index 5ccdaf8..aff29d8 100644
--- a/compiler/profiling/CostCentre.lhs
+++ b/compiler/profiling/CostCentre.lhs
@@ -36,11 +36,10 @@ module CostCentre (
 	cmpCostCentre	-- used for removing dups in a list
     ) where
 
-#include "HsVersions.h"
-
 import Var		( Id )
 import Name
 import Module		( Module )
+import Unique
 import Outputable	
 import FastTypes
 import FastString
@@ -228,12 +227,14 @@ mkAutoCC id mod is_caf
     }
   where 
         name = getName id
-        -- beware: we might be making an auto CC for a compiler-generated
-        -- thing (like a CAF when -caf-all is on), so include the uniq.
-        -- See bug #249, tests prof001, prof002
-        str | isSystemName name = mkFastString (showSDoc (ppr name))
-            | otherwise         = occNameFS (getOccName id)
-
+        -- beware: only external names are guaranteed to have unique
+        -- Occnames.  If the name is not external, we must append its
+        -- Unique.
+        -- See bug #249, tests prof001, prof002,  also #2411
+        str | isExternalName name = occNameFS (getOccName id)
+            | otherwise           = mkFastString $ showSDoc $
+                                      ftext (occNameFS (getOccName id))
+                                      <> char '_' <> pprUnique (getUnique name)
 mkAllCafsCC :: Module -> CostCentre
 mkAllCafsCC m = AllCafsCC  { cc_mod = m }
 
@@ -299,8 +300,8 @@ cmpCostCentre (NormalCC {cc_name = n1, cc_mod =  m1, cc_is_caf = c1})
 
 cmpCostCentre other_1 other_2
   = let
-	tag1 = tag_CC other_1
-	tag2 = tag_CC other_2
+	!tag1 = tag_CC other_1
+	!tag2 = tag_CC other_2
     in
     if tag1 <# tag2 then LT else GT
   where
@@ -333,15 +334,15 @@ non-constant C expression.
 
 \begin{code}
 instance Outputable CostCentreStack where
-  ppr NoCCS		= ptext SLIT("NO_CCS")
-  ppr CurrentCCS	= ptext SLIT("CCCS")
-  ppr OverheadCCS	= ptext SLIT("CCS_OVERHEAD")
-  ppr DontCareCCS	= ptext SLIT("CCS_DONT_CARE")
-  ppr SubsumedCCS	= ptext SLIT("CCS_SUBSUMED")
-  ppr (PushCC cc NoCCS) = ppr cc <> ptext SLIT("_ccs")
-  ppr (PushCC cc ccs)   = ptext SLIT("PushCostCentre") <> 
+  ppr NoCCS		= ptext (sLit "NO_CCS")
+  ppr CurrentCCS	= ptext (sLit "CCCS")
+  ppr OverheadCCS	= ptext (sLit "CCS_OVERHEAD")
+  ppr DontCareCCS	= ptext (sLit "CCS_DONT_CARE")
+  ppr SubsumedCCS	= ptext (sLit "CCS_SUBSUMED")
+  ppr (PushCC cc NoCCS) = ppr cc <> ptext (sLit "_ccs")
+  ppr (PushCC cc ccs)   = ptext (sLit "PushCostCentre") <> 
 			   parens (ppr ccs <> comma <> 
-			   parens(ptext SLIT("void *")) <> ppr cc)
+			   parens(ptext (sLit "void *")) <> ppr cc)
 \end{code}
 
 -----------------------------------------------------------------------------