{-# LANGUAGE DeriveDataTypeable #-}
module GHC.Types.CostCentre (
        -- All abstract except to friend: ParseIface.y
        CostCentre(..), CcName, CCFlavour,
        mkCafFlavour, mkExprCCFlavour, mkDeclCCFlavour, mkHpcCCFlavour,
        mkLateCCFlavour, mkCallerCCFlavour,
        getAllCAFsCC,

        pprCostCentre,
        CostCentreStack,
        pprCostCentreStack,
        CollectedCCs, emptyCollectedCCs, collectCC,
        currentCCS, dontCareCCS,
        isCurrentCCS,
        maybeSingletonCCS,

        mkUserCC, mkAutoCC, mkAllCafsCC,
        mkSingletonCCS,
        isCafCCS, isCafCC, isSccCountCC, sccAbleCC, ccFromThisModule,

        pprCostCentreCore,
        costCentreUserName, costCentreUserNameFS,
        costCentreSrcSpan,

        cmpCostCentre   -- used for removing dups in a list
    ) where

import GHC.Prelude

import GHC.Utils.Binary
import GHC.Types.Var
import GHC.Types.Name
import GHC.Unit.Module
import GHC.Types.Unique
import GHC.Utils.Outputable
import GHC.Types.SrcLoc
import GHC.Data.FastString
import GHC.Types.CostCentre.State

import Data.Data

-----------------------------------------------------------------------------
-- Cost Centres

-- | A Cost Centre is a single @{-# SCC #-}@ annotation.

data CostCentre
  = NormalCC {
                CostCentre -> CCFlavour
cc_flavour  :: CCFlavour,
                 -- ^ Two cost centres may have the same name and
                 -- module but different SrcSpans, so we need a way to
                 -- distinguish them easily and give them different
                 -- object-code labels.  So every CostCentre has an
                 -- associated flavour that indicates how it was
                 -- generated, and flavours that allow multiple instances
                 -- of the same name and module have a deterministic 0-based
                 -- index.
                CostCentre -> CcName
cc_name :: CcName,      -- ^ Name of the cost centre itself
                CostCentre -> Module
cc_mod  :: Module,      -- ^ Name of module defining this CC.
                CostCentre -> SrcSpan
cc_loc  :: SrcSpan
    }

  | AllCafsCC {
                cc_mod  :: Module,      -- Name of module defining this CC.
                cc_loc  :: SrcSpan
    }
  deriving Typeable CostCentre
Typeable CostCentre =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CostCentre -> c CostCentre)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CostCentre)
-> (CostCentre -> Constr)
-> (CostCentre -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CostCentre))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CostCentre))
-> ((forall b. Data b => b -> b) -> CostCentre -> CostCentre)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CostCentre -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CostCentre -> r)
-> (forall u. (forall d. Data d => d -> u) -> CostCentre -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CostCentre -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CostCentre -> m CostCentre)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CostCentre -> m CostCentre)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CostCentre -> m CostCentre)
-> Data CostCentre
CostCentre -> Constr
CostCentre -> DataType
(forall b. Data b => b -> b) -> CostCentre -> CostCentre
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CostCentre -> u
forall u. (forall d. Data d => d -> u) -> CostCentre -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostCentre)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostCentre)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre
$ctoConstr :: CostCentre -> Constr
toConstr :: CostCentre -> Constr
$cdataTypeOf :: CostCentre -> DataType
dataTypeOf :: CostCentre -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostCentre)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostCentre)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostCentre)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostCentre)
$cgmapT :: (forall b. Data b => b -> b) -> CostCentre -> CostCentre
gmapT :: (forall b. Data b => b -> b) -> CostCentre -> CostCentre
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CostCentre -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CostCentre -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CostCentre -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CostCentre -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
Data

type CcName = FastString

data IndexedCCFlavour
    = ExprCC -- ^ Explicitly annotated expression
    | DeclCC -- ^ Explicitly annotated declaration
    | HpcCC -- ^ Generated by HPC for coverage
    | LateCC -- ^ Annotated by the one of the prof-last* passes.
    | CallerCC -- ^ Annotated by the one of the prof-last* passes.
    deriving (IndexedCCFlavour -> IndexedCCFlavour -> Bool
(IndexedCCFlavour -> IndexedCCFlavour -> Bool)
-> (IndexedCCFlavour -> IndexedCCFlavour -> Bool)
-> Eq IndexedCCFlavour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
== :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
$c/= :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
/= :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
Eq,Eq IndexedCCFlavour
Eq IndexedCCFlavour =>
(IndexedCCFlavour -> IndexedCCFlavour -> Ordering)
-> (IndexedCCFlavour -> IndexedCCFlavour -> Bool)
-> (IndexedCCFlavour -> IndexedCCFlavour -> Bool)
-> (IndexedCCFlavour -> IndexedCCFlavour -> Bool)
-> (IndexedCCFlavour -> IndexedCCFlavour -> Bool)
-> (IndexedCCFlavour -> IndexedCCFlavour -> IndexedCCFlavour)
-> (IndexedCCFlavour -> IndexedCCFlavour -> IndexedCCFlavour)
-> Ord IndexedCCFlavour
IndexedCCFlavour -> IndexedCCFlavour -> Bool
IndexedCCFlavour -> IndexedCCFlavour -> Ordering
IndexedCCFlavour -> IndexedCCFlavour -> IndexedCCFlavour
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IndexedCCFlavour -> IndexedCCFlavour -> Ordering
compare :: IndexedCCFlavour -> IndexedCCFlavour -> Ordering
$c< :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
< :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
$c<= :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
<= :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
$c> :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
> :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
$c>= :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
>= :: IndexedCCFlavour -> IndexedCCFlavour -> Bool
$cmax :: IndexedCCFlavour -> IndexedCCFlavour -> IndexedCCFlavour
max :: IndexedCCFlavour -> IndexedCCFlavour -> IndexedCCFlavour
$cmin :: IndexedCCFlavour -> IndexedCCFlavour -> IndexedCCFlavour
min :: IndexedCCFlavour -> IndexedCCFlavour -> IndexedCCFlavour
Ord,Typeable IndexedCCFlavour
Typeable IndexedCCFlavour =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IndexedCCFlavour -> c IndexedCCFlavour)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IndexedCCFlavour)
-> (IndexedCCFlavour -> Constr)
-> (IndexedCCFlavour -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IndexedCCFlavour))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c IndexedCCFlavour))
-> ((forall b. Data b => b -> b)
    -> IndexedCCFlavour -> IndexedCCFlavour)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IndexedCCFlavour -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IndexedCCFlavour -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> IndexedCCFlavour -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IndexedCCFlavour -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> IndexedCCFlavour -> m IndexedCCFlavour)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> IndexedCCFlavour -> m IndexedCCFlavour)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> IndexedCCFlavour -> m IndexedCCFlavour)
-> Data IndexedCCFlavour
IndexedCCFlavour -> Constr
IndexedCCFlavour -> DataType
(forall b. Data b => b -> b)
-> IndexedCCFlavour -> IndexedCCFlavour
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> IndexedCCFlavour -> u
forall u. (forall d. Data d => d -> u) -> IndexedCCFlavour -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IndexedCCFlavour -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IndexedCCFlavour -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> IndexedCCFlavour -> m IndexedCCFlavour
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IndexedCCFlavour -> m IndexedCCFlavour
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IndexedCCFlavour
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IndexedCCFlavour -> c IndexedCCFlavour
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IndexedCCFlavour)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IndexedCCFlavour)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IndexedCCFlavour -> c IndexedCCFlavour
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IndexedCCFlavour -> c IndexedCCFlavour
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IndexedCCFlavour
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IndexedCCFlavour
$ctoConstr :: IndexedCCFlavour -> Constr
toConstr :: IndexedCCFlavour -> Constr
$cdataTypeOf :: IndexedCCFlavour -> DataType
dataTypeOf :: IndexedCCFlavour -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IndexedCCFlavour)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IndexedCCFlavour)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IndexedCCFlavour)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IndexedCCFlavour)
$cgmapT :: (forall b. Data b => b -> b)
-> IndexedCCFlavour -> IndexedCCFlavour
gmapT :: (forall b. Data b => b -> b)
-> IndexedCCFlavour -> IndexedCCFlavour
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IndexedCCFlavour -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IndexedCCFlavour -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IndexedCCFlavour -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IndexedCCFlavour -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IndexedCCFlavour -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> IndexedCCFlavour -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> IndexedCCFlavour -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> IndexedCCFlavour -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> IndexedCCFlavour -> m IndexedCCFlavour
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> IndexedCCFlavour -> m IndexedCCFlavour
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IndexedCCFlavour -> m IndexedCCFlavour
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IndexedCCFlavour -> m IndexedCCFlavour
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IndexedCCFlavour -> m IndexedCCFlavour
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IndexedCCFlavour -> m IndexedCCFlavour
Data,Int -> IndexedCCFlavour
IndexedCCFlavour -> Int
IndexedCCFlavour -> [IndexedCCFlavour]
IndexedCCFlavour -> IndexedCCFlavour
IndexedCCFlavour -> IndexedCCFlavour -> [IndexedCCFlavour]
IndexedCCFlavour
-> IndexedCCFlavour -> IndexedCCFlavour -> [IndexedCCFlavour]
(IndexedCCFlavour -> IndexedCCFlavour)
-> (IndexedCCFlavour -> IndexedCCFlavour)
-> (Int -> IndexedCCFlavour)
-> (IndexedCCFlavour -> Int)
-> (IndexedCCFlavour -> [IndexedCCFlavour])
-> (IndexedCCFlavour -> IndexedCCFlavour -> [IndexedCCFlavour])
-> (IndexedCCFlavour -> IndexedCCFlavour -> [IndexedCCFlavour])
-> (IndexedCCFlavour
    -> IndexedCCFlavour -> IndexedCCFlavour -> [IndexedCCFlavour])
-> Enum IndexedCCFlavour
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: IndexedCCFlavour -> IndexedCCFlavour
succ :: IndexedCCFlavour -> IndexedCCFlavour
$cpred :: IndexedCCFlavour -> IndexedCCFlavour
pred :: IndexedCCFlavour -> IndexedCCFlavour
$ctoEnum :: Int -> IndexedCCFlavour
toEnum :: Int -> IndexedCCFlavour
$cfromEnum :: IndexedCCFlavour -> Int
fromEnum :: IndexedCCFlavour -> Int
$cenumFrom :: IndexedCCFlavour -> [IndexedCCFlavour]
enumFrom :: IndexedCCFlavour -> [IndexedCCFlavour]
$cenumFromThen :: IndexedCCFlavour -> IndexedCCFlavour -> [IndexedCCFlavour]
enumFromThen :: IndexedCCFlavour -> IndexedCCFlavour -> [IndexedCCFlavour]
$cenumFromTo :: IndexedCCFlavour -> IndexedCCFlavour -> [IndexedCCFlavour]
enumFromTo :: IndexedCCFlavour -> IndexedCCFlavour -> [IndexedCCFlavour]
$cenumFromThenTo :: IndexedCCFlavour
-> IndexedCCFlavour -> IndexedCCFlavour -> [IndexedCCFlavour]
enumFromThenTo :: IndexedCCFlavour
-> IndexedCCFlavour -> IndexedCCFlavour -> [IndexedCCFlavour]
Enum)
-- | The flavour of a cost centre.
--
-- Index fields represent 0-based indices giving source-code ordering of
-- centres with the same module, name, and flavour.
data CCFlavour = CafCC -- ^ Auto-generated top-level thunk, they all go into the same bucket
               | IndexedCC !IndexedCCFlavour !CostCentreIndex -- ^ Explicitly annotated expression
               deriving (CCFlavour -> CCFlavour -> Bool
(CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> Bool) -> Eq CCFlavour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CCFlavour -> CCFlavour -> Bool
== :: CCFlavour -> CCFlavour -> Bool
$c/= :: CCFlavour -> CCFlavour -> Bool
/= :: CCFlavour -> CCFlavour -> Bool
Eq, Eq CCFlavour
Eq CCFlavour =>
(CCFlavour -> CCFlavour -> Ordering)
-> (CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> CCFlavour)
-> (CCFlavour -> CCFlavour -> CCFlavour)
-> Ord CCFlavour
CCFlavour -> CCFlavour -> Bool
CCFlavour -> CCFlavour -> Ordering
CCFlavour -> CCFlavour -> CCFlavour
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CCFlavour -> CCFlavour -> Ordering
compare :: CCFlavour -> CCFlavour -> Ordering
$c< :: CCFlavour -> CCFlavour -> Bool
< :: CCFlavour -> CCFlavour -> Bool
$c<= :: CCFlavour -> CCFlavour -> Bool
<= :: CCFlavour -> CCFlavour -> Bool
$c> :: CCFlavour -> CCFlavour -> Bool
> :: CCFlavour -> CCFlavour -> Bool
$c>= :: CCFlavour -> CCFlavour -> Bool
>= :: CCFlavour -> CCFlavour -> Bool
$cmax :: CCFlavour -> CCFlavour -> CCFlavour
max :: CCFlavour -> CCFlavour -> CCFlavour
$cmin :: CCFlavour -> CCFlavour -> CCFlavour
min :: CCFlavour -> CCFlavour -> CCFlavour
Ord, Typeable CCFlavour
Typeable CCFlavour =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CCFlavour -> c CCFlavour)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CCFlavour)
-> (CCFlavour -> Constr)
-> (CCFlavour -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CCFlavour))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour))
-> ((forall b. Data b => b -> b) -> CCFlavour -> CCFlavour)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CCFlavour -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CCFlavour -> r)
-> (forall u. (forall d. Data d => d -> u) -> CCFlavour -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CCFlavour -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour)
-> Data CCFlavour
CCFlavour -> Constr
CCFlavour -> DataType
(forall b. Data b => b -> b) -> CCFlavour -> CCFlavour
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CCFlavour -> u
forall u. (forall d. Data d => d -> u) -> CCFlavour -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCFlavour)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour
$ctoConstr :: CCFlavour -> Constr
toConstr :: CCFlavour -> Constr
$cdataTypeOf :: CCFlavour -> DataType
dataTypeOf :: CCFlavour -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCFlavour)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCFlavour)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour)
$cgmapT :: (forall b. Data b => b -> b) -> CCFlavour -> CCFlavour
gmapT :: (forall b. Data b => b -> b) -> CCFlavour -> CCFlavour
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CCFlavour -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CCFlavour -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CCFlavour -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CCFlavour -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
Data)

-- Construct a CC flavour
mkCafFlavour :: CCFlavour
mkCafFlavour :: CCFlavour
mkCafFlavour = CCFlavour
CafCC
mkExprCCFlavour :: CostCentreIndex -> CCFlavour
mkExprCCFlavour :: CostCentreIndex -> CCFlavour
mkExprCCFlavour CostCentreIndex
idx = IndexedCCFlavour -> CostCentreIndex -> CCFlavour
IndexedCC IndexedCCFlavour
ExprCC CostCentreIndex
idx
mkDeclCCFlavour :: CostCentreIndex -> CCFlavour
mkDeclCCFlavour :: CostCentreIndex -> CCFlavour
mkDeclCCFlavour CostCentreIndex
idx = IndexedCCFlavour -> CostCentreIndex -> CCFlavour
IndexedCC IndexedCCFlavour
DeclCC CostCentreIndex
idx
mkHpcCCFlavour :: CostCentreIndex -> CCFlavour
mkHpcCCFlavour :: CostCentreIndex -> CCFlavour
mkHpcCCFlavour CostCentreIndex
idx = IndexedCCFlavour -> CostCentreIndex -> CCFlavour
IndexedCC IndexedCCFlavour
HpcCC CostCentreIndex
idx
mkLateCCFlavour :: CostCentreIndex -> CCFlavour
mkLateCCFlavour :: CostCentreIndex -> CCFlavour
mkLateCCFlavour CostCentreIndex
idx = IndexedCCFlavour -> CostCentreIndex -> CCFlavour
IndexedCC IndexedCCFlavour
LateCC CostCentreIndex
idx
mkCallerCCFlavour :: CostCentreIndex -> CCFlavour
mkCallerCCFlavour :: CostCentreIndex -> CCFlavour
mkCallerCCFlavour CostCentreIndex
idx = IndexedCCFlavour -> CostCentreIndex -> CCFlavour
IndexedCC IndexedCCFlavour
CallerCC CostCentreIndex
idx

-- | Extract the index from a flavour
flavourIndex :: CCFlavour -> Int
flavourIndex :: CCFlavour -> Int
flavourIndex CCFlavour
CafCC = Int
0
flavourIndex (IndexedCC IndexedCCFlavour
_flav CostCentreIndex
x) = CostCentreIndex -> Int
unCostCentreIndex CostCentreIndex
x

instance Eq CostCentre where
        CostCentre
c1 == :: CostCentre -> CostCentre -> Bool
== CostCentre
c2 = case CostCentre
c1 CostCentre -> CostCentre -> Ordering
`cmpCostCentre` CostCentre
c2 of { Ordering
EQ -> Bool
True; Ordering
_ -> Bool
False }

instance Ord CostCentre where
        compare :: CostCentre -> CostCentre -> Ordering
compare = CostCentre -> CostCentre -> Ordering
cmpCostCentre

cmpCostCentre :: CostCentre -> CostCentre -> Ordering

cmpCostCentre :: CostCentre -> CostCentre -> Ordering
cmpCostCentre (AllCafsCC  {cc_mod :: CostCentre -> Module
cc_mod = Module
m1}) (AllCafsCC  {cc_mod :: CostCentre -> Module
cc_mod = Module
m2})
  = Module
m1 Module -> Module -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Module
m2

cmpCostCentre NormalCC {cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
f1, cc_mod :: CostCentre -> Module
cc_mod =  Module
m1, cc_name :: CostCentre -> CcName
cc_name = CcName
n1}
              NormalCC {cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
f2, cc_mod :: CostCentre -> Module
cc_mod =  Module
m2, cc_name :: CostCentre -> CcName
cc_name = CcName
n2}
    -- first key is module name, then centre name, then flavour
  = [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat
      [ Module
m1 Module -> Module -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Module
m2
      , CcName
n1 CcName -> CcName -> Ordering
`lexicalCompareFS` CcName
n2 -- compare lexically to avoid non-determinism
      , CCFlavour
f1 CCFlavour -> CCFlavour -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CCFlavour
f2
      ]

cmpCostCentre CostCentre
other_1 CostCentre
other_2
  = let
        tag1 :: Int
tag1 = CostCentre -> Int
tag_CC CostCentre
other_1
        tag2 :: Int
tag2 = CostCentre -> Int
tag_CC CostCentre
other_2
    in
    if Int
tag1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
tag2 then Ordering
LT else Ordering
GT
  where
    tag_CC :: CostCentre -> Int
    tag_CC :: CostCentre -> Int
tag_CC (NormalCC   {}) = Int
0
    tag_CC (AllCafsCC  {}) = Int
1


-----------------------------------------------------------------------------
-- Predicates on CostCentre

isCafCC :: CostCentre -> Bool
isCafCC :: CostCentre -> Bool
isCafCC (AllCafsCC {})                  = Bool
True
isCafCC (NormalCC {cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
CafCC}) = Bool
True
isCafCC CostCentre
_                               = Bool
False

-- | Is this a cost-centre which records scc counts
isSccCountCC :: CostCentre -> Bool
isSccCountCC :: CostCentre -> Bool
isSccCountCC CostCentre
cc | CostCentre -> Bool
isCafCC CostCentre
cc  = Bool
False
                | Bool
otherwise   = Bool
True

-- | Is this a cost-centre which can be sccd ?
sccAbleCC :: CostCentre -> Bool
sccAbleCC :: CostCentre -> Bool
sccAbleCC CostCentre
cc | CostCentre -> Bool
isCafCC CostCentre
cc = Bool
False
             | Bool
otherwise  = Bool
True

ccFromThisModule :: CostCentre -> Module -> Bool
ccFromThisModule :: CostCentre -> Module -> Bool
ccFromThisModule CostCentre
cc Module
m = CostCentre -> Module
cc_mod CostCentre
cc Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
m


-----------------------------------------------------------------------------
-- Building cost centres

mkUserCC :: FastString -> Module -> SrcSpan -> CCFlavour -> CostCentre
mkUserCC :: CcName -> Module -> SrcSpan -> CCFlavour -> CostCentre
mkUserCC CcName
cc_name Module
mod SrcSpan
loc CCFlavour
flavour
  = NormalCC { cc_name :: CcName
cc_name = CcName
cc_name, cc_mod :: Module
cc_mod =  Module
mod, cc_loc :: SrcSpan
cc_loc = SrcSpan
loc,
               cc_flavour :: CCFlavour
cc_flavour = CCFlavour
flavour
    }

mkAutoCC :: Id -> Module -> CostCentre
mkAutoCC :: Id -> Module -> CostCentre
mkAutoCC Id
id Module
mod
  = NormalCC { cc_name :: CcName
cc_name = CcName
str, cc_mod :: Module
cc_mod =  Module
mod,
               cc_loc :: SrcSpan
cc_loc = Name -> SrcSpan
nameSrcSpan (Id -> Name
forall a. NamedThing a => a -> Name
getName Id
id),
               cc_flavour :: CCFlavour
cc_flavour = CCFlavour
CafCC
    }
  where
        name :: Name
name = Id -> Name
forall a. NamedThing a => a -> Name
getName Id
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 :: CcName
str | Name -> Bool
isExternalName Name
name = OccName -> CcName
occNameFS (Id -> OccName
forall a. NamedThing a => a -> OccName
getOccName Id
id)
            | Bool
otherwise           = [CcName] -> CcName
concatFS [OccName -> CcName
occNameFS (Id -> OccName
forall a. NamedThing a => a -> OccName
getOccName Id
id),
                                              String -> CcName
fsLit String
"_",
                                              String -> CcName
mkFastString (Unique -> String
forall a. Show a => a -> String
show (Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique Name
name))]
mkAllCafsCC :: Module -> SrcSpan -> CostCentre
mkAllCafsCC :: Module -> SrcSpan -> CostCentre
mkAllCafsCC Module
m SrcSpan
loc = AllCafsCC { cc_mod :: Module
cc_mod = Module
m, cc_loc :: SrcSpan
cc_loc = SrcSpan
loc }

-----------------------------------------------------------------------------
-- Cost Centre Stacks

-- | A Cost Centre Stack is something that can be attached to a closure.
-- This is either:
--
--      * the current cost centre stack (CCCS)
--      * a pre-defined cost centre stack (there are several
--        pre-defined CCSs, see below).

data CostCentreStack
  = CurrentCCS          -- Pinned on a let(rec)-bound
                        -- thunk/function/constructor, this says that the
                        -- cost centre to be attached to the object, when it
                        -- is allocated, is whatever is in the
                        -- current-cost-centre-stack register.

  | DontCareCCS         -- We need a CCS to stick in static closures
                        -- (for data), but we *don't* expect them to
                        -- accumulate any costs.  But we still need
                        -- the placeholder.  This CCS is it.

  | SingletonCCS CostCentre

  deriving (CostCentreStack -> CostCentreStack -> Bool
(CostCentreStack -> CostCentreStack -> Bool)
-> (CostCentreStack -> CostCentreStack -> Bool)
-> Eq CostCentreStack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CostCentreStack -> CostCentreStack -> Bool
== :: CostCentreStack -> CostCentreStack -> Bool
$c/= :: CostCentreStack -> CostCentreStack -> Bool
/= :: CostCentreStack -> CostCentreStack -> Bool
Eq, Eq CostCentreStack
Eq CostCentreStack =>
(CostCentreStack -> CostCentreStack -> Ordering)
-> (CostCentreStack -> CostCentreStack -> Bool)
-> (CostCentreStack -> CostCentreStack -> Bool)
-> (CostCentreStack -> CostCentreStack -> Bool)
-> (CostCentreStack -> CostCentreStack -> Bool)
-> (CostCentreStack -> CostCentreStack -> CostCentreStack)
-> (CostCentreStack -> CostCentreStack -> CostCentreStack)
-> Ord CostCentreStack
CostCentreStack -> CostCentreStack -> Bool
CostCentreStack -> CostCentreStack -> Ordering
CostCentreStack -> CostCentreStack -> CostCentreStack
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CostCentreStack -> CostCentreStack -> Ordering
compare :: CostCentreStack -> CostCentreStack -> Ordering
$c< :: CostCentreStack -> CostCentreStack -> Bool
< :: CostCentreStack -> CostCentreStack -> Bool
$c<= :: CostCentreStack -> CostCentreStack -> Bool
<= :: CostCentreStack -> CostCentreStack -> Bool
$c> :: CostCentreStack -> CostCentreStack -> Bool
> :: CostCentreStack -> CostCentreStack -> Bool
$c>= :: CostCentreStack -> CostCentreStack -> Bool
>= :: CostCentreStack -> CostCentreStack -> Bool
$cmax :: CostCentreStack -> CostCentreStack -> CostCentreStack
max :: CostCentreStack -> CostCentreStack -> CostCentreStack
$cmin :: CostCentreStack -> CostCentreStack -> CostCentreStack
min :: CostCentreStack -> CostCentreStack -> CostCentreStack
Ord)    -- needed for Ord on CLabel


-- 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
    , [CostCentreStack]  -- pre-defined "singleton" cost centre stacks
    )

emptyCollectedCCs :: CollectedCCs
emptyCollectedCCs :: CollectedCCs
emptyCollectedCCs = ([], [])

collectCC :: CostCentre -> CostCentreStack -> CollectedCCs -> CollectedCCs
collectCC :: CostCentre -> CostCentreStack -> CollectedCCs -> CollectedCCs
collectCC CostCentre
cc CostCentreStack
ccs ([CostCentre]
c, [CostCentreStack]
cs) = (CostCentre
cc CostCentre -> [CostCentre] -> [CostCentre]
forall a. a -> [a] -> [a]
: [CostCentre]
c, CostCentreStack
ccs CostCentreStack -> [CostCentreStack] -> [CostCentreStack]
forall a. a -> [a] -> [a]
: [CostCentreStack]
cs)

currentCCS, dontCareCCS :: CostCentreStack

currentCCS :: CostCentreStack
currentCCS              = CostCentreStack
CurrentCCS
dontCareCCS :: CostCentreStack
dontCareCCS             = CostCentreStack
DontCareCCS

-----------------------------------------------------------------------------
-- Predicates on Cost-Centre Stacks

isCurrentCCS :: CostCentreStack -> Bool
isCurrentCCS :: CostCentreStack -> Bool
isCurrentCCS CostCentreStack
CurrentCCS                 = Bool
True
isCurrentCCS CostCentreStack
_                          = Bool
False

isCafCCS :: CostCentreStack -> Bool
isCafCCS :: CostCentreStack -> Bool
isCafCCS (SingletonCCS CostCentre
cc)              = CostCentre -> Bool
isCafCC CostCentre
cc
isCafCCS CostCentreStack
_                              = Bool
False

maybeSingletonCCS :: CostCentreStack -> Maybe CostCentre
maybeSingletonCCS :: CostCentreStack -> Maybe CostCentre
maybeSingletonCCS (SingletonCCS CostCentre
cc)     = CostCentre -> Maybe CostCentre
forall a. a -> Maybe a
Just CostCentre
cc
maybeSingletonCCS CostCentreStack
_                     = Maybe CostCentre
forall a. Maybe a
Nothing

mkSingletonCCS :: CostCentre -> CostCentreStack
mkSingletonCCS :: CostCentre -> CostCentreStack
mkSingletonCCS CostCentre
cc = CostCentre -> CostCentreStack
SingletonCCS CostCentre
cc


-----------------------------------------------------------------------------
-- Printing Cost Centre Stacks.

-- The outputable instance for CostCentreStack prints the CCS as a C
-- expression.

instance Outputable CostCentreStack where
  ppr :: CostCentreStack -> SDoc
ppr = CostCentreStack -> SDoc
forall doc. IsLine doc => CostCentreStack -> doc
pprCostCentreStack

pprCostCentreStack :: IsLine doc => CostCentreStack -> doc
pprCostCentreStack :: forall doc. IsLine doc => CostCentreStack -> doc
pprCostCentreStack CostCentreStack
CurrentCCS        = String -> doc
forall doc. IsLine doc => String -> doc
text String
"CCCS"
pprCostCentreStack CostCentreStack
DontCareCCS       = String -> doc
forall doc. IsLine doc => String -> doc
text String
"CCS_DONT_CARE"
pprCostCentreStack (SingletonCCS CostCentre
cc) = CostCentre -> doc
forall doc. IsLine doc => CostCentre -> doc
pprCostCentre CostCentre
cc doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_ccs"
{-# SPECIALISE pprCostCentreStack :: CostCentreStack -> SDoc #-}
{-# SPECIALISE pprCostCentreStack :: CostCentreStack -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-----------------------------------------------------------------------------
-- Printing Cost Centres
--
-- There are several different ways in which we might want to print a
-- cost centre:
--
--      - the name of the cost centre, for profiling output (a C string)
--      - the label, i.e. C label for cost centre in .hc file.
--      - the debugging name, for output in -ddump things
--      - the interface name, for printing in _scc_ exprs in iface files.
--
-- The last 3 are derived from costCentreStr below.  The first is given
-- by costCentreName.

instance Outputable CostCentre where
  ppr :: CostCentre -> SDoc
ppr = CostCentre -> SDoc
forall doc. IsLine doc => CostCentre -> doc
pprCostCentre

pprCostCentre :: IsLine doc => CostCentre -> doc
pprCostCentre :: forall doc. IsLine doc => CostCentre -> doc
pprCostCentre CostCentre
cc = doc -> (PprStyle -> SDoc) -> doc
forall doc. IsOutput doc => doc -> (PprStyle -> SDoc) -> doc
docWithStyle (CostCentre -> doc
forall doc. IsLine doc => CostCentre -> doc
ppCostCentreLbl CostCentre
cc)
                                (\PprStyle
_ -> CcName -> SDoc
forall doc. IsLine doc => CcName -> doc
ftext (CostCentre -> CcName
costCentreUserNameFS CostCentre
cc))
{-# SPECIALISE pprCostCentre :: CostCentre -> SDoc #-}
{-# SPECIALISE pprCostCentre :: CostCentre -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- Printing in Core
pprCostCentreCore :: CostCentre -> SDoc
pprCostCentreCore :: CostCentre -> SDoc
pprCostCentreCore (AllCafsCC {cc_mod :: CostCentre -> Module
cc_mod = Module
m})
  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__sccC" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m)
pprCostCentreCore (NormalCC {cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
flavour, cc_name :: CostCentre -> CcName
cc_name = CcName
n,
                             cc_mod :: CostCentre -> Module
cc_mod = Module
m, cc_loc :: CostCentre -> SrcSpan
cc_loc = SrcSpan
loc})
  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__scc" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [
        Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'.' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CcName -> SDoc
forall doc. IsLine doc => CcName -> doc
ftext CcName
n,
        CCFlavour -> SDoc
pprFlavourCore CCFlavour
flavour,
        SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
loc)
    ])

-- ^ Print a flavour in Core
pprFlavourCore :: CCFlavour -> SDoc
pprFlavourCore :: CCFlavour -> SDoc
pprFlavourCore CCFlavour
CafCC = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__C"
pprFlavourCore CCFlavour
f     = Int -> SDoc
pprIdxCore (Int -> SDoc) -> Int -> SDoc
forall a b. (a -> b) -> a -> b
$ CCFlavour -> Int
flavourIndex CCFlavour
f

-- ^ Print a flavour's index in Core
pprIdxCore :: Int -> SDoc
pprIdxCore :: Int -> SDoc
pprIdxCore Int
0 = SDoc
forall doc. IsOutput doc => doc
empty
pprIdxCore Int
idx = SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
idx

-- Printing as a C label
ppCostCentreLbl :: IsLine doc => CostCentre -> doc
ppCostCentreLbl :: forall doc. IsLine doc => CostCentre -> doc
ppCostCentreLbl (AllCafsCC  {cc_mod :: CostCentre -> Module
cc_mod = Module
m}) = Module -> doc
forall doc. IsLine doc => Module -> doc
pprModule Module
m doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_CAFs_cc"
ppCostCentreLbl (NormalCC {cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
f, cc_name :: CostCentre -> CcName
cc_name = CcName
n, cc_mod :: CostCentre -> Module
cc_mod = Module
m})
  = Module -> doc
forall doc. IsLine doc => Module -> doc
pprModule Module
m doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'_' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> FastZString -> doc
forall doc. IsLine doc => FastZString -> doc
ztext (CcName -> FastZString
zEncodeFS CcName
n) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'_' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<>
        CCFlavour -> doc
forall doc. IsLine doc => CCFlavour -> doc
ppFlavourLblComponent CCFlavour
f doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_cc"
{-# SPECIALISE ppCostCentreLbl :: CostCentre -> SDoc #-}
{-# SPECIALISE ppCostCentreLbl :: CostCentre -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- ^ Print the flavour component of a C label
ppFlavourLblComponent :: IsLine doc => CCFlavour -> doc
ppFlavourLblComponent :: forall doc. IsLine doc => CCFlavour -> doc
ppFlavourLblComponent CCFlavour
CafCC = String -> doc
forall doc. IsLine doc => String -> doc
text String
"CAF"
ppFlavourLblComponent (IndexedCC IndexedCCFlavour
flav CostCentreIndex
i) =
  case IndexedCCFlavour
flav of
    IndexedCCFlavour
ExprCC -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"EXPR" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> CostCentreIndex -> doc
forall doc. IsLine doc => CostCentreIndex -> doc
ppIdxLblComponent CostCentreIndex
i
    IndexedCCFlavour
DeclCC -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"DECL" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> CostCentreIndex -> doc
forall doc. IsLine doc => CostCentreIndex -> doc
ppIdxLblComponent CostCentreIndex
i
    IndexedCCFlavour
HpcCC -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"HPC" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> CostCentreIndex -> doc
forall doc. IsLine doc => CostCentreIndex -> doc
ppIdxLblComponent CostCentreIndex
i
    IndexedCCFlavour
LateCC -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"LATECC" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> CostCentreIndex -> doc
forall doc. IsLine doc => CostCentreIndex -> doc
ppIdxLblComponent CostCentreIndex
i
    IndexedCCFlavour
CallerCC -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"CALLERCC" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> CostCentreIndex -> doc
forall doc. IsLine doc => CostCentreIndex -> doc
ppIdxLblComponent CostCentreIndex
i
{-# SPECIALISE ppFlavourLblComponent :: CCFlavour -> SDoc #-}
{-# SPECIALISE ppFlavourLblComponent :: CCFlavour -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- ^ Print the flavour index component of a C label
ppIdxLblComponent :: IsLine doc => CostCentreIndex -> doc
ppIdxLblComponent :: forall doc. IsLine doc => CostCentreIndex -> doc
ppIdxLblComponent CostCentreIndex
n =
  case CostCentreIndex -> Int
unCostCentreIndex CostCentreIndex
n of
    Int
0 -> doc
forall doc. IsOutput doc => doc
empty
    Int
n -> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
{-# SPECIALISE ppIdxLblComponent :: CostCentreIndex -> SDoc #-}
{-# SPECIALISE ppIdxLblComponent :: CostCentreIndex -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- This is the name to go in the user-displayed string,
-- recorded in the cost centre declaration
costCentreUserName :: CostCentre -> String
costCentreUserName :: CostCentre -> String
costCentreUserName = CcName -> String
unpackFS (CcName -> String)
-> (CostCentre -> CcName) -> CostCentre -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostCentre -> CcName
costCentreUserNameFS

costCentreUserNameFS :: CostCentre -> FastString
costCentreUserNameFS :: CostCentre -> CcName
costCentreUserNameFS (AllCafsCC {})  = String -> CcName
mkFastString String
"CAF"
costCentreUserNameFS (NormalCC {cc_name :: CostCentre -> CcName
cc_name = CcName
name, cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
is_caf})
  =  case CCFlavour
is_caf of
      CCFlavour
CafCC -> String -> CcName
mkFastString String
"CAF:" CcName -> CcName -> CcName
`appendFS` CcName
name
      CCFlavour
_     -> CcName
name

costCentreSrcSpan :: CostCentre -> SrcSpan
costCentreSrcSpan :: CostCentre -> SrcSpan
costCentreSrcSpan = CostCentre -> SrcSpan
cc_loc

instance Binary CCFlavour where
    put_ :: WriteBinHandle -> CCFlavour -> IO ()
put_ WriteBinHandle
bh CCFlavour
CafCC =
        WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    put_ WriteBinHandle
bh (IndexedCC IndexedCCFlavour
flav CostCentreIndex
i) = do
        WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
        let !flav_index :: Int
flav_index = IndexedCCFlavour -> Int
forall a. Enum a => a -> Int
fromEnum IndexedCCFlavour
flav
        WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
flav_index
        WriteBinHandle -> CostCentreIndex -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CostCentreIndex
i
    get :: ReadBinHandle -> IO CCFlavour
get ReadBinHandle
bh = do
            h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
            case h of
              Word8
0 -> CCFlavour -> IO CCFlavour
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CCFlavour
CafCC
              Word8
_ -> do
                IndexedCCFlavour -> CostCentreIndex -> CCFlavour
IndexedCC (IndexedCCFlavour -> CostCentreIndex -> CCFlavour)
-> IO IndexedCCFlavour -> IO (CostCentreIndex -> CCFlavour)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IndexedCCFlavour
forall a. Enum a => Int -> a
toEnum (Int -> IndexedCCFlavour) -> IO Int -> IO IndexedCCFlavour
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh) IO (CostCentreIndex -> CCFlavour)
-> IO CostCentreIndex -> IO CCFlavour
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO CostCentreIndex
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh

instance Binary CostCentre where
    put_ :: WriteBinHandle -> CostCentre -> IO ()
put_ WriteBinHandle
bh (NormalCC CCFlavour
aa CcName
ab Module
ac SrcSpan
_ad) = do
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
            WriteBinHandle -> CCFlavour -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CCFlavour
aa
            WriteBinHandle -> CcName -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CcName
ab
            WriteBinHandle -> Module -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Module
ac
    put_ WriteBinHandle
bh (AllCafsCC Module
ae SrcSpan
_af) = do
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
            WriteBinHandle -> Module -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Module
ae
    get :: ReadBinHandle -> IO CostCentre
get ReadBinHandle
bh = do
            h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
            case h of
              Word8
0 -> do aa <- ReadBinHandle -> IO CCFlavour
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      ab <- get bh
                      ac <- get bh
                      return (NormalCC aa ab ac noSrcSpan)
              Word8
_ -> do ae <- ReadBinHandle -> IO Module
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      return (AllCafsCC ae noSrcSpan)

    -- We ignore the SrcSpans in CostCentres when we serialise them,
    -- and set the SrcSpans to noSrcSpan when deserialising.  This is
    -- ok, because we only need the SrcSpan when declaring the
    -- CostCentre in the original module, it is not used by importing
    -- modules.

getAllCAFsCC :: Module -> (CostCentre, CostCentreStack)
getAllCAFsCC :: Module -> (CostCentre, CostCentreStack)
getAllCAFsCC Module
this_mod =
    let
      span :: SrcSpan
span = CcName -> SrcSpan
mkGeneralSrcSpan (String -> CcName
mkFastString String
"<entire-module>") -- XXX do better
      all_cafs_cc :: CostCentre
all_cafs_cc  = Module -> SrcSpan -> CostCentre
mkAllCafsCC Module
this_mod SrcSpan
span
      all_cafs_ccs :: CostCentreStack
all_cafs_ccs = CostCentre -> CostCentreStack
mkSingletonCCS CostCentre
all_cafs_cc
    in
      (CostCentre
all_cafs_cc, CostCentreStack
all_cafs_ccs)