Skip to content

Commit

Permalink
Output to framegraph stack format.
Browse files Browse the repository at this point in the history
  • Loading branch information
thealmarty committed Sep 28, 2021
1 parent 3071f5f commit 3b11901
Showing 1 changed file with 12 additions and 4 deletions.
16 changes: 12 additions & 4 deletions plutus-tx-plugin/executables/profile/Main.hs
Expand Up @@ -104,7 +104,7 @@ writeLogToFile fileName values = do
WriteMode
(\h -> hPutDoc h log)
processed <- processLog filePath
writeFile (filePath<>".stacks") $ show processed
writeFile (filePath<>".stacks") processed
pure ()

data Stacks
Expand All @@ -117,6 +117,7 @@ data Stacks
deriving (Show)

-- processLog :: FilePath -> IO [([String],String, NominalDiffTime)]
processLog :: FilePath -> IO [Char]
processLog file = do
content <- readFile file
-- lEvents is in the form of [[t1,t2,t3,entering/exiting,var]]. Time is chopped to 3 parts.
Expand All @@ -134,7 +135,14 @@ processLog file = do
lVar = map (!! 4) lEvents
lTripleTimeVar = zip3 (lUTC lTime) lEnterOrExit lVar
stacks = getStacks [] lTripleTimeVar
pure $ map (intercalate "; " . fst) stacks
fnsStacks = map (intercalate "; " . fst) stacks
stacksFgFormat (hdf:tlf) (hdt:tlt)=
hdf<>" "<>show hdt<>"\n":stacksFgFormat tlf tlt
stacksFgFormat _ _ = []
pure $
concat $
reverse $
stacksFgFormat fnsStacks (map ((*1000000) . snd) stacks)

lUTC :: [String] -> [UTCTime]
lUTC = map (read :: String -> UTCTime)
Expand All @@ -145,7 +153,7 @@ getStacks ::
-- | the input log which is processed to a list of (UTCTime, entering/exiting, var name)
[(UTCTime, String, String)] ->
-- | a list of (fns it's in, var/function, the time spent on it)
[([String],NominalDiffTime)]
[([String],Double)]
getStacks curStack (hd:tl) =
case hd of
(time, "entering", var) ->
Expand All @@ -167,7 +175,7 @@ getStacks curStack (hd:tl) =
in
-- time spent on this function is the total time spent
-- minus the time spent on the functions it called.
(fnsEntered <> [var], duration - curTimeSpent):getStacks updatedStack tl
(fnsEntered <> [var], realToFrac (duration - curTimeSpent)::Double):getStacks updatedStack tl
else error "getStacks: exiting a stack that is not on top of the stack."
(_, what, _) -> error $
show what <>
Expand Down

0 comments on commit 3b11901

Please sign in to comment.