summaryrefslogtreecommitdiff
path: root/compiler/profiling/CostCentreState.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/profiling/CostCentreState.hs')
-rw-r--r--compiler/profiling/CostCentreState.hs36
1 files changed, 36 insertions, 0 deletions
diff --git a/compiler/profiling/CostCentreState.hs b/compiler/profiling/CostCentreState.hs
new file mode 100644
index 0000000000..0050c1d033
--- /dev/null
+++ b/compiler/profiling/CostCentreState.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module CostCentreState ( CostCentreState, newCostCentreState
+ , CostCentreIndex, unCostCentreIndex, getCCIndex
+ ) where
+
+import GhcPrelude
+import FastString
+import FastStringEnv
+
+import Data.Data
+import Binary
+
+-- | Per-module state for tracking cost centre indices.
+--
+-- See documentation of 'CostCentre.cc_flavour' for more details.
+newtype CostCentreState = CostCentreState (FastStringEnv Int)
+
+-- | Initialize cost centre state.
+newCostCentreState :: CostCentreState
+newCostCentreState = CostCentreState emptyFsEnv
+
+-- | An index into a given cost centre module,name,flavour set
+newtype CostCentreIndex = CostCentreIndex { unCostCentreIndex :: Int }
+ deriving (Eq, Ord, Data, Binary)
+
+-- | Get a new index for a given cost centre name.
+getCCIndex :: FastString
+ -> CostCentreState
+ -> (CostCentreIndex, CostCentreState)
+getCCIndex nm (CostCentreState m) =
+ (CostCentreIndex idx, CostCentreState m')
+ where
+ m_idx = lookupFsEnv m nm
+ idx = maybe 0 id m_idx
+ m' = extendFsEnv m nm (idx + 1)