Tidy up benchmarks a bit (#5209)

* Tidy up benchmarks a bit

- Compute evaluation context once and share between benchmarks more
  simply.
- Use simpler way of computing the evaluation context since we're not
  benchmarking it.
- Add some missing strictness to other benchmarks to check that they are
  measuring things correctly.

* Try this?

Author: michaelpj

plutus-benchmark/plutus-benchmark.cabal

@@ -272,7 +272,6 @@ benchmark validation
     , plutus-benchmark-common
     , plutus-core              ^>=1.3
     , plutus-ledger-api        ^>=1.3
-    , transformers
 
 ---------------- validation-decode ----------------
 
@@ -286,14 +285,14 @@ benchmark validation-decode
     , base                     >=4.9     && <5
     , bytestring
     , criterion                >=1.5.9.0
+    , deepseq
     , directory
     , filepath
     , flat                     <0.5
     , optparse-applicative
     , plutus-benchmark-common
     , plutus-core              ^>=1.3
     , plutus-ledger-api        ^>=1.3
-    , transformers
 
 ---------------- validation-full ----------------
 
@@ -307,14 +306,14 @@ benchmark validation-full
     , base                                                              >=4.9     && <5
     , bytestring
     , criterion                                                         >=1.5.9.0
+    , deepseq
     , directory
     , filepath
     , flat                                                              <0.5
     , optparse-applicative
     , plutus-benchmark-common
     , plutus-core                                                       ^>=1.3
     , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib}  ^>=1.3
-    , transformers
 
 ---------------- Cek cost model calibration ----------------
 

plutus-benchmark/validation/BenchCek.hs

@@ -17,10 +17,11 @@ import UntypedPlutusCore as UPLC
      `cabal bench -- plutus-benchmark:validation --benchmark-options crowdfunding`.
 -}
 main :: IO ()
-main = evaluate (force getEvalCtx) *> benchWith mkCekBM
- where
-   mkCekBM file program =
+main = do
+  evalCtx <- evaluate (force mkEvalCtx)
+  let mkCekBM file program =
        -- don't count the undebruijn . unflat cost
        -- `force` to try to ensure that deserialiation is not included in benchmarking time.
        let !nterm = force (toNamedDeBruijnTerm $ UPLC._progTerm $ unsafeUnflat file program)
-       in whnf evaluateCekLikeInProd nterm
+       in whnf (evaluateCekLikeInProd evalCtx) nterm
+  benchWith mkCekBM

plutus-benchmark/validation/BenchDec.hs

@@ -1,9 +1,11 @@
+{-# LANGUAGE BangPatterns #-}
 module Main where
 
 import PlutusLedgerApi.V1
 import UntypedPlutusCore qualified as UPLC
 
 import Common
+import Control.DeepSeq (force)
 import Control.Exception
 import Criterion
 import Data.ByteString as BS
@@ -32,7 +34,8 @@ main = benchWith mkDecBM
             (unsaturated, _args) = peelDataArguments fullyApplied
 
             -- we then have to re-encode and serialise it
-            benchScript :: SerialisedScript = serialiseUPLC $ UPLC.Program () v unsaturated
+            !(benchScript :: SerialisedScript) =
+                force (serialiseUPLC $ UPLC.Program () v unsaturated)
 
             -- Deserialize using 'FakeNamedDeBruijn' to get the fake names added
         in whnf (either throw id . assertScriptWellFormed (ProtocolVersion 6 0)

plutus-benchmark/validation/BenchFull.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 module Main where
 
 import PlutusCore.Evaluation.Machine.ExBudget
@@ -6,6 +7,7 @@ import PlutusLedgerApi.V1
 import UntypedPlutusCore qualified as UPLC
 
 import Common
+import Control.DeepSeq (force)
 import Criterion
 import Data.ByteString as BS
 import Data.Either
@@ -37,7 +39,7 @@ main = benchWith mkFullBM
             (term, args) = peelDataArguments body
 
             -- strictify and "short" the result cbor to create a real `SerialisedScript`
-            benchScript :: SerialisedScript = serialiseUPLC $ UPLC.Program () v term
+            !(benchScript :: SerialisedScript) = force (serialiseUPLC $ UPLC.Program () v term)
 
         in  whnf (\ script ->
                       (isRight $ snd $ evaluateScriptRestricting

plutus-benchmark/validation/Common.hs

@@ -3,25 +3,23 @@
 module Common (
     benchWith
     , unsafeUnflat
-    , getEvalCtx
+    , mkEvalCtx
     , evaluateCekLikeInProd
     , peelDataArguments
     , Term
     ) where
 
-import PlutusPrelude
-
 import PlutusBenchmark.Common (getConfig, getDataDir)
 import PlutusBenchmark.NaturalSort
 
 import PlutusCore qualified as PLC
 import PlutusCore.Builtin qualified as PLC
 import PlutusCore.Data qualified as PLC
+import PlutusCore.Default qualified as PLC (BuiltinVersion (DefaultFunV1))
 import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC
-import PlutusCore.Evaluation.Result
-import PlutusLedgerApi.Common (PlutusLedgerLanguage (PlutusV1), evaluateTerm)
-import PlutusLedgerApi.Common.Versions (ledgerLanguageIntroducedIn)
-import PlutusLedgerApi.V1 (EvaluationContext, ParamName, VerboseMode (..), mkEvaluationContext)
+import PlutusLedgerApi.Common (PlutusLedgerLanguage (PlutusV1), evaluateTerm,
+                               ledgerLanguageIntroducedIn, mkDynEvaluationContext)
+import PlutusLedgerApi.V1 (EvaluationContext, VerboseMode (..))
 import UntypedPlutusCore qualified as UPLC
 import UntypedPlutusCore.Evaluation.Machine.Cek qualified as UPLC
 
@@ -30,8 +28,6 @@ import Criterion.Main.Options (Mode, parseWith)
 import Criterion.Types (Config (..))
 import Options.Applicative
 
-import Control.Monad.Trans.Except
-import Control.Monad.Trans.Writer.Strict
 import Data.ByteString qualified as BS
 import Data.List (isPrefixOf)
 import Flat
@@ -136,28 +132,26 @@ benchWith act = do
         env (BS.readFile $ dir </> file) $ \scriptBS ->
             bench (dropExtension file) $ act file scriptBS
 
-getEvalCtx
-    :: Either
-            (UPLC.CekEvaluationException UPLC.NamedDeBruijn UPLC.DefaultUni UPLC.DefaultFun)
-            EvaluationContext
-getEvalCtx = do
-    costParams <-
-        maybe
-            (Left evaluationFailure)
-            (Right . take (length $ enumerate @ParamName) . toList)
-            PLC.defaultCostModelParams
-    either (const $ Left evaluationFailure) (Right . fst) . runExcept . runWriterT $
-        mkEvaluationContext costParams
-{-# NOINLINE getEvalCtx #-}
+-- | Create the evaluation context for the benchmarks. This doesn't exactly match how it's done
+-- on-chain, but that's okay because the evaluation context is cached by the ledger, so we're
+-- deliberately not including it in the benchmarks.
+mkEvalCtx :: EvaluationContext
+mkEvalCtx =
+    case PLC.defaultCostModelParams of
+        -- The validation benchmarks were all created from PlutusV1 scripts
+        Just p -> case mkDynEvaluationContext PLC.DefaultFunV1 p of
+            Right ec -> ec
+            Left err -> error $ show err
+        Nothing -> error "Couldn't get cost model params"
 
 -- | Evaluate a term as it would be evaluated using the on-chain evaluator.
 evaluateCekLikeInProd
-    :: UPLC.Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ()
+    :: EvaluationContext
+    -> UPLC.Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ()
     -> Either
             (UPLC.CekEvaluationException UPLC.NamedDeBruijn UPLC.DefaultUni UPLC.DefaultFun)
             (UPLC.Term UPLC.NamedDeBruijn UPLC.DefaultUni UPLC.DefaultFun ())
-evaluateCekLikeInProd term = do
-    evalCtx <- getEvalCtx
+evaluateCekLikeInProd evalCtx term = do
     let (getRes, _, _) =
             -- The validation benchmarks were all created from PlutusV1 scripts
             evaluateTerm UPLC.restrictingEnormous (ledgerLanguageIntroducedIn PlutusV1) Quiet evalCtx term

plutus-ledger-api/src/PlutusLedgerApi/Common.hs

@@ -28,6 +28,8 @@ module PlutusLedgerApi.Common
     , Version (..)
     , builtinsIntroducedIn
     , builtinsAvailableIn
+    , ledgerLanguageIntroducedIn
+    , ledgerLanguagesAvailableIn
 
       -- * Network's costing parameters
       {-| A less drastic approach (that does not rely on a HF)