diff --git a/plutus-core/cost-model/budgeting-bench/Benchmarks/Values.hs b/plutus-core/cost-model/budgeting-bench/Benchmarks/Values.hs new file mode 100644 index 00000000000..dafe28a68e7 --- /dev/null +++ b/plutus-core/cost-model/budgeting-bench/Benchmarks/Values.hs @@ -0,0 +1,115 @@ +module Benchmarks.Values ( + makeBenchmarks, +) where + +import Prelude + +import Common + +import PlutusCore (DefaultFun (InsertCoin, LookupCoin, UnValueData, ValueContains, ValueData)) +import PlutusCore.Value (Value) +import PlutusCore.Value qualified as Value + +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.State.Strict (State, StateT, evalState, gets, modify) +import Criterion.Main (Benchmark) +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.Text qualified as Text +import Data.Text.Encoding (encodeUtf8) +import Data.Word (Word8) +import System.Random.Stateful (StateGenM, StatefulGen, StdGen, UniformRange (uniformRM), + runStateGenT_, uniformByteStringM) + +makeBenchmarks :: StdGen -> [Benchmark] +makeBenchmarks gen = + [ benchInsertCoin gen + -- , benchUnionValue gen + ] + +newtype PolicyId = PolicyId ByteString +newtype TokenName = TokenName ByteString +newtype Amount = Amount Integer +type Counter = Integer + +data GenState = GenState + { policyIdCounter :: Counter + , tokenNameCounter :: Counter + } + +type BenchState = StateT StdGen (State GenState) + +-- | An insertCoin benchmark is a concrete set of arguments we apply to the +-- InsertCoin builtin function to measure its runtime cost. +data InsertCoinBenchmark = InsertCoinBenchmark + { icPolicyId :: PolicyId + , icTokenName :: TokenName + , icAmount :: Amount + , icValue :: Value + } + +icToRawTuple :: InsertCoinBenchmark -> (ByteString, ByteString, Integer, Value) +icToRawTuple (InsertCoinBenchmark (PolicyId p) (TokenName t) (Amount a) v) = (p, t, a, v) + +benchInsertCoin :: StdGen -> Benchmark +benchInsertCoin gen = + createFourTermBuiltinBenchElementwiseWithWrappers + (id, id, id, id) -- TODO: use proper wrappers + InsertCoin + [] + (icToRawTuple <$> insertCoinBenchGen gen) + +-- | Generate a set of benchmarks for the InsertCoin builtin function. +-- It includes the following scenarios: +-- 1. Inserting into an empty Value. +-- 2. Inserting a new TokenName into an existing PolicyId. Randomly extracting a PolicyId from the Value. +-- 3. Inserting into an existing TokenName. Randomly extracting a (PolicyId, TokenName) pair from the Value. +-- 4. Inserting a new PolicyId. +-- 5. Deleting a TokenName by inserting a 0 amount. Randomly extracting a (PolicyId, TokenName) pair from the Value. +-- 6. Deleting a PolicyId by inserting a 0 amount into its last TokenName. Should generate a Value with multiple such PolicyIds, and randomly picking which PolicyId to delete. +-- We're interested in the worst case performance, so we'll use the largest key values possible. +-- We should also run randomized benchmarks, where we insert random values into random Values. +-- We actually want to see how the performance scales with the size of the Value, so we should generate Values of varying sizes. +-- We want to make sure we are also hitting the worst case scenarios and various edge cases. +insertCoinBenchGen + :: StdGen + -> [InsertCoinBenchmark] +insertCoinBenchGen g = flip evalState (GenState 0 0) $ runStateGenT_ g $ \gen -> do + policyId <- newPolicyId gen + tokenName <- newTokenName gen + amount <- uniformAmount gen + let emptyValueBench = InsertCoinBenchmark policyId tokenName amount Value.empty + pure [emptyValueBench] + +-- | Generate a unique PolicyId on a uniform distribution. Note that the size of the +-- generated bytestring is going to be larger than Value.maxKeyLen, because we +-- append a counter integer to ensure uniqueness. This is acceptable for benchmarking +-- purposes, as we're interested in the worst-case performance. +newPolicyId :: StateGenM StdGen -> BenchState PolicyId +newPolicyId gen = do + bs <- uniformByteStringM Value.maxKeyLen gen + c <- lift $ gets policyIdCounter + let newbs = BS.append bs (encodeUtf8 . Text.pack . show $ c) + lift $ modify $ \s -> s { policyIdCounter = c + 1 } + pure $ PolicyId newbs + +-- | Generate a unique TokenName on a uniform distribution. Note that the size of the +-- generated bytestring is going to be larger than Value.maxKeyLen, because we +-- append a counter integer to ensure uniqueness. This is acceptable for benchmarking +-- purposes, as we're interested in the worst-case performance. +-- Actually, this wouldn't be acceptable if we were to measure based on the size of the +-- keys, because we would want to view how key size affects performance! +newTokenName :: StateGenM StdGen -> BenchState TokenName +newTokenName gen = do + bs <- uniformByteStringM Value.maxKeyLen gen + c <- lift $ gets tokenNameCounter + let newbs = BS.append bs (encodeUtf8 . Text.pack . show $ c) + lift $ modify $ \s -> s { tokenNameCounter = c + 1 } + pure $ TokenName newbs + +uniformAmount :: StateGenM StdGen -> BenchState Amount +uniformAmount gen = + Amount <$> uniformRM (0, 100) gen -- TODO: tweak the range + +newValue :: StateGenM StdGen -> BenchState Value +newValue gen = undefined diff --git a/plutus-core/cost-model/budgeting-bench/Common.hs b/plutus-core/cost-model/budgeting-bench/Common.hs index 1812fe78731..92766abff5d 100644 --- a/plutus-core/cost-model/budgeting-bench/Common.hs +++ b/plutus-core/cost-model/budgeting-bench/Common.hs @@ -431,3 +431,36 @@ createThreeTermBuiltinBenchWithWrappers (wrapX, wrapY, wrapZ) fun tys xs ys zs = [mkBM x y z | z <- zs] | y <- ys] | x <- xs] where mkBM x y z = benchDefault (showMemoryUsage (wrapZ z)) $ mkApp3 fun tys x y z +{- See Note [Adjusting the memory usage of arguments of costing benchmarks]. -} +createFourTermBuiltinBenchElementwiseWithWrappers + :: ( fun ~ DefaultFun + , uni ~ DefaultUni + , uni `HasTermLevel` a + , uni `HasTermLevel` b + , uni `HasTermLevel` c + , uni `HasTermLevel` d + , ExMemoryUsage a' + , ExMemoryUsage b' + , ExMemoryUsage c' + , ExMemoryUsage d' + , NFData a + , NFData b + , NFData c + , NFData d + ) + => (a -> a', b -> b', c -> c', d -> d') + -> fun + -> [Type tyname uni ()] + -> [(a,b,c,d)] + -> Benchmark +createFourTermBuiltinBenchElementwiseWithWrappers (wrapW, wrapX, wrapY, wrapZ) fun tys inputs = + bgroup (show fun) $ + fmap + (\(w, x, y, z) -> + bgroup (showMemoryUsage $ wrapW w) + [bgroup (showMemoryUsage $ wrapX x) + [bgroup (showMemoryUsage $ wrapY y) [mkBM w x y z]] + ] + ) + inputs + where mkBM w x y z = benchDefault (showMemoryUsage $ wrapZ z) $ mkApp4 fun tys w x y z diff --git a/plutus-core/cost-model/create-cost-model/BuiltinMemoryModels.hs b/plutus-core/cost-model/create-cost-model/BuiltinMemoryModels.hs index 65e647d48f9..ccad29c0366 100644 --- a/plutus-core/cost-model/create-cost-model/BuiltinMemoryModels.hs +++ b/plutus-core/cost-model/create-cost-model/BuiltinMemoryModels.hs @@ -176,5 +176,8 @@ builtinMemoryModels = BuiltinCostModelBase , paramLengthOfArray = Id $ ModelOneArgumentConstantCost 10 , paramListToArray = Id $ ModelOneArgumentLinearInX $ OneVariableLinearFunction 7 1 , paramIndexArray = Id $ ModelTwoArgumentsConstantCost 32 + -- Builtin values + , paramInsertCoin = Id $ ModelFourArgumentsConstantCost 1 + , paramUnionValue = Id $ ModelTwoArgumentsConstantCost 1 } where identityFunction = OneVariableLinearFunction 0 1 diff --git a/plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs b/plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs index 889d43da60a..175cce25840 100644 --- a/plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs +++ b/plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs @@ -131,6 +131,9 @@ builtinCostModelNames = BuiltinCostModelBase , paramLengthOfArray = "lengthOfArrayModel" , paramListToArray = "listToArrayModel" , paramIndexArray = "indexArrayModel" + -- Builtin values + , paramInsertCoin = "insertCoinModel" + , paramUnionValue = "unionValueModel" } @@ -279,6 +282,9 @@ createBuiltinCostModel bmfile rfile = do paramLengthOfArray <- getParams readCF1 paramLengthOfArray paramListToArray <- getParams readCF1 paramListToArray paramIndexArray <- getParams readCF2 paramIndexArray + -- Builtin values + paramInsertCoin <- getParams readCF4 paramInsertCoin + paramUnionValue <- getParams readCF2 paramUnionValue pure $ BuiltinCostModelBase {..} @@ -442,6 +448,13 @@ readCF3 e = do "exp_mod_cost" -> ModelThreeArgumentsExpModCost <$> readExpModCostingFunction "y_mem" "z_mem" e _ -> error $ "Unknown three-variable model type: " ++ ty +readCF4 :: MonadR m => SomeSEXP (Region m) -> m ModelFourArguments +readCF4 e = do + ty <- getType e + case ty of + "constant_cost" -> ModelFourArgumentsConstantCost <$> getConstant e + _ -> error $ "Unknown four-variable model type: " ++ ty + readCF6 :: MonadR m => SomeSEXP (Region m) -> m ModelSixArguments readCF6 e = do ty <- getType e diff --git a/plutus-core/cost-model/data/builtinCostModelA.json b/plutus-core/cost-model/data/builtinCostModelA.json index d1c4baf684c..e311183e326 100644 --- a/plutus-core/cost-model/data/builtinCostModelA.json +++ b/plutus-core/cost-model/data/builtinCostModelA.json @@ -1205,5 +1205,25 @@ "arguments": 4, "type": "constant_cost" } + }, + "insertCoin": { + "cpu": { + "arguments": 0, + "type": "constant_cost" + }, + "memory": { + "arguments": 0, + "type": "constant_cost" + } + }, + "unionValue": { + "cpu": { + "arguments": 0, + "type": "constant_cost" + }, + "memory": { + "arguments": 0, + "type": "constant_cost" + } } } diff --git a/plutus-core/cost-model/data/builtinCostModelB.json b/plutus-core/cost-model/data/builtinCostModelB.json index 7b4350c3c10..5b4a42cb611 100644 --- a/plutus-core/cost-model/data/builtinCostModelB.json +++ b/plutus-core/cost-model/data/builtinCostModelB.json @@ -1205,5 +1205,25 @@ "arguments": 4, "type": "constant_cost" } + }, + "insertCoin": { + "cpu": { + "arguments": 1000, + "type": "constant_cost" + }, + "memory": { + "arguments": 10, + "type": "constant_cost" + } + }, + "unionValue": { + "cpu": { + "arguments": 1000, + "type": "constant_cost" + }, + "memory": { + "arguments": 10, + "type": "constant_cost" + } } } diff --git a/plutus-core/cost-model/data/builtinCostModelC.json b/plutus-core/cost-model/data/builtinCostModelC.json index f69154d323c..6bc07a6eccb 100644 --- a/plutus-core/cost-model/data/builtinCostModelC.json +++ b/plutus-core/cost-model/data/builtinCostModelC.json @@ -1223,5 +1223,25 @@ "arguments": 4, "type": "constant_cost" } + }, + "insertCoin": { + "cpu": { + "arguments": 1000, + "type": "constant_cost" + }, + "memory": { + "arguments": 10, + "type": "constant_cost" + } + }, + "unionValue": { + "cpu": { + "arguments": 1000, + "type": "constant_cost" + }, + "memory": { + "arguments": 10, + "type": "constant_cost" + } } } diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index 412c942303c..ee27a639792 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -95,10 +95,10 @@ library Data.MultiSet.Lens Data.Version.Extras PlutusCore - PlutusCore.AstSize PlutusCore.Analysis.Definitions PlutusCore.Annotation PlutusCore.Arity + PlutusCore.AstSize PlutusCore.Bitwise PlutusCore.Builtin PlutusCore.Builtin.Debug @@ -515,11 +515,11 @@ library plutus-ir hs-source-dirs: plutus-ir/src exposed-modules: PlutusIR - PlutusIR.AstSize PlutusIR.Analysis.Builtins PlutusIR.Analysis.Dependencies PlutusIR.Analysis.RetainedSize PlutusIR.Analysis.VarInfo + PlutusIR.AstSize PlutusIR.Check.Uniques PlutusIR.Compiler PlutusIR.Compiler.Datatype @@ -935,6 +935,7 @@ executable cost-model-budgeting-bench Benchmarks.Strings Benchmarks.Tracing Benchmarks.Unit + Benchmarks.Values Common CriterionExtensions Generators @@ -958,6 +959,7 @@ executable cost-model-budgeting-bench , random , text , time + , transformers , vector -- This reads CSV data generated by cost-model-budgeting-bench, uses R to build diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs index 04165c16ef4..3d399213322 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs @@ -2053,7 +2053,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where {-# INLINE insertCoinDenotation #-} in makeBuiltinMeaning insertCoinDenotation - (runCostingFunFourArguments . unimplementedCostingFun) + (runCostingFunFourArguments . paramInsertCoin) toBuiltinMeaning _semvar LookupCoin = let lookupCoinDenotation :: ByteString -> ByteString -> Value -> Integer @@ -2069,7 +2069,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where {-# INLINE unionValueDenotation #-} in makeBuiltinMeaning unionValueDenotation - (runCostingFunTwoArguments . unimplementedCostingFun) + (runCostingFunTwoArguments . paramUnionValue) toBuiltinMeaning _semvar ValueContains = let valueContainsDenotation :: Value -> Value -> BuiltinResult Bool diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/BuiltinCostModel.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/BuiltinCostModel.hs index 9cb77e0bb64..5fa7204e8dd 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/BuiltinCostModel.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/BuiltinCostModel.hs @@ -193,6 +193,9 @@ data BuiltinCostModelBase f = , paramLengthOfArray :: f ModelOneArgument , paramListToArray :: f ModelOneArgument , paramIndexArray :: f ModelTwoArguments + -- Builtin values + , paramInsertCoin :: f ModelFourArguments + , paramUnionValue :: f ModelTwoArguments } deriving stock (Generic) deriving anyclass (FunctorB, TraversableB, ConstraintsB) diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs index b70266cb250..03dfcf380f7 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs @@ -238,6 +238,9 @@ unitCostTwoArguments = CostingFun (ModelTwoArgumentsConstantCost 1) (ModelTwo unitCostThreeArguments :: CostingFun ModelThreeArguments unitCostThreeArguments = CostingFun (ModelThreeArgumentsConstantCost 1) (ModelThreeArgumentsConstantCost 0) +unitCostFourArguments :: CostingFun ModelFourArguments +unitCostFourArguments = CostingFun (ModelFourArgumentsConstantCost 1) (ModelFourArgumentsConstantCost 0) + unitCostSixArguments :: CostingFun ModelSixArguments unitCostSixArguments = CostingFun (ModelSixArgumentsConstantCost 1) (ModelSixArgumentsConstantCost 0) @@ -355,6 +358,9 @@ unitCostBuiltinCostModel = BuiltinCostModelBase , paramLengthOfArray = unitCostOneArgument , paramListToArray = unitCostOneArgument , paramIndexArray = unitCostTwoArguments + -- Builtin values + , paramInsertCoin = unitCostFourArguments + , paramUnionValue = unitCostTwoArguments } unitCekParameters :: Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann)