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

@@ -181,5 +181,7 @@ builtinMemoryModels = BuiltinCostModelBase
   , paramValueContains                   = Id $ ModelTwoArgumentsConstantCost 32
   , paramValueData                       = Id $ ModelOneArgumentConstantCost 32
   , paramUnValueData                     = Id $ ModelOneArgumentConstantCost 32
+  , paramInsertCoin                      = Id $ ModelFourArgumentsConstantCost 1
+  , paramUnionValue                      = Id $ ModelTwoArgumentsConstantCost 1
   }
   where identityFunction = OneVariableLinearFunction 0 1

plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs

@@ -136,6 +136,8 @@ builtinCostModelNames = BuiltinCostModelBase
   , paramValueContains                   = "valueContainsModel"
   , paramValueData                       = "valueDataModel"
   , paramUnValueData                     = "unValueDataModel"
+  , paramInsertCoin                      = "insertCoinModel"
+  , paramUnionValue                      = "unionValueModel"
   }
 
 
@@ -289,6 +291,8 @@ createBuiltinCostModel bmfile rfile = do
   paramValueContains                   <- getParams readCF2 paramValueContains
   paramValueData                       <- getParams readCF1 paramValueData
   paramUnValueData                     <- getParams readCF1 paramUnValueData
+  paramInsertCoin                      <- getParams readCF4 paramInsertCoin
+  paramUnionValue                      <- getParams readCF2 paramUnionValue
 
   pure $ BuiltinCostModelBase {..}
 
@@ -452,6 +456,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

@@ -1254,5 +1254,25 @@
       "arguments": 1,
       "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

@@ -1254,5 +1254,25 @@
       "arguments": 1,
       "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

@@ -1272,5 +1272,25 @@
       "arguments": 1,
       "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

@@ -2054,7 +2054,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
           {-# INLINE insertCoinDenotation #-}
        in makeBuiltinMeaning
             insertCoinDenotation
-            (runCostingFunFourArguments . unimplementedCostingFun)
+            (runCostingFunFourArguments . paramInsertCoin)
 
     toBuiltinMeaning _semvar LookupCoin =
       let lookupCoinDenotation :: ByteString -> ByteString -> ValueLogOuterSizeAddLogMaxInnerSize -> Integer
@@ -2070,7 +2070,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
           {-# INLINE unionValueDenotation #-}
        in makeBuiltinMeaning
             unionValueDenotation
-            (runCostingFunTwoArguments . unimplementedCostingFun)
+            (runCostingFunTwoArguments . paramUnionValue)
 
     toBuiltinMeaning _semvar ValueContains =
       let valueContainsDenotation :: ValueLogOuterSizeAddLogMaxInnerSize -> ValueTotalSize -> BuiltinResult Bool

plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/BuiltinCostModel.hs

@@ -198,6 +198,8 @@ data BuiltinCostModelBase f =
     , paramValueContains                   :: f ModelTwoArguments
     , paramValueData                       :: f ModelOneArgument
     , paramUnValueData                     :: f ModelOneArgument
+    , 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)
 
@@ -360,6 +363,8 @@ unitCostBuiltinCostModel = BuiltinCostModelBase
     , paramValueContains                   = unitCostTwoArguments
     , paramValueData                       = unitCostOneArgument
     , paramUnValueData                     = unitCostOneArgument
+    , paramInsertCoin                      = unitCostFourArguments
+    , paramUnionValue                      = unitCostTwoArguments
     }
 
 unitCekParameters :: Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann)