X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fprofiling%2FCostCentre.lhs;h=b9014b2927c51c4d4b7c00ecfeaa827902a3d51c;hb=44a19648ed137d25fd66cc13796243000c367308;hp=56fde05608343d2f418d98061835b03840f77f7f;hpb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;p=ghc-hetmet.git diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs index 56fde05..b9014b2 100644 --- a/compiler/profiling/CostCentre.lhs +++ b/compiler/profiling/CostCentre.lhs @@ -4,6 +4,13 @@ \section[CostCentre]{The @CostCentre@ data type} \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module CostCentre ( CostCentre(..), CcName, IsDupdCC(..), IsCafCC(..), -- All abstract except to friend: ParseIface.y @@ -32,7 +39,7 @@ module CostCentre ( #include "HsVersions.h" import Var ( Id ) -import Name ( getOccName, occNameFS ) +import Name import Module ( Module ) import Outputable import FastTypes @@ -206,9 +213,16 @@ mkUserCC cc_name mod mkAutoCC :: Id -> Module -> IsCafCC -> CostCentre mkAutoCC id mod is_caf - = NormalCC { cc_name = occNameFS (getOccName id), cc_mod = mod, + = NormalCC { cc_name = str, cc_mod = mod, cc_is_dupd = OriginalCC, cc_is_caf = 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) mkAllCafsCC m = AllCafsCC { cc_mod = m } @@ -278,8 +292,8 @@ cmpCostCentre other_1 other_2 in if tag1 <# tag2 then LT else GT where - tag_CC (NormalCC {}) = (_ILIT 1 :: FastInt) - tag_CC (AllCafsCC {}) = _ILIT 2 + tag_CC (NormalCC {}) = _ILIT(1) + tag_CC (AllCafsCC {}) = _ILIT(2) cmp_caf NotCafCC CafCC = LT cmp_caf NotCafCC NotCafCC = EQ @@ -359,7 +373,7 @@ pp_caf other = empty ppCostCentreLbl (NoCostCentre) = text "NONE_cc" ppCostCentreLbl (AllCafsCC {cc_mod = m}) = ppr m <> text "_CAFs_cc" ppCostCentreLbl (NormalCC {cc_name = n, cc_mod = m, cc_is_caf = is_caf}) - = ppr m <> ftext (zEncodeFS n) <> + = ppr m <> char '_' <> ftext (zEncodeFS n) <> text (case is_caf of { CafCC -> "_CAF"; _ -> "" }) <> text "_cc" -- This is the name to go in the user-displayed string,