{-# LANGUAGE ExistentialQuantification #-}

module Unison.Codebase.Runtime.Profile
  ( ProfTrie (..),
    Profile (..),
    SomeProfile (..),
    ProfileSpec (..),
    emptyProfile,
    singlePath,
    addPath,
    aggregatePruned,
    fullProfile,
    miniProfile,
    foldedProfile,
  )
where

import Data.Bifunctor (second)
import Data.Functor.Identity (Identity (..))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M
import Data.Set (Set)
import Data.Set qualified as S
import Data.String
import Data.Text (Text)
import Numeric
import Unison.PrettyPrintEnv
import Unison.Reference
import Unison.Referent
import Unison.Syntax.NamePrinter
import Unison.Util.Pretty as P

-- A `ProfTrie` maps non-empty paths to counts of occurrences of that
-- path. This allows tracking relative frequency of call stacks. The
-- path elements are parameterized to allow for more efficient `Map` keys
-- to be used during construction, and can be paired with a decoding to
-- `Reference` as below.
newtype ProfTrie k a = ProfT (Map k (a, ProfTrie k a))
  deriving ((forall a b. (a -> b) -> ProfTrie k a -> ProfTrie k b)
-> (forall a b. a -> ProfTrie k b -> ProfTrie k a)
-> Functor (ProfTrie k)
forall a b. a -> ProfTrie k b -> ProfTrie k a
forall a b. (a -> b) -> ProfTrie k a -> ProfTrie k b
forall k a b. a -> ProfTrie k b -> ProfTrie k a
forall k a b. (a -> b) -> ProfTrie k a -> ProfTrie k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k a b. (a -> b) -> ProfTrie k a -> ProfTrie k b
fmap :: forall a b. (a -> b) -> ProfTrie k a -> ProfTrie k b
$c<$ :: forall k a b. a -> ProfTrie k b -> ProfTrie k a
<$ :: forall a b. a -> ProfTrie k b -> ProfTrie k a
Functor)

trimEmpty :: (Ord k, Eq a, Num a) => ProfTrie k a -> ProfTrie k a
trimEmpty :: forall k a. (Ord k, Eq a, Num a) => ProfTrie k a -> ProfTrie k a
trimEmpty (ProfT Map k (a, ProfTrie k a)
m) = case (k -> (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a)))
-> Map k (a, ProfTrie k a) -> Identity (Map k (a, ProfTrie k a))
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
M.traverseMaybeWithKey k -> (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a))
forall {k} {a} {a} {f :: * -> *} {p}.
(Ord k, Num a, Num a, Applicative f, Eq a, Eq a) =>
p -> (a, ProfTrie k a) -> f (Maybe (a, ProfTrie k a))
f Map k (a, ProfTrie k a)
m of
  Identity Map k (a, ProfTrie k a)
m -> Map k (a, ProfTrie k a) -> ProfTrie k a
forall k a. Map k (a, ProfTrie k a) -> ProfTrie k a
ProfT Map k (a, ProfTrie k a)
m
  where
    f :: p -> (a, ProfTrie k a) -> f (Maybe (a, ProfTrie k a))
f p
_ (a
a, ProfTrie k a -> ProfTrie k a
forall k a. (Ord k, Eq a, Num a) => ProfTrie k a -> ProfTrie k a
trimEmpty -> sub :: ProfTrie k a
sub@(ProfT Map k (a, ProfTrie k a)
m))
      | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0, Map k (a, ProfTrie k a) -> Bool
forall a. Map k a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map k (a, ProfTrie k a)
m = Maybe (a, ProfTrie k a) -> f (Maybe (a, ProfTrie k a))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, ProfTrie k a)
forall a. Maybe a
Nothing
      | Bool
otherwise = Maybe (a, ProfTrie k a) -> f (Maybe (a, ProfTrie k a))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, ProfTrie k a) -> f (Maybe (a, ProfTrie k a)))
-> Maybe (a, ProfTrie k a) -> f (Maybe (a, ProfTrie k a))
forall a b. (a -> b) -> a -> b
$ (a, ProfTrie k a) -> Maybe (a, ProfTrie k a)
forall a. a -> Maybe a
Just (a
a, ProfTrie k a
sub)

demux ::
  (Ord k, Eq a, Eq b, Num a, Num b) =>
  ProfTrie k (a, b) ->
  (ProfTrie k a, ProfTrie k b)
demux :: forall k a b.
(Ord k, Eq a, Eq b, Num a, Num b) =>
ProfTrie k (a, b) -> (ProfTrie k a, ProfTrie k b)
demux ProfTrie k (a, b)
tr = (ProfTrie k a -> ProfTrie k a
forall k a. (Ord k, Eq a, Num a) => ProfTrie k a -> ProfTrie k a
trimEmpty (ProfTrie k a -> ProfTrie k a) -> ProfTrie k a -> ProfTrie k a
forall a b. (a -> b) -> a -> b
$ (a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> ProfTrie k (a, b) -> ProfTrie k a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProfTrie k (a, b)
tr, ProfTrie k b -> ProfTrie k b
forall k a. (Ord k, Eq a, Num a) => ProfTrie k a -> ProfTrie k a
trimEmpty (ProfTrie k b -> ProfTrie k b) -> ProfTrie k b -> ProfTrie k b
forall a b. (a -> b) -> a -> b
$ (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> ProfTrie k (a, b) -> ProfTrie k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProfTrie k (a, b)
tr)

-- A profile pairs the above arbitrary key based profile trie with a
-- decoding of the integers to references and a total sample count.
data Profile k
  = Prof !(Int, Int) !(ProfTrie k (Int, Int)) !(Map k Reference)

-- Abstracts over the exact key type used in a profile.
data SomeProfile = forall k. (Ord k) => SomeProf (Profile k)

data ProfileSpec = NoProf | MiniProf | FullProf String
  deriving (ProfileSpec -> ProfileSpec -> Bool
(ProfileSpec -> ProfileSpec -> Bool)
-> (ProfileSpec -> ProfileSpec -> Bool) -> Eq ProfileSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProfileSpec -> ProfileSpec -> Bool
== :: ProfileSpec -> ProfileSpec -> Bool
$c/= :: ProfileSpec -> ProfileSpec -> Bool
/= :: ProfileSpec -> ProfileSpec -> Bool
Eq, Eq ProfileSpec
Eq ProfileSpec =>
(ProfileSpec -> ProfileSpec -> Ordering)
-> (ProfileSpec -> ProfileSpec -> Bool)
-> (ProfileSpec -> ProfileSpec -> Bool)
-> (ProfileSpec -> ProfileSpec -> Bool)
-> (ProfileSpec -> ProfileSpec -> Bool)
-> (ProfileSpec -> ProfileSpec -> ProfileSpec)
-> (ProfileSpec -> ProfileSpec -> ProfileSpec)
-> Ord ProfileSpec
ProfileSpec -> ProfileSpec -> Bool
ProfileSpec -> ProfileSpec -> Ordering
ProfileSpec -> ProfileSpec -> ProfileSpec
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 :: ProfileSpec -> ProfileSpec -> Ordering
compare :: ProfileSpec -> ProfileSpec -> Ordering
$c< :: ProfileSpec -> ProfileSpec -> Bool
< :: ProfileSpec -> ProfileSpec -> Bool
$c<= :: ProfileSpec -> ProfileSpec -> Bool
<= :: ProfileSpec -> ProfileSpec -> Bool
$c> :: ProfileSpec -> ProfileSpec -> Bool
> :: ProfileSpec -> ProfileSpec -> Bool
$c>= :: ProfileSpec -> ProfileSpec -> Bool
>= :: ProfileSpec -> ProfileSpec -> Bool
$cmax :: ProfileSpec -> ProfileSpec -> ProfileSpec
max :: ProfileSpec -> ProfileSpec -> ProfileSpec
$cmin :: ProfileSpec -> ProfileSpec -> ProfileSpec
min :: ProfileSpec -> ProfileSpec -> ProfileSpec
Ord, Int -> ProfileSpec -> ShowS
[ProfileSpec] -> ShowS
ProfileSpec -> String
(Int -> ProfileSpec -> ShowS)
-> (ProfileSpec -> String)
-> ([ProfileSpec] -> ShowS)
-> Show ProfileSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfileSpec -> ShowS
showsPrec :: Int -> ProfileSpec -> ShowS
$cshow :: ProfileSpec -> String
show :: ProfileSpec -> String
$cshowList :: [ProfileSpec] -> ShowS
showList :: [ProfileSpec] -> ShowS
Show)

emptyProfile :: Profile k
emptyProfile :: forall k. Profile k
emptyProfile = (Int, Int) -> ProfTrie k (Int, Int) -> Map k Reference -> Profile k
forall k.
(Int, Int) -> ProfTrie k (Int, Int) -> Map k Reference -> Profile k
Prof (Int, Int)
zero (Map k ((Int, Int), ProfTrie k (Int, Int)) -> ProfTrie k (Int, Int)
forall k a. Map k (a, ProfTrie k a) -> ProfTrie k a
ProfT Map k ((Int, Int), ProfTrie k (Int, Int))
forall k a. Map k a
M.empty) Map k Reference
forall k a. Map k a
M.empty

zero :: (Int, Int)
zero :: (Int, Int)
zero = (Int
0, Int
0)

inc :: Bool -> (Int, Int) -> (Int, Int)
inc :: Bool -> (Int, Int) -> (Int, Int)
inc Bool
b (Int
m, Int
n) = Int -> Int -> (Int, Int)
forall {a} {b}. a -> b -> (a, b)
pair (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (if Bool
b then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n)
  where
    pair :: a -> b -> (a, b)
pair !a
x !b
y = (a
x, b
y)

-- Creates a singleton profile trie from a path.
singlePath ::
  (Ord k) =>
  Bool ->
  [k] ->
  ((Int, Int), ProfTrie k (Int, Int))
singlePath :: forall k.
Ord k =>
Bool -> [k] -> ((Int, Int), ProfTrie k (Int, Int))
singlePath Bool
b [] = (Bool -> (Int, Int) -> (Int, Int)
inc Bool
b (Int, Int)
zero, Map k ((Int, Int), ProfTrie k (Int, Int)) -> ProfTrie k (Int, Int)
forall k a. Map k (a, ProfTrie k a) -> ProfTrie k a
ProfT Map k ((Int, Int), ProfTrie k (Int, Int))
forall k a. Map k a
M.empty)
singlePath Bool
b (k
i : [k]
is) =
  ((Int, Int)
zero,) (ProfTrie k (Int, Int) -> ((Int, Int), ProfTrie k (Int, Int)))
-> (Map k ((Int, Int), ProfTrie k (Int, Int))
    -> ProfTrie k (Int, Int))
-> Map k ((Int, Int), ProfTrie k (Int, Int))
-> ((Int, Int), ProfTrie k (Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k ((Int, Int), ProfTrie k (Int, Int)) -> ProfTrie k (Int, Int)
forall k a. Map k (a, ProfTrie k a) -> ProfTrie k a
ProfT (Map k ((Int, Int), ProfTrie k (Int, Int))
 -> ((Int, Int), ProfTrie k (Int, Int)))
-> Map k ((Int, Int), ProfTrie k (Int, Int))
-> ((Int, Int), ProfTrie k (Int, Int))
forall a b. (a -> b) -> a -> b
$! k
-> ((Int, Int), ProfTrie k (Int, Int))
-> Map k ((Int, Int), ProfTrie k (Int, Int))
forall k a. k -> a -> Map k a
M.singleton k
i (Bool -> [k] -> ((Int, Int), ProfTrie k (Int, Int))
forall k.
Ord k =>
Bool -> [k] -> ((Int, Int), ProfTrie k (Int, Int))
singlePath Bool
b [k]
is)

addPath0 ::
  (Ord k) =>
  Bool ->
  [k] ->
  ((Int, Int), ProfTrie k (Int, Int)) ->
  ((Int, Int), ProfTrie k (Int, Int))
addPath0 :: forall k.
Ord k =>
Bool
-> [k]
-> ((Int, Int), ProfTrie k (Int, Int))
-> ((Int, Int), ProfTrie k (Int, Int))
addPath0 Bool
b [] ((Int, Int)
t, ProfTrie k (Int, Int)
p) = (,ProfTrie k (Int, Int)
p) ((Int, Int) -> ((Int, Int), ProfTrie k (Int, Int)))
-> (Int, Int) -> ((Int, Int), ProfTrie k (Int, Int))
forall a b. (a -> b) -> a -> b
$! Bool -> (Int, Int) -> (Int, Int)
inc Bool
b (Int, Int)
t
addPath0 Bool
b (k
i : [k]
is) ((Int, Int)
m, ProfT Map k ((Int, Int), ProfTrie k (Int, Int))
p) = ((Int, Int)
m,) (ProfTrie k (Int, Int) -> ((Int, Int), ProfTrie k (Int, Int)))
-> (Map k ((Int, Int), ProfTrie k (Int, Int))
    -> ProfTrie k (Int, Int))
-> Map k ((Int, Int), ProfTrie k (Int, Int))
-> ((Int, Int), ProfTrie k (Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k ((Int, Int), ProfTrie k (Int, Int)) -> ProfTrie k (Int, Int)
forall k a. Map k (a, ProfTrie k a) -> ProfTrie k a
ProfT (Map k ((Int, Int), ProfTrie k (Int, Int))
 -> ((Int, Int), ProfTrie k (Int, Int)))
-> Map k ((Int, Int), ProfTrie k (Int, Int))
-> ((Int, Int), ProfTrie k (Int, Int))
forall a b. (a -> b) -> a -> b
$! (Maybe ((Int, Int), ProfTrie k (Int, Int))
 -> Maybe ((Int, Int), ProfTrie k (Int, Int)))
-> k
-> Map k ((Int, Int), ProfTrie k (Int, Int))
-> Map k ((Int, Int), ProfTrie k (Int, Int))
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
f k
i Map k ((Int, Int), ProfTrie k (Int, Int))
p
  where
    f :: Maybe ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
f Maybe ((Int, Int), ProfTrie k (Int, Int))
Nothing = ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
forall a. a -> Maybe a
Just (((Int, Int), ProfTrie k (Int, Int))
 -> Maybe ((Int, Int), ProfTrie k (Int, Int)))
-> ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
forall a b. (a -> b) -> a -> b
$ Bool -> [k] -> ((Int, Int), ProfTrie k (Int, Int))
forall k.
Ord k =>
Bool -> [k] -> ((Int, Int), ProfTrie k (Int, Int))
singlePath Bool
b [k]
is
    f (Just ((Int, Int), ProfTrie k (Int, Int))
q) = ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
forall a. a -> Maybe a
Just (((Int, Int), ProfTrie k (Int, Int))
 -> Maybe ((Int, Int), ProfTrie k (Int, Int)))
-> ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
forall a b. (a -> b) -> a -> b
$ Bool
-> [k]
-> ((Int, Int), ProfTrie k (Int, Int))
-> ((Int, Int), ProfTrie k (Int, Int))
forall k.
Ord k =>
Bool
-> [k]
-> ((Int, Int), ProfTrie k (Int, Int))
-> ((Int, Int), ProfTrie k (Int, Int))
addPath0 Bool
b [k]
is ((Int, Int), ProfTrie k (Int, Int))
q

-- Adds a path to a profile trie, incrementing the count for the given
-- path.
addPath ::
  (Ord k) =>
  Bool ->
  [k] ->
  ProfTrie k (Int, Int) ->
  ProfTrie k (Int, Int)
addPath :: forall k.
Ord k =>
Bool -> [k] -> ProfTrie k (Int, Int) -> ProfTrie k (Int, Int)
addPath Bool
_ [] ProfTrie k (Int, Int)
p = ProfTrie k (Int, Int)
p
addPath Bool
b (k
i : [k]
is) (ProfT Map k ((Int, Int), ProfTrie k (Int, Int))
m) = Map k ((Int, Int), ProfTrie k (Int, Int)) -> ProfTrie k (Int, Int)
forall k a. Map k (a, ProfTrie k a) -> ProfTrie k a
ProfT (Map k ((Int, Int), ProfTrie k (Int, Int))
 -> ProfTrie k (Int, Int))
-> Map k ((Int, Int), ProfTrie k (Int, Int))
-> ProfTrie k (Int, Int)
forall a b. (a -> b) -> a -> b
$ (Maybe ((Int, Int), ProfTrie k (Int, Int))
 -> Maybe ((Int, Int), ProfTrie k (Int, Int)))
-> k
-> Map k ((Int, Int), ProfTrie k (Int, Int))
-> Map k ((Int, Int), ProfTrie k (Int, Int))
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
f k
i Map k ((Int, Int), ProfTrie k (Int, Int))
m
  where
    f :: Maybe ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
f Maybe ((Int, Int), ProfTrie k (Int, Int))
Nothing = ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
forall a. a -> Maybe a
Just (((Int, Int), ProfTrie k (Int, Int))
 -> Maybe ((Int, Int), ProfTrie k (Int, Int)))
-> ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
forall a b. (a -> b) -> a -> b
$ Bool -> [k] -> ((Int, Int), ProfTrie k (Int, Int))
forall k.
Ord k =>
Bool -> [k] -> ((Int, Int), ProfTrie k (Int, Int))
singlePath Bool
b [k]
is
    f (Just ((Int, Int), ProfTrie k (Int, Int))
q) = ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
forall a. a -> Maybe a
Just (((Int, Int), ProfTrie k (Int, Int))
 -> Maybe ((Int, Int), ProfTrie k (Int, Int)))
-> ((Int, Int), ProfTrie k (Int, Int))
-> Maybe ((Int, Int), ProfTrie k (Int, Int))
forall a b. (a -> b) -> a -> b
$ Bool
-> [k]
-> ((Int, Int), ProfTrie k (Int, Int))
-> ((Int, Int), ProfTrie k (Int, Int))
forall k.
Ord k =>
Bool
-> [k]
-> ((Int, Int), ProfTrie k (Int, Int))
-> ((Int, Int), ProfTrie k (Int, Int))
addPath0 Bool
b [k]
is ((Int, Int), ProfTrie k (Int, Int))
q

data AggInfo k = Ag
  { -- inherited sample count
    forall k. AggInfo k -> Int
inherited :: Int,
    -- total sample for all occurrences of a key
    forall k. AggInfo k -> Map k Int
allOccs :: Map k Int
  }

instance (Ord k) => Semigroup (AggInfo k) where
  Ag Int
il Map k Int
al <> :: AggInfo k -> AggInfo k -> AggInfo k
<> Ag Int
ir Map k Int
ar =
    Int -> Map k Int -> AggInfo k
forall k. Int -> Map k Int -> AggInfo k
Ag (Int
il Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ir) ((Int -> Int -> Int) -> Map k Int -> Map k Int -> Map k Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Map k Int
al Map k Int
ar)

instance (Ord k) => Monoid (AggInfo k) where
  mempty :: AggInfo k
mempty = Int -> Map k Int -> AggInfo k
forall k. Int -> Map k Int -> AggInfo k
Ag Int
0 Map k Int
forall k a. Map k a
M.empty

aggregateWith ::
  (Ord k) =>
  (AggInfo k -> Int -> r) ->
  k ->
  (Int, ProfTrie k Int) ->
  (AggInfo k, (r, ProfTrie k r))
aggregateWith :: forall k r.
Ord k =>
(AggInfo k -> Int -> r)
-> k -> (Int, ProfTrie k Int) -> (AggInfo k, (r, ProfTrie k r))
aggregateWith AggInfo k -> Int -> r
f k
k (Int
m, ProfT Map k (Int, ProfTrie k Int)
t) =
  case (k -> (Int, ProfTrie k Int) -> (AggInfo k, (r, ProfTrie k r)))
-> Map k (Int, ProfTrie k Int)
-> (AggInfo k, Map k (r, ProfTrie k r))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey ((AggInfo k -> Int -> r)
-> k -> (Int, ProfTrie k Int) -> (AggInfo k, (r, ProfTrie k r))
forall k r.
Ord k =>
(AggInfo k -> Int -> r)
-> k -> (Int, ProfTrie k Int) -> (AggInfo k, (r, ProfTrie k r))
aggregateWith AggInfo k -> Int -> r
f) Map k (Int, ProfTrie k Int)
t of
    (AggInfo k
ag, Map k (r, ProfTrie k r)
t) -> (AggInfo k
ag', (AggInfo k -> Int -> r
f AggInfo k
ag' Int
m, Map k (r, ProfTrie k r) -> ProfTrie k r
forall k a. Map k (a, ProfTrie k a) -> ProfTrie k a
ProfT Map k (r, ProfTrie k r)
t))
      where
        ag' :: AggInfo k
ag' = AggInfo k
ag AggInfo k -> AggInfo k -> AggInfo k
forall a. Semigroup a => a -> a -> a
<> Int -> Map k Int -> AggInfo k
forall k. Int -> Map k Int -> AggInfo k
Ag Int
m (k -> Int -> Map k Int
forall k a. k -> a -> Map k a
M.singleton k
k Int
m)

prune0 ::
  (Ord k) =>
  Set k ->
  k ->
  (a, ProfTrie k a) ->
  Identity (Maybe (a, ProfTrie k a))
prune0 :: forall k a.
Ord k =>
Set k
-> k -> (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a))
prune0 Set k
keep k
k (a
a, ProfT Map k (a, ProfTrie k a)
sub) =
  case (k -> (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a)))
-> Map k (a, ProfTrie k a) -> Identity (Map k (a, ProfTrie k a))
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
M.traverseMaybeWithKey (Set k
-> k -> (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a))
forall k a.
Ord k =>
Set k
-> k -> (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a))
prune0 Set k
keep) Map k (a, ProfTrie k a)
sub of
    Identity Map k (a, ProfTrie k a)
sub
      | Map k (a, ProfTrie k a) -> Bool
forall a. Map k a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map k (a, ProfTrie k a)
sub, k
k k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set k
keep -> Maybe (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a))
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, ProfTrie k a)
forall a. Maybe a
Nothing
      | Bool
otherwise -> Maybe (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a))
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a)))
-> Maybe (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a))
forall a b. (a -> b) -> a -> b
$ (a, ProfTrie k a) -> Maybe (a, ProfTrie k a)
forall a. a -> Maybe a
Just (a
a, Map k (a, ProfTrie k a) -> ProfTrie k a
forall k a. Map k (a, ProfTrie k a) -> ProfTrie k a
ProfT Map k (a, ProfTrie k a)
sub)

prune :: (Ord k) => Set k -> ProfTrie k a -> ProfTrie k a
prune :: forall k a. Ord k => Set k -> ProfTrie k a -> ProfTrie k a
prune Set k
keep (ProfT Map k (a, ProfTrie k a)
m) = case (k -> (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a)))
-> Map k (a, ProfTrie k a) -> Identity (Map k (a, ProfTrie k a))
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
M.traverseMaybeWithKey (Set k
-> k -> (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a))
forall k a.
Ord k =>
Set k
-> k -> (a, ProfTrie k a) -> Identity (Maybe (a, ProfTrie k a))
prune0 Set k
keep) Map k (a, ProfTrie k a)
m of
  Identity Map k (a, ProfTrie k a)
sub -> Map k (a, ProfTrie k a) -> ProfTrie k a
forall k a. Map k (a, ProfTrie k a) -> ProfTrie k a
ProfT Map k (a, ProfTrie k a)
sub

topN :: (Ord k) => Int -> Map k Int -> [(k, Int)]
topN :: forall k. Ord k => Int -> Map k Int -> [(k, Int)]
topN Int
n0 = ([(k, Int)] -> k -> Int -> [(k, Int)])
-> [(k, Int)] -> Map k Int -> [(k, Int)]
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey (Int -> [(k, Int)] -> k -> Int -> [(k, Int)]
forall {t} {t} {t}.
(Eq t, Num t, Num t, Ord t) =>
t -> [(t, t)] -> t -> t -> [(t, t)]
ins Int
n0) []
  where
    ins :: t -> [(t, t)] -> t -> t -> [(t, t)]
ins t
_ [(t, t)]
pss t
_ t
0 = [(t, t)]
pss
    ins t
0 [(t, t)]
_ t
_ t
_ = []
    ins t
_ [] t
k t
i = [(t
k, t
i)]
    ins t
n pss :: [(t, t)]
pss@((t
k1, t
j) : [(t, t)]
ps) t
k0 t
i
      | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
j = (t
k0, t
i) (t, t) -> [(t, t)] -> [(t, t)]
forall a. a -> [a] -> [a]
: t -> [(t, t)] -> [(t, t)]
forall {t} {a}. (Eq t, Num t) => t -> [a] -> [a]
pop (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [(t, t)]
pss
      | Bool
otherwise = (t
k1, t
j) (t, t) -> [(t, t)] -> [(t, t)]
forall a. a -> [a] -> [a]
: t -> [(t, t)] -> t -> t -> [(t, t)]
ins (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [(t, t)]
ps t
k0 t
i

    pop :: t -> [a] -> [a]
pop t
0 [a]
_ = []
    pop t
_ [] = []
    pop t
n (a
p : [a]
ps) = a
p a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
pop (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [a]
ps

fraction :: Int -> Int -> Double
fraction :: Int -> Int -> Double
fraction Int
n Int
d = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d

fractions :: Int -> AggInfo k -> Int -> (Double, Double)
fractions :: forall k. Int -> AggInfo k -> Int -> (Double, Double)
fractions Int
total AggInfo k
ag Int
lo =
  (Int -> Int -> Double
fraction (AggInfo k -> Int
forall k. AggInfo k -> Int
inherited AggInfo k
ag) Int
total, Int -> Int -> Double
fraction Int
lo Int
total)

topNum :: Int
topNum :: Int
topNum = Int
25

-- Given a total count and a profile trie, calculates local and inherited
-- cost fractions of the positions in the trie, and prunes it to the
-- hottest spots.
aggregatePruned ::
  (Ord k) => Int -> ProfTrie k Int -> ProfTrie k (Double, Double)
aggregatePruned :: forall k.
Ord k =>
Int -> ProfTrie k Int -> ProfTrie k (Double, Double)
aggregatePruned Int
total (ProfT Map k (Int, ProfTrie k Int)
t) =
  case (k
 -> (Int, ProfTrie k Int)
 -> (AggInfo k, ((Double, Double), ProfTrie k (Double, Double))))
-> Map k (Int, ProfTrie k Int)
-> (AggInfo k,
    Map k ((Double, Double), ProfTrie k (Double, Double)))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey ((AggInfo k -> Int -> (Double, Double))
-> k
-> (Int, ProfTrie k Int)
-> (AggInfo k, ((Double, Double), ProfTrie k (Double, Double)))
forall k r.
Ord k =>
(AggInfo k -> Int -> r)
-> k -> (Int, ProfTrie k Int) -> (AggInfo k, (r, ProfTrie k r))
aggregateWith (Int -> AggInfo k -> Int -> (Double, Double)
forall k. Int -> AggInfo k -> Int -> (Double, Double)
fractions Int
total)) Map k (Int, ProfTrie k Int)
t of
    (AggInfo k
ag, Map k ((Double, Double), ProfTrie k (Double, Double))
t)
      | [(k, Int)]
top <- Int -> Map k Int -> [(k, Int)]
forall k. Ord k => Int -> Map k Int -> [(k, Int)]
topN Int
topNum (AggInfo k -> Map k Int
forall k. AggInfo k -> Map k Int
allOccs AggInfo k
ag) ->
          Set k -> ProfTrie k (Double, Double) -> ProfTrie k (Double, Double)
forall k a. Ord k => Set k -> ProfTrie k a -> ProfTrie k a
prune ([k] -> Set k
forall a. Ord a => [a] -> Set a
S.fromList ([k] -> Set k) -> [k] -> Set k
forall a b. (a -> b) -> a -> b
$ (k, Int) -> k
forall a b. (a, b) -> a
fst ((k, Int) -> k) -> [(k, Int)] -> [k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(k, Int)]
top) (ProfTrie k (Double, Double) -> ProfTrie k (Double, Double))
-> ProfTrie k (Double, Double) -> ProfTrie k (Double, Double)
forall a b. (a -> b) -> a -> b
$ Map k ((Double, Double), ProfTrie k (Double, Double))
-> ProfTrie k (Double, Double)
forall k a. Map k (a, ProfTrie k a) -> ProfTrie k a
ProfT Map k ((Double, Double), ProfTrie k (Double, Double))
t

aggregate ::
  (Ord k) =>
  Int ->
  ProfTrie k Int ->
  ([(k, Double)], ProfTrie k (Double, Double))
aggregate :: forall k.
Ord k =>
Int
-> ProfTrie k Int -> ([(k, Double)], ProfTrie k (Double, Double))
aggregate Int
total (ProfT Map k (Int, ProfTrie k Int)
t) =
  case (k
 -> (Int, ProfTrie k Int)
 -> (AggInfo k, ((Double, Double), ProfTrie k (Double, Double))))
-> Map k (Int, ProfTrie k Int)
-> (AggInfo k,
    Map k ((Double, Double), ProfTrie k (Double, Double)))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey ((AggInfo k -> Int -> (Double, Double))
-> k
-> (Int, ProfTrie k Int)
-> (AggInfo k, ((Double, Double), ProfTrie k (Double, Double)))
forall k r.
Ord k =>
(AggInfo k -> Int -> r)
-> k -> (Int, ProfTrie k Int) -> (AggInfo k, (r, ProfTrie k r))
aggregateWith (Int -> AggInfo k -> Int -> (Double, Double)
forall k. Int -> AggInfo k -> Int -> (Double, Double)
fractions Int
total)) Map k (Int, ProfTrie k Int)
t of
    (AggInfo k
ag, Map k ((Double, Double), ProfTrie k (Double, Double))
t) ->
      ( (Int -> Double) -> (k, Int) -> (k, Double)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Int -> Int -> Double) -> Int -> Int -> Double
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Double
fraction Int
total) ((k, Int) -> (k, Double)) -> [(k, Int)] -> [(k, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Map k Int -> [(k, Int)]
forall k. Ord k => Int -> Map k Int -> [(k, Int)]
topN Int
topNum (AggInfo k -> Map k Int
forall k. AggInfo k -> Map k Int
allOccs AggInfo k
ag),
        Map k ((Double, Double), ProfTrie k (Double, Double))
-> ProfTrie k (Double, Double)
forall k a. Map k (a, ProfTrie k a) -> ProfTrie k a
ProfT Map k ((Double, Double), ProfTrie k (Double, Double))
t
      )

-- Folds over a profile trie. The mapping function receives a reversed
-- path to the node, which can be used e.g. to see the node's key and to
-- calculate the depth in the trie.
foldMapTrie :: (Monoid m) => ((k, [k]) -> v -> m) -> ProfTrie k v -> m
foldMapTrie :: forall m k v. Monoid m => ((k, [k]) -> v -> m) -> ProfTrie k v -> m
foldMapTrie (k, [k]) -> v -> m
f = [k] -> ProfTrie k v -> m
descend []
  where
    descend :: [k] -> ProfTrie k v -> m
descend [k]
ks (ProfT Map k (v, ProfTrie k v)
m) =
      (k -> (v, ProfTrie k v) -> m) -> Map k (v, ProfTrie k v) -> m
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey
        (\k
k (v
v, ProfTrie k v
sub) -> (k, [k]) -> v -> m
f (k
k, [k]
ks) v
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> [k] -> ProfTrie k v -> m
descend (k
k k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k]
ks) ProfTrie k v
sub)
        Map k (v, ProfTrie k v)
m

showPercent :: Double -> String
showPercent :: Double -> String
showPercent Double
d = ShowS
pad ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d) String
"%"
  where
    pad :: ShowS
pad String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' ' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s

dispProfEntry ::
  (Ord k) =>
  PrettyPrintEnv ->
  Map Reference (Pretty ColorText) ->
  Map k Reference ->
  (k, [k]) ->
  (Double, Double) ->
  Pretty ColorText
dispProfEntry :: forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> (k, [k])
-> (Double, Double)
-> Pretty ColorText
dispProfEntry PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs (k
k, [k]
ks) (Double
inh, Double
self) =
  [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
    [ Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> (String -> Pretty ColorText) -> String -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pretty ColorText
forall a. IsString a => String -> a
fromString (String -> Pretty ColorText) -> String -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Double -> String
showPercent Double
inh,
      Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
4 (Pretty ColorText -> Pretty ColorText)
-> (String -> Pretty ColorText) -> String -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pretty ColorText
forall a. IsString a => String -> a
fromString (String -> Pretty ColorText) -> String -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Double -> String
showPercent Double
self,
      Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN (Width
2 Width -> Width -> Width
forall a. Num a => a -> a -> a
* Width
ind Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
4) (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> k
-> Pretty ColorText
forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> k
-> Pretty ColorText
dispKey PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs k
k,
      Pretty ColorText
"\n"
    ]
  where
    ind :: Width
ind = Int -> Width
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Width) -> Int -> Width
forall a b. (a -> b) -> a -> b
$ [k] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [k]
ks

dispFunc ::
  PrettyPrintEnv ->
  Map Reference (Pretty ColorText) ->
  Reference ->
  Pretty ColorText
dispFunc :: PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Reference
-> Pretty ColorText
dispFunc PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Reference
r
  | Just Pretty ColorText
pr <- Reference
-> Map Reference (Pretty ColorText) -> Maybe (Pretty ColorText)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Reference
r Map Reference (Pretty ColorText)
misc = Pretty ColorText
pr
  | Bool
otherwise =
      Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty ColorText)
-> (Referent -> Pretty (SyntaxText' Reference))
-> Referent
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' Reference)
prettyHashQualified (HashQualified Name -> Pretty (SyntaxText' Reference))
-> (Referent -> HashQualified Name)
-> Referent
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv -> Referent -> HashQualified Name
termName PrettyPrintEnv
ppe (Referent -> Pretty ColorText) -> Referent -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Reference -> Referent
Ref Reference
r

dispKey ::
  (Ord k) =>
  PrettyPrintEnv ->
  Map Reference (Pretty ColorText) ->
  Map k Reference ->
  k ->
  Pretty ColorText
dispKey :: forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> k
-> Pretty ColorText
dispKey PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs k
k = case k -> Map k Reference -> Maybe Reference
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k Reference
refs of
  Just Reference
r -> PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Reference
-> Pretty ColorText
dispFunc PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Reference
r
  Maybe Reference
Nothing -> Pretty ColorText
"<unknown>"

dispProfTrie ::
  (Ord k) =>
  PrettyPrintEnv ->
  Map Reference (Pretty ColorText) ->
  Map k Reference ->
  ProfTrie k (Double, Double) ->
  Pretty ColorText
dispProfTrie :: forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> ProfTrie k (Double, Double)
-> Pretty ColorText
dispProfTrie PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs ProfTrie k (Double, Double)
ag =
  ((k, [k]) -> (Double, Double) -> Pretty ColorText)
-> ProfTrie k (Double, Double) -> Pretty ColorText
forall m k v. Monoid m => ((k, [k]) -> v -> m) -> ProfTrie k v -> m
foldMapTrie (PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> (k, [k])
-> (Double, Double)
-> Pretty ColorText
forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> (k, [k])
-> (Double, Double)
-> Pretty ColorText
dispProfEntry PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs) ProfTrie k (Double, Double)
ag

dispTopEntry ::
  (Ord k) =>
  PrettyPrintEnv ->
  Map Reference (Pretty ColorText) ->
  Map k Reference ->
  (k, Double) ->
  Pretty ColorText
dispTopEntry :: forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> (k, Double)
-> Pretty ColorText
dispTopEntry PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs (k
k, Double
frac) =
  [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
    [ Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
3 (Pretty ColorText -> Pretty ColorText)
-> (String -> Pretty ColorText) -> String -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pretty ColorText
forall a. IsString a => String -> a
fromString (String -> Pretty ColorText) -> String -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Double -> String
showPercent Double
frac,
      Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
4 Pretty ColorText
dr,
      Pretty ColorText
"\n"
    ]
  where
    dr :: Pretty ColorText
    dr :: Pretty ColorText
dr
      | Just Reference
r <- k -> Map k Reference -> Maybe Reference
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k Reference
refs = PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Reference
-> Pretty ColorText
dispFunc PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Reference
r
      | Bool
otherwise = Pretty ColorText
"<unknown>"

dispTop ::
  (Ord k) =>
  PrettyPrintEnv ->
  Map Reference (Pretty ColorText) ->
  Map k Reference ->
  [(k, Double)] ->
  Pretty ColorText
dispTop :: forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> [(k, Double)]
-> Pretty ColorText
dispTop PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs = ((k, Double) -> Pretty ColorText)
-> [(k, Double)] -> Pretty ColorText
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> (k, Double)
-> Pretty ColorText
forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> (k, Double)
-> Pretty ColorText
dispTopEntry PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs)

overallHeader :: Pretty ColorText -> Int -> Pretty ColorText
overallHeader :: Pretty ColorText -> Int -> Pretty ColorText
overallHeader Pretty ColorText
label Int
samps = Pretty ColorText
label Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
": " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
dsamps Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
newline
  where
    dsamps :: Pretty ColorText
dsamps
      | Int
samps Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Pretty ColorText
"1 sample"
      | Bool
otherwise = String -> Pretty ColorText
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
samps) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" samples"

profileTopHeader :: Pretty ColorText
profileTopHeader :: Pretty ColorText
profileTopHeader =
  Pretty ColorText
"Hot Spots\n" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" Total Cost    Function\n"

profileTreeHeader :: Pretty ColorText
profileTreeHeader :: Pretty ColorText
profileTreeHeader =
  [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
    [ Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
9 Pretty ColorText
"Costs",
      Pretty ColorText
"Inherited      Local    Function Call Tree",
      Pretty ColorText
""
    ]

miniProfile ::
  (Ord k) =>
  PrettyPrintEnv ->
  Map Reference (Pretty ColorText) ->
  Profile k ->
  Pretty ColorText
miniProfile :: forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Profile k
-> Pretty ColorText
miniProfile PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc (Prof (Int
total, Int
wtotal) ProfTrie k (Int, Int)
tr Map k Reference
refs) =
  [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
    [ Pretty ColorText -> Int -> Pretty ColorText
overallHeader Pretty ColorText
"Complete Profile" Int
total,
      Pretty ColorText
profileTreeHeader Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> ProfTrie k (Double, Double)
-> Pretty ColorText
forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> ProfTrie k (Double, Double)
-> Pretty ColorText
dispProfTrie PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs ProfTrie k (Double, Double)
ag,
      Pretty ColorText
"",
      if Int
wtotal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        then
          Pretty ColorText -> Int -> Pretty ColorText
overallHeader Pretty ColorText
"Post-wakeup Profile" Int
wtotal
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
newline
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
profileTreeHeader
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> ProfTrie k (Double, Double)
-> Pretty ColorText
forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> ProfTrie k (Double, Double)
-> Pretty ColorText
dispProfTrie PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs ProfTrie k (Double, Double)
agw
        else Pretty ColorText
"Threads never missed ticks"
    ]
  where
    (ProfTrie k Int
full, ProfTrie k Int
wait) = ProfTrie k (Int, Int) -> (ProfTrie k Int, ProfTrie k Int)
forall k a b.
(Ord k, Eq a, Eq b, Num a, Num b) =>
ProfTrie k (a, b) -> (ProfTrie k a, ProfTrie k b)
demux ProfTrie k (Int, Int)
tr
    ag :: ProfTrie k (Double, Double)
ag = Int -> ProfTrie k Int -> ProfTrie k (Double, Double)
forall k.
Ord k =>
Int -> ProfTrie k Int -> ProfTrie k (Double, Double)
aggregatePruned Int
total ProfTrie k Int
full
    agw :: ProfTrie k (Double, Double)
agw = Int -> ProfTrie k Int -> ProfTrie k (Double, Double)
forall k.
Ord k =>
Int -> ProfTrie k Int -> ProfTrie k (Double, Double)
aggregatePruned Int
wtotal ProfTrie k Int
wait

fullProfile ::
  (Ord k) =>
  PrettyPrintEnv ->
  Map Reference (Pretty ColorText) ->
  Profile k ->
  (Pretty ColorText, Pretty ColorText)
fullProfile :: forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Profile k
-> (Pretty ColorText, Pretty ColorText)
fullProfile PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc (Prof (Int
total, Int
wtotal) ProfTrie k (Int, Int)
tr0 Map k Reference
refs) =
  ( Pretty ColorText -> Int -> ProfTrie k Int -> Pretty ColorText
make Pretty ColorText
"Complete Profile" Int
total ProfTrie k Int
comp,
    Pretty ColorText -> Int -> ProfTrie k Int -> Pretty ColorText
make Pretty ColorText
"Post-wakeup Profile" Int
wtotal ProfTrie k Int
wait
  )
  where
    (ProfTrie k Int
comp, ProfTrie k Int
wait) = ProfTrie k (Int, Int) -> (ProfTrie k Int, ProfTrie k Int)
forall k a b.
(Ord k, Eq a, Eq b, Num a, Num b) =>
ProfTrie k (a, b) -> (ProfTrie k a, ProfTrie k b)
demux ProfTrie k (Int, Int)
tr0

    make :: Pretty ColorText -> Int -> ProfTrie k Int -> Pretty ColorText
make Pretty ColorText
label Int
tot ProfTrie k Int
tr =
      Pretty ColorText -> Int -> Pretty ColorText
overallHeader Pretty ColorText
label Int
tot
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
newline
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
profileTopHeader
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> [(k, Double)]
-> Pretty ColorText
forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> [(k, Double)]
-> Pretty ColorText
dispTop PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs [(k, Double)]
top
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
newline
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
newline
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
profileTreeHeader
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> ProfTrie k (Double, Double)
-> Pretty ColorText
forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> ProfTrie k (Double, Double)
-> Pretty ColorText
dispProfTrie PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs ProfTrie k (Double, Double)
ag
      where
        ([(k, Double)]
top, ProfTrie k (Double, Double)
ag) = Int
-> ProfTrie k Int -> ([(k, Double)], ProfTrie k (Double, Double))
forall k.
Ord k =>
Int
-> ProfTrie k Int -> ([(k, Double)], ProfTrie k (Double, Double))
aggregate Int
tot ProfTrie k Int
tr

foldedProfile ::
  (Ord k) =>
  PrettyPrintEnv ->
  Map Reference (Pretty ColorText) ->
  Profile k ->
  (Text, Text)
foldedProfile :: forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText) -> Profile k -> (Text, Text)
foldedProfile PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc (Prof (Int, Int)
_ ProfTrie k (Int, Int)
tr Map k Reference
refs) =
  ( Width -> Pretty ColorText -> Text
toPlain Width
0 (Pretty ColorText -> Text) -> Pretty ColorText -> Text
forall a b. (a -> b) -> a -> b
$ ((k, [k]) -> Int -> Pretty ColorText)
-> ProfTrie k Int -> Pretty ColorText
forall m k v. Monoid m => ((k, [k]) -> v -> m) -> ProfTrie k v -> m
foldMapTrie (k, [k]) -> Int -> Pretty ColorText
f ProfTrie k Int
comp,
    Width -> Pretty ColorText -> Text
toPlain Width
0 (Pretty ColorText -> Text) -> Pretty ColorText -> Text
forall a b. (a -> b) -> a -> b
$ ((k, [k]) -> Int -> Pretty ColorText)
-> ProfTrie k Int -> Pretty ColorText
forall m k v. Monoid m => ((k, [k]) -> v -> m) -> ProfTrie k v -> m
foldMapTrie (k, [k]) -> Int -> Pretty ColorText
f ProfTrie k Int
wake
  )
  where
    dk :: k -> Pretty ColorText
dk = PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> k
-> Pretty ColorText
forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Map k Reference
-> k
-> Pretty ColorText
dispKey PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc Map k Reference
refs

    (ProfTrie k Int
comp, ProfTrie k Int
wake) = ProfTrie k (Int, Int) -> (ProfTrie k Int, ProfTrie k Int)
forall k a b.
(Ord k, Eq a, Eq b, Num a, Num b) =>
ProfTrie k (a, b) -> (ProfTrie k a, ProfTrie k b)
demux ProfTrie k (Int, Int)
tr

    f :: (k, [k]) -> Int -> Pretty ColorText
f (k
k, [k]
ks) Int
n =
      [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
        [ (Pretty ColorText -> k -> Pretty ColorText)
-> Pretty ColorText -> [k] -> Pretty ColorText
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Pretty ColorText
tx k
k -> k -> Pretty ColorText
dk k
k Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
";" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
tx) (k -> Pretty ColorText
dk k
k) [k]
ks,
          Pretty ColorText
" ",
          String -> Pretty ColorText
forall a. IsString a => String -> a
fromString (String -> Pretty ColorText) -> String -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n,
          Pretty ColorText
"\n"
        ]