{-# LANGUAGE DeriveDataTypeable #-}
module GHC.Types.CostCentre (
        CostCentre(..), CcName, CCFlavour(..),
                -- All abstract except to friend: ParseIface.y

        CostCentreStack,
        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.Utils.Misc
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
DataType
Constr
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 -> DataType
CostCentre -> Constr
(forall b. Data b => b -> b) -> CostCentre -> CostCentre
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cAllCafsCC :: Constr
$cNormalCC :: Constr
$tCostCentre :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
gmapQi :: Int -> (forall d. Data d => d -> u) -> CostCentre -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CostCentre -> u
gmapQ :: (forall d. Data d => d -> u) -> CostCentre -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CostCentre -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
gmapT :: (forall b. Data b => b -> b) -> CostCentre -> CostCentre
$cgmapT :: (forall b. Data b => b -> b) -> CostCentre -> CostCentre
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostCentre)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostCentre)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CostCentre)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostCentre)
dataTypeOf :: CostCentre -> DataType
$cdataTypeOf :: CostCentre -> DataType
toConstr :: CostCentre -> Constr
$ctoConstr :: CostCentre -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
External instance of the constraint type Data (GenUnit UnitId)
External instance of the constraint type Data (GenUnit UnitId)
External instance of the constraint type forall unit. Data unit => Data (GenModule unit)
External instance of the constraint type Data (GenUnit UnitId)
External instance of the constraint type Data SrcSpan
External instance of the constraint type Data CcName
External instance of the constraint type Data (GenUnit UnitId)
External instance of the constraint type forall unit. Data unit => Data (GenModule unit)
External instance of the constraint type forall unit. Data unit => Data (GenModule unit)
External instance of the constraint type Data (GenUnit UnitId)
External instance of the constraint type Data SrcSpan
External instance of the constraint type Data SrcSpan
Instance of class: Data of the constraint type Data CCFlavour
Data

type CcName = FastString

-- | 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
               | ExprCC !CostCentreIndex -- ^ Explicitly annotated expression
               | DeclCC !CostCentreIndex -- ^ Explicitly annotated declaration
               | HpcCC !CostCentreIndex -- ^ Generated by HPC for coverage
               deriving (CCFlavour -> CCFlavour -> Bool
(CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> Bool) -> Eq CCFlavour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CCFlavour -> CCFlavour -> Bool
$c/= :: CCFlavour -> CCFlavour -> Bool
== :: CCFlavour -> CCFlavour -> Bool
$c== :: CCFlavour -> CCFlavour -> Bool
External instance of the constraint type Eq CostCentreIndex
External instance of the constraint type Eq CostCentreIndex
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
min :: CCFlavour -> CCFlavour -> CCFlavour
$cmin :: CCFlavour -> CCFlavour -> CCFlavour
max :: CCFlavour -> CCFlavour -> CCFlavour
$cmax :: CCFlavour -> CCFlavour -> CCFlavour
>= :: CCFlavour -> CCFlavour -> Bool
$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
compare :: CCFlavour -> CCFlavour -> Ordering
$ccompare :: CCFlavour -> CCFlavour -> Ordering
External instance of the constraint type Ord CostCentreIndex
External instance of the constraint type Ord CostCentreIndex
Instance of class: Eq of the constraint type Eq CCFlavour
Instance of class: Eq of the constraint type Eq CCFlavour
Ord, Typeable CCFlavour
DataType
Constr
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 -> DataType
CCFlavour -> Constr
(forall b. Data b => b -> b) -> CCFlavour -> CCFlavour
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cHpcCC :: Constr
$cDeclCC :: Constr
$cExprCC :: Constr
$cCafCC :: Constr
$tCCFlavour :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
gmapQi :: Int -> (forall d. Data d => d -> u) -> CCFlavour -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CCFlavour -> u
gmapQ :: (forall d. Data d => d -> u) -> CCFlavour -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CCFlavour -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
gmapT :: (forall b. Data b => b -> b) -> CCFlavour -> CCFlavour
$cgmapT :: (forall b. Data b => b -> b) -> CCFlavour -> CCFlavour
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CCFlavour)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCFlavour)
dataTypeOf :: CCFlavour -> DataType
$cdataTypeOf :: CCFlavour -> DataType
toConstr :: CCFlavour -> Constr
$ctoConstr :: CCFlavour -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
External instance of the constraint type Data CostCentreIndex
External instance of the constraint type Data CostCentreIndex
External instance of the constraint type Data CostCentreIndex
Data)

-- | Extract the index from a flavour
flavourIndex :: CCFlavour -> Int
flavourIndex :: CCFlavour -> Int
flavourIndex CCFlavour
CafCC = Int
0
flavourIndex (ExprCC CostCentreIndex
x) = CostCentreIndex -> Int
unCostCentreIndex CostCentreIndex
x
flavourIndex (DeclCC CostCentreIndex
x) = CostCentreIndex -> Int
unCostCentreIndex CostCentreIndex
x
flavourIndex (HpcCC 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
External instance of the constraint type forall unit. Ord unit => Ord (GenModule unit)
External instance of the constraint type Ord (GenUnit UnitId)
`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
  = (Module
m1 Module -> Module -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type forall unit. Ord unit => Ord (GenModule unit)
External instance of the constraint type Ord (GenUnit UnitId)
`compare` Module
m2) Ordering -> Ordering -> Ordering
`thenCmp` (CcName
n1 CcName -> CcName -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord CcName
`compare` CcName
n2) Ordering -> Ordering -> Ordering
`thenCmp` (CCFlavour
f1 CCFlavour -> CCFlavour -> Ordering
forall a. Ord a => a -> a -> Ordering
Instance of class: Ord of the constraint type Ord CCFlavour
`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
External instance of the constraint type Ord Int
< 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
External instance of the constraint type forall unit. Eq unit => Eq (GenModule unit)
External instance of the constraint type Eq (GenUnit UnitId)
== 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 :: CCFlavour -> CcName -> Module -> SrcSpan -> CostCentre
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 :: CCFlavour -> CcName -> Module -> SrcSpan -> CostCentre
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
External instance of the constraint type NamedThing Id
getName Id
id),
               cc_flavour :: CCFlavour
cc_flavour = CCFlavour
CafCC
    }
  where
        name :: Name
name = Id -> Name
forall a. NamedThing a => a -> Name
External instance of the constraint type NamedThing Id
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
External instance of the constraint type NamedThing Id
getOccName Id
id)
            | Bool
otherwise           = OccName -> CcName
occNameFS (Id -> OccName
forall a. NamedThing a => a -> OccName
External instance of the constraint type NamedThing Id
getOccName Id
id)
                                    CcName -> CcName -> CcName
`appendFS`
                                    String -> CcName
mkFastString (Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: Unique -> String
forall a. Show a => a -> String
External instance of the constraint type Show Unique
show (Name -> Unique
forall a. Uniquable a => a -> Unique
External instance of the constraint type Uniquable Name
getUnique Name
name))
mkAllCafsCC :: Module -> SrcSpan -> CostCentre
mkAllCafsCC :: Module -> SrcSpan -> CostCentre
mkAllCafsCC Module
m SrcSpan
loc = AllCafsCC :: Module -> SrcSpan -> CostCentre
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
/= :: CostCentreStack -> CostCentreStack -> Bool
$c/= :: CostCentreStack -> CostCentreStack -> Bool
== :: CostCentreStack -> CostCentreStack -> Bool
$c== :: CostCentreStack -> CostCentreStack -> Bool
Instance of class: Eq of the constraint type Eq CostCentre
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
min :: CostCentreStack -> CostCentreStack -> CostCentreStack
$cmin :: CostCentreStack -> CostCentreStack -> CostCentreStack
max :: CostCentreStack -> CostCentreStack -> CostCentreStack
$cmax :: CostCentreStack -> CostCentreStack -> CostCentreStack
>= :: CostCentreStack -> CostCentreStack -> Bool
$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
compare :: CostCentreStack -> CostCentreStack -> Ordering
$ccompare :: CostCentreStack -> CostCentreStack -> Ordering
Instance of class: Eq of the constraint type Eq CostCentreStack
Instance of class: Ord of the constraint type Ord CostCentre
Instance of class: Ord of the constraint type Ord CostCentreStack
Instance of class: Eq of the constraint type Eq 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
CurrentCCS        = String -> SDoc
text String
"CCCS"
  ppr CostCentreStack
DontCareCCS       = String -> SDoc
text String
"CCS_DONT_CARE"
  ppr (SingletonCCS CostCentre
cc) = CostCentre -> SDoc
forall a. Outputable a => a -> SDoc
Instance of class: Outputable of the constraint type Outputable CostCentre
ppr CostCentre
cc SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_ccs"


-----------------------------------------------------------------------------
-- 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
cc = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ PprStyle
sty ->
           if PprStyle -> Bool
codeStyle PprStyle
sty
           then CostCentre -> SDoc
ppCostCentreLbl CostCentre
cc
           else String -> SDoc
text (CostCentre -> String
costCentreUserName CostCentre
cc)

-- Printing in Core
pprCostCentreCore :: CostCentre -> SDoc
pprCostCentreCore :: CostCentre -> SDoc
pprCostCentreCore (AllCafsCC {cc_mod :: CostCentre -> Module
cc_mod = Module
m})
  = String -> SDoc
text String
"__sccC" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
braces (Module -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Module
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
text String
"__scc" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
braces ([SDoc] -> SDoc
hsep [
        Module -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Module
ppr Module
m SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'.' SDoc -> SDoc -> SDoc
<> CcName -> SDoc
ftext CcName
n,
        CCFlavour -> SDoc
pprFlavourCore CCFlavour
flavour,
        SDoc -> SDoc
whenPprDebug (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable SrcSpan
ppr SrcSpan
loc)
    ])

-- ^ Print a flavour in Core
pprFlavourCore :: CCFlavour -> SDoc
pprFlavourCore :: CCFlavour -> SDoc
pprFlavourCore CCFlavour
CafCC = String -> SDoc
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
empty
pprIdxCore Int
idx = SDoc -> SDoc
whenPprDebug (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Int -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Int
ppr Int
idx

-- Printing as a C label
ppCostCentreLbl :: CostCentre -> SDoc
ppCostCentreLbl :: CostCentre -> SDoc
ppCostCentreLbl (AllCafsCC  {cc_mod :: CostCentre -> Module
cc_mod = Module
m}) = Module -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Module
ppr Module
m SDoc -> SDoc -> SDoc
<> String -> SDoc
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 -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Module
ppr Module
m SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'_' SDoc -> SDoc -> SDoc
<> FastZString -> SDoc
ztext (CcName -> FastZString
zEncodeFS CcName
n) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'_' SDoc -> SDoc -> SDoc
<>
        CCFlavour -> SDoc
ppFlavourLblComponent CCFlavour
f SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_cc"

-- ^ Print the flavour component of a C label
ppFlavourLblComponent :: CCFlavour -> SDoc
ppFlavourLblComponent :: CCFlavour -> SDoc
ppFlavourLblComponent CCFlavour
CafCC = String -> SDoc
text String
"CAF"
ppFlavourLblComponent (ExprCC CostCentreIndex
i) = String -> SDoc
text String
"EXPR" SDoc -> SDoc -> SDoc
<> CostCentreIndex -> SDoc
ppIdxLblComponent CostCentreIndex
i
ppFlavourLblComponent (DeclCC CostCentreIndex
i) = String -> SDoc
text String
"DECL" SDoc -> SDoc -> SDoc
<> CostCentreIndex -> SDoc
ppIdxLblComponent CostCentreIndex
i
ppFlavourLblComponent (HpcCC CostCentreIndex
i) = String -> SDoc
text String
"HPC" SDoc -> SDoc -> SDoc
<> CostCentreIndex -> SDoc
ppIdxLblComponent CostCentreIndex
i

-- ^ Print the flavour index component of a C label
ppIdxLblComponent :: CostCentreIndex -> SDoc
ppIdxLblComponent :: CostCentreIndex -> SDoc
ppIdxLblComponent CostCentreIndex
n =
  case CostCentreIndex -> Int
unCostCentreIndex CostCentreIndex
n of
    Int
0 -> SDoc
empty
    Int
n -> Int -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Int
ppr Int
n

-- 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_ :: BinHandle -> CCFlavour -> IO ()
put_ BinHandle
bh CCFlavour
CafCC = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh (ExprCC CostCentreIndex
i) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            BinHandle -> CostCentreIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary CostCentreIndex
put_ BinHandle
bh CostCentreIndex
i
    put_ BinHandle
bh (DeclCC CostCentreIndex
i) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
            BinHandle -> CostCentreIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary CostCentreIndex
put_ BinHandle
bh CostCentreIndex
i
    put_ BinHandle
bh (HpcCC CostCentreIndex
i) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
            BinHandle -> CostCentreIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary CostCentreIndex
put_ BinHandle
bh CostCentreIndex
i
    get :: BinHandle -> IO CCFlavour
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do CCFlavour -> IO CCFlavour
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return CCFlavour
CafCC
              Word8
1 -> CostCentreIndex -> CCFlavour
ExprCC (CostCentreIndex -> CCFlavour)
-> IO CostCentreIndex -> IO CCFlavour
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
<$> BinHandle -> IO CostCentreIndex
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary CostCentreIndex
get BinHandle
bh
              Word8
2 -> CostCentreIndex -> CCFlavour
DeclCC (CostCentreIndex -> CCFlavour)
-> IO CostCentreIndex -> IO CCFlavour
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
<$> BinHandle -> IO CostCentreIndex
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary CostCentreIndex
get BinHandle
bh
              Word8
_ -> CostCentreIndex -> CCFlavour
HpcCC (CostCentreIndex -> CCFlavour)
-> IO CostCentreIndex -> IO CCFlavour
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
<$> BinHandle -> IO CostCentreIndex
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary CostCentreIndex
get BinHandle
bh

instance Binary CostCentre where
    put_ :: BinHandle -> CostCentre -> IO ()
put_ BinHandle
bh (NormalCC CCFlavour
aa CcName
ab Module
ac SrcSpan
_ad) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            BinHandle -> CCFlavour -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Instance of class: Binary of the constraint type Binary CCFlavour
put_ BinHandle
bh CCFlavour
aa
            BinHandle -> CcName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary CcName
put_ BinHandle
bh CcName
ab
            BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type forall a. Binary a => Binary (GenModule a)
External instance of the constraint type Binary (GenUnit UnitId)
put_ BinHandle
bh Module
ac
    put_ BinHandle
bh (AllCafsCC Module
ae SrcSpan
_af) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type forall a. Binary a => Binary (GenModule a)
External instance of the constraint type Binary (GenUnit UnitId)
put_ BinHandle
bh Module
ae
    get :: BinHandle -> IO CostCentre
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do CCFlavour
aa <- BinHandle -> IO CCFlavour
forall a. Binary a => BinHandle -> IO a
Instance of class: Binary of the constraint type Binary CCFlavour
get BinHandle
bh
                      CcName
ab <- BinHandle -> IO CcName
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary CcName
get BinHandle
bh
                      Module
ac <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type forall a. Binary a => Binary (GenModule a)
External instance of the constraint type Binary (GenUnit UnitId)
get BinHandle
bh
                      CostCentre -> IO CostCentre
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (CCFlavour -> CcName -> Module -> SrcSpan -> CostCentre
NormalCC CCFlavour
aa CcName
ab Module
ac SrcSpan
noSrcSpan)
              Word8
_ -> do Module
ae <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type forall a. Binary a => Binary (GenModule a)
External instance of the constraint type Binary (GenUnit UnitId)
get BinHandle
bh
                      CostCentre -> IO CostCentre
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Module -> SrcSpan -> CostCentre
AllCafsCC Module
ae SrcSpan
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.