[project @ 2003-11-17 14:38:22 by simonmar]

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

diff --git a/ghc/compiler/profiling/CostCentre.lhs b/ghc/compiler/profiling/CostCentre.lhs
index 85c36be..ed40a5e 100644 (file)
--- a/ghc/compiler/profiling/CostCentre.lhs
+++ b/ghc/compiler/profiling/CostCentre.lhs
@@ -9,14 +9,15 @@ module CostCentre (
                -- All abstract except to friend: ParseIface.y
 
        CostCentreStack,
+       CollectedCCs,
        noCCS, subsumedCCS, currentCCS, overheadCCS, dontCareCCS,
-       noCostCentre, noCCAttached,
+       noCostCentre,
        noCCSAttached, isCurrentCCS,  isSubsumedCCS, currentOrSubsumedCCS,
        isDerivedFromCurrentCCS,
 
        mkUserCC, mkAutoCC, mkAllCafsCC, 
-       mkSingletonCCS, cafifyCC, dupifyCC, pushCCOnCCS,
-       isCafCC, isDupdCC, isEmptyCC, isCafCCS,
+       mkSingletonCCS, dupifyCC, pushCCOnCCS,
+       isCafCCS,
        isSccCountCostCentre,
        sccAbleCostCentre,
        ccFromThisModule,
@@ -38,6 +39,7 @@ import Module         ( Module, ModuleName, moduleName,
 import Outputable      
 import CStrings                ( pprStringInCStyle )
 import FastTypes
+import FastString
 import Util            ( thenCmp )
 \end{code}
 
@@ -138,6 +140,14 @@ data IsDupdCC
                        -- "dupd".
 
 data IsCafCC = CafCC | NotCafCC
+
+-- synonym for triple which describes the cost centre info in the generated
+-- code for a module.
+type CollectedCCs
+  = ( [CostCentre]       -- local cost-centres that need to be decl'd
+    , [CostCentre]       -- "extern" cost-centres
+    , [CostCentreStack]  -- pre-defined "singleton" cost centre stacks
+    )
 \end{code}
 
 WILL: Would there be any merit to recording ``I am now using a
@@ -210,15 +220,6 @@ mkSingletonCCS cc = pushCCOnCCS cc NoCCS
 pushCCOnCCS :: CostCentre -> CostCentreStack -> CostCentreStack
 pushCCOnCCS = PushCC
 
-cafifyCC, dupifyCC  :: CostCentre -> CostCentre
-cafifyCC cc@(NormalCC {cc_is_caf = is_caf})
-  = ASSERT(not_a_caf_already is_caf)
-    cc {cc_is_caf = CafCC}
-  where
-    not_a_caf_already CafCC = False
-    not_a_caf_already _       = True
-cafifyCC cc = pprPanic "cafifyCC" (ppr cc)
-
 dupifyCC cc = cc {cc_is_dupd = DupdCC}
 
 isEmptyCC, isCafCC, isDupdCC :: CostCentre -> Bool
@@ -352,7 +353,7 @@ pprCostCentreCore (AllCafsCC {cc_mod = m})
 pprCostCentreCore (NormalCC {cc_name = n, cc_mod = m,
                             cc_is_caf = caf, cc_is_dupd = dup})
   = text "__scc" <+> braces (hsep [
-       ptext n,
+       ftext n,
        ppr m,  
        pp_dup dup,
        pp_caf caf
@@ -369,7 +370,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 <> ptext n <> 
+  = ppr m <> ftext n <> 
        text (case is_caf of { CafCC -> "_CAF"; _ -> "" }) <> text "_cc"
 
 -- This is the name to go in the user-displayed string, 
@@ -377,7 +378,7 @@ ppCostCentreLbl (NormalCC {cc_name = n, cc_mod = m, cc_is_caf = is_caf})
 costCentreUserName (NoCostCentre)  = "NO_CC"
 costCentreUserName (AllCafsCC {})  = "CAF"
 costCentreUserName cc@(NormalCC {cc_name = name, cc_is_caf = is_caf})
-  =  case is_caf of { CafCC -> "CAF:";   _ -> "" } ++ decode (_UNPK_ name)
+  =  case is_caf of { CafCC -> "CAF:";   _ -> "" } ++ decode (unpackFS name)
 \end{code}
 
 Cost Centre Declarations
@@ -394,7 +395,7 @@ pprCostCentreDecl is_local cc
            cc_ident,                                                   comma,
            pprStringInCStyle (costCentreUserName cc),                  comma,
            pprStringInCStyle (moduleNameUserString mod_name),          comma,
-           ptext is_subsumed,                                          comma,
+           is_subsumed,                                                comma,
            empty,      -- Now always externally visible
            text ");"]
     else
@@ -404,7 +405,7 @@ pprCostCentreDecl is_local cc
     mod_name   = cc_mod cc
     is_subsumed = ccSubsumed cc
 
-ccSubsumed :: CostCentre -> FAST_STRING                -- subsumed value
-ccSubsumed cc | isCafCC  cc = SLIT("CC_IS_CAF")
-             | otherwise   = SLIT("CC_IS_BORING")
+ccSubsumed :: CostCentre -> SDoc               -- subsumed value
+ccSubsumed cc | isCafCC  cc = ptext SLIT("CC_IS_CAF")
+             | otherwise   = ptext SLIT("CC_IS_BORING")
 \end{code}