(F)SLIT -> (f)sLit in CostCentre

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

diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs
index c1ef7e7..4d13f10 100644 (file)
--- a/compiler/profiling/CostCentre.lhs
+++ b/compiler/profiling/CostCentre.lhs
@@ -4,11 +4,11 @@
 \section[CostCentre]{The @CostCentre@ data type}
 
 \begin{code}
-{-# OPTIONS -w #-}
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
 -- 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/CodingStyle#Warnings
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
 module CostCentre (
@@ -36,8 +36,6 @@ module CostCentre (
        cmpCostCentre   -- used for removing dups in a list
     ) where
 
-#include "HsVersions.h"
-
 import Var             ( Id )
 import Name
 import Module          ( Module )
@@ -162,6 +160,7 @@ being moved across module boundaries.
 SIMON: Maybe later...
 
 \begin{code}
+noCCS, subsumedCCS, currentCCS, overheadCCS, dontCareCCS :: CostCentreStack
 
 noCCS                  = NoCCS
 subsumedCCS            = SubsumedCCS
@@ -169,35 +168,44 @@ currentCCS                = CurrentCCS
 overheadCCS            = OverheadCCS
 dontCareCCS            = DontCareCCS
 
+noCostCentre :: CostCentre
 noCostCentre           = NoCostCentre
 \end{code}
 
 Predicates on Cost-Centre Stacks
 
 \begin{code}
+noCCSAttached :: CostCentreStack -> Bool
 noCCSAttached NoCCS                    = True
 noCCSAttached _                                = False
 
+noCCAttached :: CostCentre -> Bool
 noCCAttached NoCostCentre              = True
 noCCAttached _                         = False
 
+isCurrentCCS :: CostCentreStack -> Bool
 isCurrentCCS CurrentCCS                        = True
 isCurrentCCS _                         = False
 
+isSubsumedCCS :: CostCentreStack -> Bool
 isSubsumedCCS SubsumedCCS              = True
 isSubsumedCCS _                                = False
 
+isCafCCS :: CostCentreStack -> Bool
 isCafCCS (PushCC cc NoCCS)             = isCafCC cc
 isCafCCS _                             = False
 
+isDerivedFromCurrentCCS :: CostCentreStack -> Bool
 isDerivedFromCurrentCCS CurrentCCS     = True
 isDerivedFromCurrentCCS (PushCC _ ccs) = isDerivedFromCurrentCCS ccs
 isDerivedFromCurrentCCS _              = False
 
+currentOrSubsumedCCS :: CostCentreStack -> Bool
 currentOrSubsumedCCS SubsumedCCS       = True
 currentOrSubsumedCCS CurrentCCS                = True
 currentOrSubsumedCCS _                 = False
 
+maybeSingletonCCS :: CostCentreStack -> Maybe CostCentre
 maybeSingletonCCS (PushCC cc NoCCS)    = Just cc
 maybeSingletonCCS _                    = Nothing
 \end{code}
@@ -224,6 +232,7 @@ mkAutoCC id mod is_caf
         str | isSystemName name = mkFastString (showSDoc (ppr name))
             | otherwise         = occNameFS (getOccName id)
 
+mkAllCafsCC :: Module -> CostCentre
 mkAllCafsCC m = AllCafsCC  { cc_mod = m }
 
 
@@ -234,6 +243,7 @@ mkSingletonCCS cc = pushCCOnCCS cc NoCCS
 pushCCOnCCS :: CostCentre -> CostCentreStack -> CostCentreStack
 pushCCOnCCS = PushCC
 
+dupifyCC :: CostCentre -> CostCentre
 dupifyCC cc = cc {cc_is_dupd = DupdCC}
 
 isCafCC, isDupdCC :: CostCentre -> Bool
@@ -292,9 +302,11 @@ 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)
 
+-- TODO: swap order of IsCafCC, add deriving Ord
+cmp_caf :: IsCafCC -> IsCafCC -> Ordering
 cmp_caf NotCafCC CafCC     = LT
 cmp_caf NotCafCC NotCafCC  = EQ
 cmp_caf CafCC    CafCC     = EQ
@@ -319,15 +331,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}
 
 -----------------------------------------------------------------------------
@@ -352,6 +364,7 @@ instance Outputable CostCentre where
           else text (costCentreUserName cc)
 
 -- Printing in an interface file or in Core generally
+pprCostCentreCore :: CostCentre -> SDoc
 pprCostCentreCore (AllCafsCC {cc_mod = m})
   = text "__sccC" <+> braces (ppr m)
 pprCostCentreCore (NormalCC {cc_name = n, cc_mod = m,
@@ -363,13 +376,16 @@ pprCostCentreCore (NormalCC {cc_name = n, cc_mod = m,
        pp_caf caf
     ])
 
+pp_dup :: IsDupdCC -> SDoc
 pp_dup DupdCC = char '!'
-pp_dup other   = empty
+pp_dup _      = empty
 
+pp_caf :: IsCafCC -> SDoc
 pp_caf CafCC = text "__C"
-pp_caf other   = empty
+pp_caf _     = empty
 
 -- Printing as a C label
+ppCostCentreLbl :: CostCentre -> SDoc
 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}) 
@@ -378,8 +394,9 @@ ppCostCentreLbl (NormalCC {cc_name = n, cc_mod = m, cc_is_caf = is_caf})
 
 -- This is the name to go in the user-displayed string, 
 -- recorded in the cost centre declaration
+costCentreUserName :: CostCentre -> String
 costCentreUserName (NoCostCentre)  = "NO_CC"
 costCentreUserName (AllCafsCC {})  = "CAF"
-costCentreUserName cc@(NormalCC {cc_name = name, cc_is_caf = is_caf})
+costCentreUserName (NormalCC {cc_name = name, cc_is_caf = is_caf})
   =  case is_caf of { CafCC -> "CAF:";   _ -> "" } ++ unpackFS name
 \end{code}