profile function calls + info

src/Pact/Eval.hs

@@ -72,6 +72,7 @@ import Data.Text (Text, pack)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Set as Set
+import Data.Time
 
 import Pact.Gas
 import Pact.Runtime.Capabilities
@@ -1129,7 +1130,14 @@ resolveArg ai as i = case as ^? ix i of
   Just i' -> i'
 
 appCall :: Pretty t => FunApp -> Info -> [Term t] -> Eval e a -> Eval e a
-appCall fa ai as = call (StackFrame (_faName fa) ai (Just (fa,map abbrev as)))
+appCall fa ai as act = do
+  t1 <- liftIO $ getCurrentTime
+  out <- call (StackFrame (_faName fa) ai (Just (fa,map abbrev as))) act
+  t2 <- liftIO $ getCurrentTime
+  let diffTime = t1 `diffUTCTime` t2
+  ref <- view eeProfilingRef
+  liftIO $ modifyIORef' ref (ProfFunctionCall (_faName fa) diffTime ai :)
+  pure out
 
 enforcePactValue :: Pretty n => (Term n) -> Eval e PactValue
 enforcePactValue t = case toPactValue t of

src/Pact/Interpreter.hs

@@ -191,6 +191,7 @@ setupEvalEnv
 setupEvalEnv dbEnv ent mode msgData refStore gasEnv np spv pd ec = do
   gasRef <- newIORef mempty
   warnRef <- newIORef mempty
+  profRef <- newIORef []
   pure EvalEnv {
     _eeRefStore = refStore
   , _eeMsgSigs = mkMsgSigs $ mdSigners msgData
@@ -212,6 +213,7 @@ setupEvalEnv dbEnv ent mode msgData refStore gasEnv np spv pd ec = do
   , _eeAdvice = def
   , _eeInRepl = False
   , _eeWarnings = warnRef
+  , _eeProfilingRef = profRef
   }
   where
     mkMsgSigs ss = M.fromList $ map toPair ss

src/Pact/Repl.hs

@@ -134,6 +134,7 @@ initEvalEnv ls = do
   mv <- newMVar ls
   gasRef <- newIORef mempty
   warnRef <- newIORef mempty
+  profRef <- newIORef mempty
   return $ EvalEnv
     { _eeRefStore = RefStore nativeDefs
     , _eeMsgSigs = mempty
@@ -155,6 +156,7 @@ initEvalEnv ls = do
     , _eeAdvice = def
     , _eeInRepl = True
     , _eeWarnings = warnRef
+    , _eeProfilingRef = profRef
     }
   where
     spvs mv = set spvSupport (spv mv) noSPVSupport

src/Pact/Types/Gas.hs

@@ -34,6 +34,7 @@ module Pact.Types.Gas
   , geGasLimit
   , geGasPrice
   , geGasModel
+  , ProfilingExec(..)
   ) where
 
 import Control.DeepSeq (NFData)
@@ -60,6 +61,7 @@ import Pact.Types.Term
 import Pact.Types.Namespace
 import Pact.Parse
 import Pact.Types.SizeOf(Bytes, SizeOfVersion)
+import Data.Time
 
 import qualified Pact.JSON.Encode as J
 
@@ -305,3 +307,7 @@ data GasEnv = GasEnv
   , _geGasModel :: !GasModel
   }
 makeLenses ''GasEnv
+
+data ProfilingExec
+  = ProfFunctionCall !Text !NominalDiffTime Info
+  deriving Show

src/Pact/Types/Purity.hs

@@ -101,6 +101,7 @@ mkPureEnv holder purity readRowImpl env@EvalEnv{..} = do
     _eeAdvice
     _eeInRepl
     _eeWarnings
+    _eeProfilingRef
 
 -- | Operationally creates the sysread-only environment.
 -- Phantom type and typeclass assigned in "runXXX" functions.

src/Pact/Types/Runtime.hs

@@ -59,7 +59,7 @@ module Pact.Types.Runtime
    liftIO,
    eAdvise,
    isOffChainForkedError,
-   OnChainErrorState(..)
+   OnChainErrorState(..), eeProfilingRef
    ) where
 
 
@@ -294,6 +294,8 @@ data EvalEnv e = EvalEnv {
     , _eeInRepl :: !Bool
       -- | Warnings ref
     , _eeWarnings :: !(IORef (Set PactWarning))
+      -- | Stuff
+    , _eeProfilingRef :: !(IORef [ProfilingExec])
     }
 makeLenses ''EvalEnv