ghc-prof 1.2.0 → 1.3.0

raw patch · 5 files changed

+129/−20 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ghc-prof.cabal +1/−1
• src/GHC/Prof.hs +3/−0
• src/GHC/Prof/CostCentreTree.hs +72/−5
• src/GHC/Prof/Parser.hs +25/−13
• src/GHC/Prof/Types.hs +28/−1

@@ -1,5 +1,5 @@ name: ghc-prof-version: 1.2.0+version: 1.3.0 synopsis: Library for parsing GHC time and allocation profiling reports description: Library for parsing GHC time and allocation profiling reports homepage: https://github.com/maoe/ghc-prof

@@ -14,6 +14,8 @@   , aggregateCallSitesOrderBy   , callSites   , callSitesOrderBy+  , aggregateModules+  , aggregateModulesOrderBy    -- * Types   , Profile(..)@@ -23,6 +25,7 @@   , CostCentre(..)   , CostCentreNo   , CallSite(..)+  , AggregateModule(..)   ) where  import qualified Data.Attoparsec.Text.Lazy as ATL

@@ -3,18 +3,29 @@ {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fsimpl-tick-factor=200 #-} module GHC.Prof.CostCentreTree-  ( aggregateCostCentres+  ( -- * Cost center breakdown+  -- ** Aggregate cost centres+    aggregateCostCentres   , aggregateCostCentresOrderBy +  -- ** Cost centre trees   , costCentres   , costCentresOrderBy +  -- * Call site breakdown+  -- ** Aggregate call sites   , aggregateCallSites   , aggregateCallSitesOrderBy +  -- ** Call sites   , callSites   , callSitesOrderBy +  -- * Module breakdown+  , aggregateModules+  , aggregateModulesOrderBy++  -- * Low level functions   , buildAggregateCostCentresOrderBy   , buildCostCentresOrderBy   , buildCallSitesOrderBy@@ -145,6 +156,24 @@ callSitesOrderBy sortKey name modName =   buildCallSitesOrderBy sortKey name modName . profileCostCentreTree +-- | Break down aggregate cost centres by module sorted by total time and+-- allocation.+aggregateModules+  :: Profile+  -> [AggregateModule]+aggregateModules = aggregateModulesOrderBy sortKey+  where+    sortKey = aggregateModuleTime &&& aggregateModuleAlloc++-- | Break odwn aggregate cost centres by module.+aggregateModulesOrderBy+  :: Ord a+  => (AggregateModule -> a) -- ^ Sorting key function+  -> Profile+  -> [AggregateModule]+aggregateModulesOrderBy sortKey =+    buildAggregateModulesOrderBy sortKey . profileCostCentreTree+ -----------------------------------------------------------  buildAggregateCostCentresOrderBy@@ -153,7 +182,8 @@   -> CostCentreTree   -> [AggregateCostCentre] buildAggregateCostCentresOrderBy sortKey CostCentreTree {..} =-  sortBy (flip compare `on` sortKey) $ Map.elems $ costCentreAggregate+  sortBy (flip compare `on` sortKey) $+    concatMap Map.elems $ Map.elems $ costCentreAggregate  buildCostCentresOrderBy   :: Ord a@@ -189,7 +219,7 @@ buildAggregateCallSitesOrderBy sortKey name modName tree@CostCentreTree {..} =   (,) <$> callee <*> callers   where-    callee = Map.lookup (name, modName) costCentreAggregate+    callee = lookupAggregate name modName costCentreAggregate     callers = do       callees <- Map.lookup (name, modName) costCentreCallSites       sortBy (flip compare `on` sortKey) . Map.elems@@ -205,7 +235,7 @@   parent <- IntMap.lookup parentNo costCentreNodes   let parentName = Types.costCentreName parent       parentModule = Types.costCentreModule parent-  aggregate <- Map.lookup (parentName, parentModule) costCentreAggregate+  aggregate <- lookupAggregate parentName parentModule costCentreAggregate   return $! Map.insertWith     mergeCallSites     (parentName, parentModule)@@ -245,7 +275,7 @@ buildCallSitesOrderBy sortKey name modName tree@CostCentreTree {..} =   (,) <$> callee <*> callers   where-    callee = Map.lookup (name, modName) costCentreAggregate+    callee = lookupAggregate name modName costCentreAggregate     callers = do       callees <- Map.lookup (name, modName) costCentreCallSites       sortBy (flip compare `on` sortKey)@@ -266,3 +296,40 @@     , callSiteContribTicks = costCentreTicks     , callSiteContribBytes = costCentreBytes     }++buildAggregateModulesOrderBy+  :: Ord a+  => (AggregateModule -> a)+  -- ^ Sorting key function+  -> CostCentreTree+  -> [AggregateModule]+buildAggregateModulesOrderBy sortKey CostCentreTree {..} =+  sortBy (flip compare `on` sortKey) $+    Map.foldrWithKey+      (\modName ccs as -> aggregateModule modName ccs : as)+      []+      costCentreAggregate+  where+    aggregateModule modName = Map.foldl' add (emptyAggregateModule modName)+    add aggMod AggregateCostCentre {..} = aggMod+      { aggregateModuleEntries = seqM $ (+)+        <$> aggregateModuleEntries aggMod+        <*> aggregateCostCentreEntries+      , aggregateModuleTime =+        aggregateModuleTime aggMod + aggregateCostCentreTime+      , aggregateModuleAlloc =+        aggregateModuleAlloc aggMod + aggregateCostCentreAlloc+      , aggregateModuleTicks = seqM $ (+)+        <$> aggregateModuleTicks aggMod+        <*> aggregateCostCentreTicks+      , aggregateModuleBytes = seqM $ (+)+        <$> aggregateModuleBytes aggMod+        <*> aggregateCostCentreBytes+      }++lookupAggregate+  :: Text -- ^ Cost centre name+  -> Text -- ^ Module name+  -> Map.Map Text (Map.Map Text AggregateCostCentre)+  -> Maybe AggregateCostCentre+lookupAggregate name modName m = Map.lookup modName m >>= Map.lookup name

@@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE LambdaCase #-} module GHC.Prof.Parser   ( profile @@ -275,20 +276,32 @@             (costCentreName node, costCentreModule node)             (Set.singleton node)             costCentreCallSites-          , costCentreAggregate = Map.insertWith addCostCentre-            (costCentreName node, costCentreModule node)-            (AggregateCostCentre-              { aggregateCostCentreName = costCentreName node-              , aggregateCostCentreModule = costCentreModule node-              , aggregateCostCentreSrc = costCentreSrc node-              , aggregateCostCentreEntries = Just $! costCentreEntries node-              , aggregateCostCentreTime = costCentreIndTime node-              , aggregateCostCentreAlloc = costCentreIndAlloc node-              , aggregateCostCentreTicks = costCentreTicks node-              , aggregateCostCentreBytes = costCentreBytes node-              })+          , costCentreAggregate = Map.alter+            (Just . updateCostCentre)+            (costCentreModule node)             costCentreAggregate           }+        aggregate = AggregateCostCentre+          { aggregateCostCentreName = costCentreName node+          , aggregateCostCentreModule = costCentreModule node+          , aggregateCostCentreSrc = costCentreSrc node+          , aggregateCostCentreEntries = Just $! costCentreEntries node+          , aggregateCostCentreTime = costCentreIndTime node+          , aggregateCostCentreAlloc = costCentreIndAlloc node+          , aggregateCostCentreTicks = costCentreTicks node+          , aggregateCostCentreBytes = costCentreBytes node+          }+        updateCostCentre+          :: Maybe (Map.Map Text AggregateCostCentre)+          -> Map.Map Text AggregateCostCentre+        updateCostCentre = \case+          Nothing -> Map.singleton (costCentreName node) aggregate+          Just costCentreByName ->+            Map.insertWith+              addCostCentre+              (costCentreName node)+              aggregate+              costCentreByName         addCostCentre x y = x           { aggregateCostCentreEntries = seqM $ (+)             <$> aggregateCostCentreEntries x@@ -304,7 +317,6 @@             <$> aggregateCostCentreBytes x             <*> aggregateCostCentreBytes y           }-  howMany :: Parser a -> Parser Int howMany p = loop 0

@@ -92,7 +92,7 @@   , costCentreParents :: !(IntMap CostCentreNo)   , costCentreChildren :: !(IntMap (Set CostCentre))   , costCentreCallSites :: !(Map (Text, Text) (Set CostCentre))-  , costCentreAggregate :: !(Map (Text, Text) AggregateCostCentre)+  , costCentreAggregate :: !(Map Text (Map Text AggregateCostCentre))   } deriving Show  emptyCostCentreTree :: CostCentreTree@@ -118,3 +118,30 @@   , callSiteContribBytes :: !(Maybe Integer)   -- ^ Number of allocated bytes contributed byt hte caller function   } deriving Show++data AggregateModule = AggregateModule+  { aggregateModuleName :: !Text+  -- ^ Name of the module+  , aggregateModuleEntries :: !(Maybe Integer)+  -- ^ Total number of entries to cost centres in the module+  , aggregateModuleTime :: !Scientific+  -- ^ Total time spent on cost centres in the module+  , aggregateModuleAlloc :: !Scientific+  -- ^ Total allocation on cost centres in the module+  , aggregateModuleTicks :: !(Maybe Integer)+  -- ^ Total ticks on cost centres in the module. This number exists only if+  -- @-P@ or @-Pa@ option is given at run-time.+  , aggregateModuleBytes :: !(Maybe Integer)+  -- ^ Total memory allocation on cost centres in the module. This number+  -- exists only if @-P@ or @-Pa@ option is given at run-time.+  } deriving (Show, Eq, Ord)++emptyAggregateModule :: Text -> AggregateModule+emptyAggregateModule name = AggregateModule+  { aggregateModuleName = name+  , aggregateModuleEntries = Just 0+  , aggregateModuleTime = 0+  , aggregateModuleAlloc = 0+  , aggregateModuleTicks = Just 0+  , aggregateModuleBytes = Just 0+  }