Add assert equal tests.

plutus-core/executables/traceToStacks/Common.hs

@@ -0,0 +1,105 @@
+{-# LANGUAGE NamedFieldPuns   #-}
+{-# LANGUAGE TypeApplications #-}
+
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
+module Common where
+
+import Data.ByteString.Lazy qualified as BSL
+import Data.Csv qualified as CSV
+import Data.Foldable (toList)
+import Data.List (intercalate)
+import Data.Text qualified as T
+import Data.Vector qualified as V
+
+data StackFrame
+  = MkStackFrame
+  { -- | The variable name.
+    varName           :: T.Text,
+    -- | The resource value when it starts to be evaluated.
+    startVal          :: Integer,
+    -- | The resource spent on evaluating the functions it called.
+    valSpentCalledFun :: Integer
+  }
+  deriving (Show)
+
+data ProfileEvent =
+  MkProfileEvent Integer Transition T.Text
+
+data Transition =
+  Enter
+  | Exit
+
+-- | Represent one of the "folded" flamegraph lines, which include fns it's in and resource spent.
+data StackVal =
+  MkStackVal [T.Text] Integer
+  deriving (Eq)
+
+instance Show StackVal where
+  show (MkStackVal fns duration) =
+    intercalate
+      "; "
+      -- reverse to make the functions in the order correct for flamegraphs.
+      (reverse (map T.unpack fns))
+      <>" "
+      <>show duration
+
+data LogRow = LogRow String [Integer]
+
+instance CSV.FromRecord LogRow where
+    parseRecord v | V.length v == 0 = fail "empty"
+    parseRecord v = LogRow <$> CSV.parseField (V.unsafeHead v) <*> traverse CSV.parseField (V.toList $ V.unsafeTail v)
+
+processLog :: Int -> BSL.ByteString -> [StackVal]
+processLog valIx content =
+  let lEvents = case CSV.decode CSV.NoHeader content of
+        Left e   -> error e
+        Right es -> es
+  in getStacks (map (parseProfileEvent valIx) $ toList lEvents)
+
+parseProfileEvent :: Int -> LogRow -> ProfileEvent
+parseProfileEvent valIx (LogRow str vals) =
+  let val = vals !! (valIx-1)
+  in case words str of
+    [transition,var] ->
+      case transition of
+        "entering" -> MkProfileEvent val Enter (T.pack var)
+        "exiting" -> MkProfileEvent val Exit (T.pack var)
+        badLog -> error $
+          "parseProfileEvent: expecting \"entering\" or \"exiting\" but got "
+          <> show badLog
+    invalid -> error $
+      "parseProfileEvent: invalid log, expecting a form of [t1,t2,t3,transition,var] but got "
+      <> show invalid
+
+getStacks :: [ProfileEvent] -> [StackVal]
+getStacks = go []
+  where
+    go ::
+      [StackFrame] ->
+      [ProfileEvent] ->
+      [StackVal]
+    go curStack ((MkProfileEvent startVal Enter varName):tl) =
+          go
+            (MkStackFrame{varName, startVal, valSpentCalledFun = 0}:curStack)
+            tl
+    go (MkStackFrame {varName=curTopVar, startVal, valSpentCalledFun}:poppedStack) ((MkProfileEvent exitVal Exit var):tl)
+      | curTopVar == var =
+        let diffVal = exitVal - startVal
+            updateValSpent (hd@MkStackFrame{valSpentCalledFun}:tl) =
+              hd {valSpentCalledFun = valSpentCalledFun + diffVal}:tl
+            updateValSpent [] = []
+            updatedStack = updateValSpent poppedStack
+            -- this is quadratic but it's fine because we have to do quadratic
+            -- work anyway for fg and the input sizes are small.
+            fnsEntered = map varName updatedStack
+        in
+          -- resource spent on this function is the total resource spent
+          -- minus the resource spent on the function(s) it called.
+          MkStackVal (var:fnsEntered) (diffVal - valSpentCalledFun):go updatedStack tl
+    go _ ((MkProfileEvent _ Exit _):_) =
+      error "getStacks; go: tried to exit but couldn't."
+    go [] [] = []
+    go stacks [] = error $
+      "getStacks; go: stack " <> show stacks <> " isn't empty but the log is."
+

plutus-core/executables/traceToStacks/Main.hs

@@ -1,6 +1,3 @@
-{-# LANGUAGE NamedFieldPuns   #-}
-{-# LANGUAGE TypeApplications #-}
-
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
 
 {- | Executable for profiling. See note [Profiling instructions]-}
@@ -23,104 +20,11 @@ control this with the '--column' argument.
 
 module Main where
 
+import Common
 import Data.ByteString.Lazy qualified as BSL
-import Data.Csv qualified as CSV
-import Data.Foldable (toList)
 import Data.List (intercalate)
-import Data.Text qualified as T
-import Data.Vector qualified as V
 import Options.Applicative
 
-data StackFrame
-  = MkStackFrame
-  { -- | The variable name.
-    varName           :: T.Text,
-    -- | The resource value when it starts to be evaluated.
-    startVal          :: Integer,
-    -- | The resource spent on evaluating the functions it called.
-    valSpentCalledFun :: Integer
-  }
-  deriving (Show)
-
-data ProfileEvent =
-  MkProfileEvent Integer Transition T.Text
-
-data Transition =
-  Enter
-  | Exit
-
--- | Represent one of the "folded" flamegraph lines, which include fns it's in and resource spent.
-data StackVal =
-  MkStackVal [T.Text] Integer
-
-instance Show StackVal where
-  show (MkStackVal fns duration) =
-    intercalate
-      "; "
-      -- reverse to make the functions in the order correct for flamegraphs.
-      (reverse (map T.unpack fns))
-      <>" "
-      <>show duration
-
-data LogRow = LogRow String [Integer]
-
-instance CSV.FromRecord LogRow where
-    parseRecord v | V.length v == 0 = fail "empty"
-    parseRecord v = LogRow <$> CSV.parseField (V.unsafeHead v) <*> traverse CSV.parseField (V.toList $ V.unsafeTail v)
-
-processLog :: Int -> BSL.ByteString -> [StackVal]
-processLog valIx content =
-  let lEvents = case CSV.decode CSV.NoHeader content of
-        Left e   -> error e
-        Right es -> es
-  in getStacks (map (parseProfileEvent valIx) $ toList lEvents)
-
-parseProfileEvent :: Int -> LogRow -> ProfileEvent
-parseProfileEvent valIx (LogRow str vals) =
-  let val = vals !! (valIx-1)
-  in case words str of
-    [transition,var] ->
-      case transition of
-        "entering" -> MkProfileEvent val Enter (T.pack var)
-        "exiting" -> MkProfileEvent val Exit (T.pack var)
-        badLog -> error $
-          "parseProfileEvent: expecting \"entering\" or \"exiting\" but got "
-          <> show badLog
-    invalid -> error $
-      "parseProfileEvent: invalid log, expecting a form of [t1,t2,t3,transition,var] but got "
-      <> show invalid
-
-getStacks :: [ProfileEvent] -> [StackVal]
-getStacks = go []
-  where
-    go ::
-      [StackFrame] ->
-      [ProfileEvent] ->
-      [StackVal]
-    go curStack ((MkProfileEvent startVal Enter varName):tl) =
-          go
-            (MkStackFrame{varName, startVal, valSpentCalledFun = 0}:curStack)
-            tl
-    go (MkStackFrame {varName=curTopVar, startVal, valSpentCalledFun}:poppedStack) ((MkProfileEvent exitVal Exit var):tl)
-      | curTopVar == var =
-        let diffVal = exitVal - startVal
-            updateValSpent (hd@MkStackFrame{valSpentCalledFun}:tl) =
-              hd {valSpentCalledFun = valSpentCalledFun + diffVal}:tl
-            updateValSpent [] = []
-            updatedStack = updateValSpent poppedStack
-            -- this is quadratic but it's fine because we have to do quadratic
-            -- work anyway for fg and the input sizes are small.
-            fnsEntered = map varName updatedStack
-        in
-          -- resource spent on this function is the total resource spent
-          -- minus the resource spent on the function(s) it called.
-          MkStackVal (var:fnsEntered) (diffVal - valSpentCalledFun):go updatedStack tl
-    go _ ((MkProfileEvent _ Exit _):_) =
-      error "go: tried to exit but couldn't."
-    go [] [] = []
-    go stacks [] = error $
-      "getStacks; go: stack " <> show stacks <> " isn't empty but the log is."
-
 column :: Parser Int
 column = option auto
   (  long "column"