ghc-prof 1.1.0 → 1.2.0

raw patch · 4 files changed

+114/−18 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ghc-prof.cabal +1/−1
• src/GHC/Prof.hs +2/−0
• src/GHC/Prof/CostCentreTree.hs +109/−15
• src/GHC/Prof/Types.hs +2/−2

@@ -1,5 +1,5 @@ name: ghc-prof-version: 1.1.0+version: 1.2.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

@@ -10,6 +10,8 @@   , aggregateCostCentresOrderBy   , costCentres   , costCentresOrderBy+  , aggregateCallSites+  , aggregateCallSitesOrderBy   , callSites   , callSitesOrderBy 

@@ -9,19 +9,23 @@   , costCentres   , costCentresOrderBy +  , aggregateCallSites+  , aggregateCallSitesOrderBy+   , callSites   , callSitesOrderBy    , buildAggregateCostCentresOrderBy   , buildCostCentresOrderBy   , buildCallSitesOrderBy+  , buildAggregateCallSitesOrderBy   ) where import Control.Applicative import Control.Arrow ((&&&))+import Control.Monad import Data.Function (on) import Data.List import Data.Maybe (listToMaybe)-import Data.Traversable (mapM) import Prelude hiding (mapM) import qualified Data.Foldable as Fold @@ -30,7 +34,8 @@ import qualified Data.Set as Set import qualified Data.Tree as Tree -import GHC.Prof.Types+import Control.Monad.Extras (seqM)+import GHC.Prof.Types as Types  #if MIN_VERSION_containers(0, 5, 0) import qualified Data.IntMap.Strict as IntMap@@ -78,6 +83,37 @@ costCentresOrderBy sortKey =   buildCostCentresOrderBy sortKey . profileCostCentreTree +-- | Build a list of call sites (caller functions of a cost centre) aggregated+-- by their cost centre names and module names.+aggregateCallSites+  :: Text+  -- ^ Cost centre name+  -> Text+  -- ^ Module name+  -> Profile+  -> Maybe (AggregateCostCentre, [CallSite AggregateCostCentre])+aggregateCallSites = aggregateCallSitesOrderBy sortKey+  where+    sortKey = callSiteContribTime &&& callSiteContribAlloc+      &&& aggregateCostCentreTime . callSiteCostCentre+      &&& aggregateCostCentreAlloc . callSiteCostCentre++-- | Build a list of call sites (caller functions of a cost centre) aggregated+-- by their cost centre names and module names. Call sites are sorted by the+-- given key function.+aggregateCallSitesOrderBy+  :: Ord a+  => (CallSite AggregateCostCentre -> a)+  -- ^ Sorting key function+  -> Text+  -- ^ Cost centre name+  -> Text+  -- ^ Module name+  -> Profile+  -> Maybe (AggregateCostCentre, [CallSite AggregateCostCentre])+aggregateCallSitesOrderBy sortKey name modName =+  buildAggregateCallSitesOrderBy sortKey name modName . profileCostCentreTree+ -- | Build a list of call-sites (caller functions) for a specified -- cost-centre name and module name. callSites@@ -86,26 +122,26 @@   -> Text   -- ^ Module name   -> Profile-  -> Maybe (AggregateCostCentre, [CallSite])+  -> Maybe (AggregateCostCentre, [CallSite CostCentre]) callSites = callSitesOrderBy sortKey   where-    sortKey =-      costCentreInhTime &&& costCentreIndTime &&&-      costCentreInhAlloc &&& costCentreIndAlloc+    sortKey = callSiteContribTime &&& callSiteContribAlloc+      &&& costCentreIndTime . callSiteCostCentre+      &&& costCentreIndAlloc . callSiteCostCentre  -- | Build a list of call-sites (caller function) for a specified -- cost-centre name and module name. Nodes are sorted by the given -- key function. callSitesOrderBy   :: Ord a-  => (CostCentre -> a)+  => (CallSite CostCentre -> a)   -- ^ Sorting key function   -> Text   -- ^ Cost-centre name   -> Text   -- ^ Module name   -> Profile-  -> Maybe (AggregateCostCentre, [CallSite])+  -> Maybe (AggregateCostCentre, [CallSite CostCentre]) callSitesOrderBy sortKey name modName =   buildCallSitesOrderBy sortKey name modName . profileCostCentreTree @@ -140,27 +176,85 @@             return $ costCentreNo               <$> sortBy (flip compare `on` sortKey) (Set.toList nodes) +buildAggregateCallSitesOrderBy+  :: Ord a+  => (CallSite AggregateCostCentre -> a)+  -- ^ Sorting key function+  -> Text+  -- ^ Cost centre name+  -> Text+  -- ^ Module name+  -> CostCentreTree+  -> Maybe (AggregateCostCentre, [CallSite AggregateCostCentre])+buildAggregateCallSitesOrderBy sortKey name modName tree@CostCentreTree {..} =+  (,) <$> callee <*> callers+  where+    callee = Map.lookup (name, modName) costCentreAggregate+    callers = do+      callees <- Map.lookup (name, modName) costCentreCallSites+      sortBy (flip compare `on` sortKey) . Map.elems+        <$> foldM (buildAggregateCallSite tree) Map.empty (Set.toList callees)++buildAggregateCallSite+  :: CostCentreTree+  -> Map.Map (Text, Text) (CallSite AggregateCostCentre)+  -> CostCentre+  -> Maybe (Map.Map (Text, Text) (CallSite AggregateCostCentre))+buildAggregateCallSite CostCentreTree {..} parents CostCentre {..} = do+  parentNo <- IntMap.lookup costCentreNo costCentreParents+  parent <- IntMap.lookup parentNo costCentreNodes+  let parentName = Types.costCentreName parent+      parentModule = Types.costCentreModule parent+  aggregate <- Map.lookup (parentName, parentModule) costCentreAggregate+  return $! Map.insertWith+    mergeCallSites+    (parentName, parentModule)+    CallSite+      { callSiteCostCentre = aggregate+      , callSiteContribEntries = costCentreEntries+      , callSiteContribTime = costCentreIndTime+      , callSiteContribAlloc = costCentreIndAlloc+      , callSiteContribTicks = costCentreTicks+      , callSiteContribBytes = costCentreBytes+      }+    parents++mergeCallSites :: CallSite a -> CallSite a -> CallSite a+mergeCallSites a b = a+  { callSiteContribEntries = callSiteContribEntries a + callSiteContribEntries b+  , callSiteContribTime = callSiteContribTime a + callSiteContribTime b+  , callSiteContribAlloc = callSiteContribAlloc a + callSiteContribAlloc b+  , callSiteContribTicks = seqM $ (+)+    <$> callSiteContribTicks a+    <*> callSiteContribTicks b+  , callSiteContribBytes = seqM $ (+)+    <$> callSiteContribBytes a+    <*> callSiteContribBytes b+  }+ buildCallSitesOrderBy   :: Ord a-  => (CostCentre -> a)+  => (CallSite CostCentre -> a)   -- ^ Sorting key function   -> Text   -- ^ Cost-centre name   -> Text   -- ^ Module name   -> CostCentreTree-  -> Maybe (AggregateCostCentre, [CallSite])+  -> Maybe (AggregateCostCentre, [CallSite CostCentre]) buildCallSitesOrderBy sortKey name modName tree@CostCentreTree {..} =   (,) <$> callee <*> callers   where-    lookupCallees = Map.lookup (name, modName) costCentreCallSites     callee = Map.lookup (name, modName) costCentreAggregate     callers = do-      callees <- lookupCallees-      mapM (buildCallSite tree) $-        sortBy (flip compare `on` sortKey) $ Set.toList callees+      callees <- Map.lookup (name, modName) costCentreCallSites+      sortBy (flip compare `on` sortKey)+        <$> mapM (buildCallSite tree) (Set.toList callees) -buildCallSite :: CostCentreTree -> CostCentre -> Maybe CallSite+buildCallSite+  :: CostCentreTree+  -> CostCentre+  -> Maybe (CallSite CostCentre) buildCallSite CostCentreTree {..} CostCentre {..} = do   parentNo <- IntMap.lookup costCentreNo costCentreParents   parent <- IntMap.lookup parentNo costCentreNodes

@@ -104,8 +104,8 @@   , costCentreAggregate = mempty   } -data CallSite = CallSite-  { callSiteCostCentre :: CostCentre+data CallSite cc = CallSite+  { callSiteCostCentre :: cc   -- ^ Metrics for the caller function   , callSiteContribEntries :: !Integer   -- ^ Number of entries contriubted by the caller function