diff --git a/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-tx-plugin.nix b/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-tx-plugin.nix index e6385db9c65..e2b3561e1bf 100644 --- a/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-tx-plugin.nix +++ b/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-tx-plugin.nix @@ -86,6 +86,7 @@ (hsPkgs."serialise" or (errorHandler.buildDepError "serialise")) (hsPkgs."template-haskell" or (errorHandler.buildDepError "template-haskell")) (hsPkgs."text" or (errorHandler.buildDepError "text")) + (hsPkgs."time" or (errorHandler.buildDepError "time")) (hsPkgs."lens" or (errorHandler.buildDepError "lens")) ]; buildable = true; diff --git a/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-tx-plugin.nix b/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-tx-plugin.nix index e6385db9c65..e2b3561e1bf 100644 --- a/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-tx-plugin.nix +++ b/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-tx-plugin.nix @@ -86,6 +86,7 @@ (hsPkgs."serialise" or (errorHandler.buildDepError "serialise")) (hsPkgs."template-haskell" or (errorHandler.buildDepError "template-haskell")) (hsPkgs."text" or (errorHandler.buildDepError "text")) + (hsPkgs."time" or (errorHandler.buildDepError "time")) (hsPkgs."lens" or (errorHandler.buildDepError "lens")) ]; buildable = true; diff --git a/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-tx-plugin.nix b/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-tx-plugin.nix index e6385db9c65..e2b3561e1bf 100644 --- a/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-tx-plugin.nix +++ b/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-tx-plugin.nix @@ -86,6 +86,7 @@ (hsPkgs."serialise" or (errorHandler.buildDepError "serialise")) (hsPkgs."template-haskell" or (errorHandler.buildDepError "template-haskell")) (hsPkgs."text" or (errorHandler.buildDepError "text")) + (hsPkgs."time" or (errorHandler.buildDepError "time")) (hsPkgs."lens" or (errorHandler.buildDepError "lens")) ]; buildable = true; diff --git a/plutus-tx-plugin/executables/profile/Main.hs b/plutus-tx-plugin/executables/profile/Main.hs index b71efcf8090..f4f6226a8f8 100644 --- a/plutus-tx-plugin/executables/profile/Main.hs +++ b/plutus-tx-plugin/executables/profile/Main.hs @@ -25,12 +25,15 @@ import qualified PlutusCore.Default as PLC import Control.Lens.Combinators (_2) import Control.Lens.Getter (view) import Data.List (stripPrefix, uncons) +import Data.Maybe (fromJust) import Data.Proxy (Proxy (Proxy)) import Data.Text (Text) +import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime) import Prettyprinter.Internal (pretty) import Prettyprinter.Render.Text (hPutDoc) import System.IO (IOMode (WriteMode), withFile) + fact :: Integer -> Integer fact n = if Builtins.equalsInteger n 0 @@ -99,36 +102,59 @@ writeLogToFile fileName values = do filePath WriteMode (\h -> hPutDoc h log) - -- processed <- processLog filePath - -- TODO - -- writeFile (filePath<>".stacks") processed + processed <- processLog filePath + writeFile (filePath<>".stacks") $ show (map show processed) pure () --- processLog :: FilePath -> IO [[String]] +processLog :: FilePath -> IO [(NominalDiffTime,String)] processLog file = do content <- readFile file + -- lEvents is in the form of [[t1,t2,t3,entering/exiting,var]]. Time is chopped to 3 parts. let lEvents = map - -- @(take i items ++ drop (1 + i) items)@ drop "UTC]" from the list -- @tail@ strips "[" in the first line and "," in the other lines, -- @words@ turns it to a list of [time, enter/exit, var] (tail . words) -- turn to a list of events (lines content) - pure $ - -- stripe “[“ and add “ UTC” to the time so I can use read instance of UTCTime - map (stripPrefix "[" . (++ " UTC") . head ) $take 1 lEvents ++ drop 2 lEvents + lTimeRaw = map unwords (take 3 lEvents) + lTime = + map + -- stripe “[“ and add “ UTC” to the time so I can use read instance of UTCTime + (fromJust . stripPrefix "[" . (++ " UTC") . head ) + lTimeEvents + lUTC (hd:tl) = (read hd :: UTCTime) : lUTC tl + lUTC [] = [] + -- list of enter/exit + lEnterOrExit = map (head . tail) lTimeEvents + -- list of var + lVar = map (head . tail . tail) lTimeEvents + lTripleTimeVar = zip3 (lUTC lTime) lEnterOrExit lVar + getStacks curStack (hd:tl) = case hd of + (time, "entering", var) -> getStacks ((time, var):curStack) tl + (time, "exiting", var) -> + let curTopVar = snd $ head curStack + curTopTime = fst $ head curStack + in + if curTopVar == var then + let updatedStack = tail curStack in + (diffUTCTime time curTopTime,var):getStacks updatedStack tl + else error "getStacks: exiting a stack that is not on top of the stack." + (time, what, _) -> error $ show what ++ "getStacks: log processed incorrectly. Expecting \"entering\" or \"exiting\"." + getStacks [] [] = [] + getStacks _ [] = error "getStacks: stack isn't empty but log is." + pure $ getStacks [] lTripleTimeVar main :: IO () main = do writeLogToFile "fib4" [toUPlc fibTest, toUPlc $ plc (Proxy @"4") (4::Integer)] - writeLogToFile "fact4" [toUPlc factTest, toUPlc $ plc (Proxy @"4") (4::Integer)] - writeLogToFile "addInt" [toUPlc addIntTest] - writeLogToFile "addInt3" [toUPlc addIntTest, toUPlc $ plc (Proxy @"3") (3::Integer)] - writeLogToFile "letInFun" [toUPlc letInFunTest, toUPlc $ plc (Proxy @"1") (1::Integer), toUPlc $ plc (Proxy @"4") (4::Integer)] - writeLogToFile "letInFunMoreArg" [toUPlc letInFunMoreArgTest, toUPlc $ plc (Proxy @"1") (1::Integer), toUPlc $ plc (Proxy @"4") (4::Integer), toUPlc $ plc (Proxy @"5") (5::Integer)] - writeLogToFile "id" [toUPlc idTest] - writeLogToFile "swap" [toUPlc swapTest] + -- writeLogToFile "fact4" [toUPlc factTest, toUPlc $ plc (Proxy @"4") (4::Integer)] + -- writeLogToFile "addInt" [toUPlc addIntTest] + -- writeLogToFile "addInt3" [toUPlc addIntTest, toUPlc $ plc (Proxy @"3") (3::Integer)] + -- writeLogToFile "letInFun" [toUPlc letInFunTest, toUPlc $ plc (Proxy @"1") (1::Integer), toUPlc $ plc (Proxy @"4") (4::Integer)] + -- writeLogToFile "letInFunMoreArg" [toUPlc letInFunMoreArgTest, toUPlc $ plc (Proxy @"1") (1::Integer), toUPlc $ plc (Proxy @"4") (4::Integer), toUPlc $ plc (Proxy @"5") (5::Integer)] + -- writeLogToFile "id" [toUPlc idTest] + -- writeLogToFile "swap" [toUPlc swapTest] diff --git a/plutus-tx-plugin/plutus-tx-plugin.cabal b/plutus-tx-plugin/plutus-tx-plugin.cabal index 2f2b0674465..9e80c2028c2 100644 --- a/plutus-tx-plugin/plutus-tx-plugin.cabal +++ b/plutus-tx-plugin/plutus-tx-plugin.cabal @@ -153,4 +153,5 @@ executable profile serialise -any, template-haskell -any, text -any, + time -any, lens -any, \ No newline at end of file