{-# LANGUAGE ExistentialQuantification #-}

-- | What the runtime records when it profiles a program. The reports made
-- from it are in "Unison.Codebase.Runtime.Profile".
module Unison.Runtime.Profile
  ( ProfTrie (..),
    Profile (..),
    SomeProfile (..),
    ProfileSpec (..),
    emptyProfile,
    singlePath,
    addPath,
  )
where

import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M
import Unison.Reference

-- 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)

-- 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