Add insertCoin and unionValue costing skeleton

Author: ana-pantilie

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

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

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

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"
+        }
     }
 }

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"
+        }
     }
 }

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"
+        }
     }
 }

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

@@ -2052,7 +2052,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
@@ -2068,7 +2068,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

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)

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)