{-# 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 Numeric
import Unison.PrettyPrintEnv
import Unison.Reference
import Unison.Referent
import Unison.Syntax.NamePrinter
import Unison.Util.Pretty as P
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)
data Profile k
= Prof !(Int, Int) !(ProfTrie k (Int, Int)) !(Map k Reference)
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)
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
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
{
forall k. AggInfo k -> Int
inherited :: Int,
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
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
)
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
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
=
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
=
[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 ->
(String, String)
foldedProfile :: forall k.
Ord k =>
PrettyPrintEnv
-> Map Reference (Pretty ColorText)
-> Profile k
-> (String, String)
foldedProfile PrettyPrintEnv
ppe Map Reference (Pretty ColorText)
misc (Prof (Int, Int)
_ ProfTrie k (Int, Int)
tr Map k Reference
refs) =
( Width -> Pretty ColorText -> String
toPlain Width
0 (Pretty ColorText -> String) -> Pretty ColorText -> String
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 -> String
toPlain Width
0 (Pretty ColorText -> String) -> Pretty ColorText -> String
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"
]