Benchmark.Arrays

Author: Unisay

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

@@ -0,0 +1,74 @@
+{-# LANGUAGE BlockArguments   #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Benchmarks.Arrays (makeBenchmarks) where
+
+import Prelude
+
+import Common (createOneTermBuiltinBench, createTwoTermBuiltinBenchElementwise)
+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 =
+  createTwoTermBuiltinBenchElementwise
+    IndexArray
+    [tyArrayOfInteger]
+    (zip 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/cost-model/create-cost-model/BuiltinMemoryModels.hs

@@ -173,8 +173,8 @@ builtinMemoryModels = BuiltinCostModelBase
   -- paramCaseList
   -- paramCaseData
   , paramDropList                        = Id $ ModelTwoArgumentsConstantCost 4
-  , paramLengthOfArray                   = Id $ ModelOneArgumentConstantCost    99
-  , paramListToArray                     = Id $ ModelOneArgumentConstantCost    99
-  , paramIndexArray                      = Id $ ModelTwoArgumentsConstantCost   99
+  , paramLengthOfArray                   = Id $ ModelOneArgumentConstantCost 10
+  , paramListToArray                     = Id $ ModelOneArgumentLinearInX identityFunction
+  , paramIndexArray                      = Id $ ModelTwoArgumentsConstantCost 32
   }
   where identityFunction = OneVariableLinearFunction 0 1

plutus-core/cost-model/data/models.R

@@ -785,7 +785,7 @@ modelFun <- function(path) {
 
     dropListModel   <- linearInX     ("DropList")
 
-    ## Arrays - TEMPORARY, but probably right
+    ## Arrays 
     lengthOfArrayModel        <- constantModel ("LengthOfArray")
     listToArrayModel          <- linearInX ("ListToArray")
     indexArrayModel           <- constantModel ("IndexArray")

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

@@ -23,7 +23,8 @@ import PlutusCore.Data (Data (..))
 import PlutusCore.Default.Universe
 import PlutusCore.Evaluation.Machine.BuiltinCostModel
 import PlutusCore.Evaluation.Machine.ExBudgetStream (ExBudgetStream)
-import PlutusCore.Evaluation.Machine.ExMemoryUsage (ExMemoryUsage, IntegerCostedLiterally (..),
+import PlutusCore.Evaluation.Machine.ExMemoryUsage (ArrayCostedByLength, ExMemoryUsage,
+                                                    IntegerCostedLiterally (..),
                                                     ListCostedByLength (..),
                                                     NumBytesCostedAsNumWords (..), memoryUsage,
                                                     singletonRose)
@@ -2107,25 +2108,30 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
             (runCostingFunTwoArguments . paramDropList)
 
     toBuiltinMeaning _semvar LengthOfArray =
-      let lengthOfArrayDenotation :: SomeConstant uni (Vector a) -> BuiltinResult Int
+      let lengthOfArrayDenotation :: SomeConstant uni (ArrayCostedByLength a) -> BuiltinResult Int
           lengthOfArrayDenotation (SomeConstant (Some (ValueOf uni vec))) =
             case uni of
               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))
+      let listToArrayDenotation
+            :: SomeConstant uni (ListCostedByLength a)
+            -> BuiltinResult (Opaque val (Vector a))
           listToArrayDenotation (SomeConstant (Some (ValueOf uniListA xs))) =
             case uniListA of
               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)
+      let indexArrayDenotation
+            :: SomeConstant uni (ArrayCostedByLength a)
+            -> Int
+            -> BuiltinResult (Opaque val a)
           indexArrayDenotation (SomeConstant (Some (ValueOf uni vec))) n =
             case uni of
               DefaultUniArray arg -> do
@@ -2138,7 +2144,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 #-}