Benchmark.Arrays

Author: Unisay

plutus-core/cost-model/budgeting-bench/Benchmarks/Arrays.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE BlockArguments   #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Benchmarks.Arrays (makeBenchmarks) where
+
+import Prelude
+
+import Common (createOneTermBuiltinBench, createTwoTermBuiltinBench)
+import Control.Monad (replicateM)
+import Criterion.Main (Benchmark)
+import Data.Vector.Strict (Vector)
+import Data.Vector.Strict qualified as Vector
+import PlutusCore.Builtin (mkTyBuiltin)
+import PlutusCore.Core (Type)
+import PlutusCore.Default (DefaultFun (IndexArray, LengthOfArray, ListToArray), DefaultUni)
+import PlutusCore.Name.Unique (TyName)
+import System.Random.Stateful (StdGen, UniformRange (uniformRM), runStateGen_)
+
+--------------------------------------------------------------------------------
+-- Benchmarks ------------------------------------------------------------------
+
+makeBenchmarks :: StdGen -> [Benchmark]
+makeBenchmarks gen =
+  [ benchLengthOfArray gen
+  , benchListToArray gen
+  , benchIndexArray gen
+  ]
+
+benchLengthOfArray :: StdGen -> Benchmark
+benchLengthOfArray gen =
+  createOneTermBuiltinBench LengthOfArray [tyArrayOfInteger] listOfArrays
+ where
+  listOfArrays :: [Vector Integer] =
+    runStateGen_ gen \g -> replicateM 100 do
+      arraySize <- uniformRM (1, 100) g
+      Vector.replicateM arraySize (uniformRM intRange g)
+
+benchListToArray :: StdGen -> Benchmark
+benchListToArray gen =
+  createOneTermBuiltinBench ListToArray [tyListOfInteger] listOfLists
+ where
+  listOfLists :: [[Integer]] =
+    runStateGen_ gen \g -> replicateM 100 do
+      listSize <- uniformRM (1, 100) g
+      replicateM listSize (uniformRM intRange g)
+
+benchIndexArray :: StdGen -> Benchmark
+benchIndexArray gen =
+  createTwoTermBuiltinBench IndexArray [tyArrayOfInteger] arrays idxs
+ where
+  (arrays :: [Vector Integer], idxs :: [Integer]) =
+    unzip $ runStateGen_ gen \g -> replicateM 100 do
+      arraySize <- uniformRM (1, 100) g
+      vec <- Vector.replicateM arraySize (uniformRM intRange g)
+      idx <- uniformRM (0, arraySize - 1) g
+      pure (vec, fromIntegral idx)
+
+--------------------------------------------------------------------------------
+-- Helpers ---------------------------------------------------------------------
+
+tyListOfInteger :: Type TyName DefaultUni ()
+tyListOfInteger = mkTyBuiltin @_ @[Integer] ()
+
+tyArrayOfInteger :: Type TyName DefaultUni ()
+tyArrayOfInteger = mkTyBuiltin @_ @(Vector Integer) ()
+
+intRange :: (Integer, Integer)
+intRange =
+  ( fromIntegral (minBound @Int) - 10
+  , fromIntegral (maxBound @Int) + 10
+  )

plutus-core/cost-model/budgeting-bench/Common.hs

@@ -84,7 +84,9 @@ benchWith
 -- the result, so e.g. 'evaluateCek' won't work properly because it returns a pair whose components
 -- won't be evaluated by 'whnf'. We can't use 'nf' because it does too much work: for instance if it
 -- gets back a 'Data' value it'll traverse all of it.
-benchWith params name term = bench name $ whnf (evaluateCekNoEmit params) term
+benchWith params name term =
+  bench name $
+    whnf (unsafeSplitStructuralOperational . evaluateCekNoEmit params) term
 
 {- Benchmark with the most recent CekParameters -}
 benchDefault :: String -> PlainTerm DefaultUni DefaultFun -> Benchmark

plutus-core/cost-model/budgeting-bench/Main.hs

@@ -3,6 +3,7 @@ module Main (main) where
 
 import CriterionExtensions (BenchmarkingPhase (Continue, Start), criterionMainWith)
 
+import Benchmarks.Arrays qualified
 import Benchmarks.Bitwise qualified
 import Benchmarks.Bool qualified
 import Benchmarks.ByteStrings qualified
@@ -53,6 +54,7 @@ main = do
         <> Benchmarks.Data.makeBenchmarks        gen
         <> Benchmarks.Integers.makeBenchmarks    gen
         <> Benchmarks.Lists.makeBenchmarks       gen
+        <> Benchmarks.Arrays.makeBenchmarks      gen
         <> Benchmarks.Misc.makeBenchmarks        gen
         <> Benchmarks.Pairs.makeBenchmarks       gen
         <> Benchmarks.Strings.makeBenchmarks     gen

plutus-core/plutus-core.cabal

@@ -888,6 +888,7 @@ executable cost-model-budgeting-bench
   import:         lang
   main-is:        Main.hs
   other-modules:
+    Benchmarks.Arrays
     Benchmarks.Bitwise
     Benchmarks.Bool
     Benchmarks.ByteStrings
@@ -924,6 +925,7 @@ executable cost-model-budgeting-bench
     , random
     , text
     , time
+    , vector
 
 -- This reads CSV data generated by cost-model-budgeting-bench, uses R to build
 -- the cost models for built-in functions, and saves them in a specified

plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs

@@ -2113,7 +2113,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
               DefaultUniArray _uniA -> pure $ Vector.length vec
               _ -> throwing _StructuralUnliftingError "Expected an array but got something else"
           {-# INLINE lengthOfArrayDenotation #-}
-        in makeBuiltinMeaning lengthOfArrayDenotation (runCostingFunOneArgument . unimplementedCostingFun)
+        in makeBuiltinMeaning lengthOfArrayDenotation (runCostingFunOneArgument . paramLengthOfArray)
 
     toBuiltinMeaning _semvar ListToArray =
       let listToArrayDenotation :: SomeConstant uni [a] -> BuiltinResult (Opaque val (Vector a))
@@ -2122,7 +2122,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
               DefaultUniList uniA -> pure $ fromValueOf (DefaultUniArray uniA) $ Vector.fromList xs
               _ -> throwing _StructuralUnliftingError  "Expected an array but got something else"
           {-# INLINE listToArrayDenotation #-}
-        in makeBuiltinMeaning listToArrayDenotation (runCostingFunOneArgument . unimplementedCostingFun)
+        in makeBuiltinMeaning listToArrayDenotation (runCostingFunOneArgument . paramListToArray)
 
     toBuiltinMeaning _semvar IndexArray =
       let indexArrayDenotation :: SomeConstant uni (Vector a) -> Int -> BuiltinResult (Opaque val a)
@@ -2138,7 +2138,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
                     -- message, so we don't need to repeat them here.
                 throwing _StructuralUnliftingError "Expected an array but got something else"
           {-# INLINE indexArrayDenotation #-}
-        in makeBuiltinMeaning indexArrayDenotation (runCostingFunTwoArguments . unimplementedCostingFun)
+        in makeBuiltinMeaning indexArrayDenotation (runCostingFunTwoArguments . paramIndexArray)
 
     -- See Note [Inlining meanings of builtins].
     {-# INLINE toBuiltinMeaning #-}