Kwxm/costing/restore old cost model param names

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

@@ -297,6 +297,13 @@ readOneVariableQuadraticFunction var e = do
   coeff2 <- Coefficient2 <$> getCoeff (printf "I(%s^2)" var) e
   pure $ OneVariableQuadraticFunction coeff0 coeff1 coeff2
 
+readTwoVariableFunLinearOnDiagonal :: MonadR m => String -> SomeSEXP (Region m) -> m ModelConstantOrLinear
+readTwoVariableFunLinearOnDiagonal var e = do
+  constantPart <- getExtraParam "constant" e
+  intercept <- Intercept <$> getCoeff "(Intercept)" e
+  slope <- Slope <$> getCoeff var e
+  pure $ ModelConstantOrLinear constantPart intercept slope
+
 -- | A costing function of the form a+sx+ty
 readTwoVariableLinearFunction :: MonadR m => String -> String -> SomeSEXP (Region m) -> m TwoVariableLinearFunction
 readTwoVariableLinearFunction var1 var2 e = do
@@ -348,6 +355,8 @@ readCF2AtType ty e = do
     "multiplied_sizes"     -> ModelTwoArgumentsMultipliedSizes    <$> readOneVariableLinearFunction "I(x_mem * y_mem)" e
     "min_size"             -> ModelTwoArgumentsMinSize            <$> readOneVariableLinearFunction "pmin(x_mem, y_mem)" e
     "max_size"             -> ModelTwoArgumentsMaxSize            <$> readOneVariableLinearFunction "pmax(x_mem, y_mem)" e
+    -- See Note [Backward compatibility for costing functions] for linear_on_diagonal
+    "linear_on_diagonal"   -> ModelTwoArgumentsLinearOnDiagonal   <$> readTwoVariableFunLinearOnDiagonal "x_mem" e
     "const_below_diagonal" -> ModelTwoArgumentsConstBelowDiagonal <$> readTwoVariableFunConstOr e
     "const_above_diagonal" -> ModelTwoArgumentsConstAboveDiagonal <$> readTwoVariableFunConstOr e
     "const_off_diagonal"   -> ModelTwoArgumentsConstOffDiagonal   <$> readOneVariableFunConstOr e

plutus-core/cost-model/data/builtinCostModel.json

@@ -397,15 +397,10 @@
         "cpu": {
             "arguments": {
                 "constant": 245000,
-                "model": {
-                    "arguments": {
-                        "intercept": 216773,
-                        "slope": 62
-                    },
-                    "type": "linear_in_x"
-                }
+                "intercept": 216773,
+                "slope": 62
             },
-            "type": "const_off_diagonal"
+            "type": "linear_on_diagonal"
         },
         "memory": {
             "arguments": 1,
@@ -442,15 +437,10 @@
         "cpu": {
             "arguments": {
                 "constant": 187000,
-                "model": {
-                    "arguments": {
-                        "intercept": 1000,
-                        "slope": 52998
-                    },
-                    "type": "linear_in_x"
-                }
+                "intercept": 1000,
+                "slope": 52998
             },
-            "type": "const_off_diagonal"
+            "type": "linear_on_diagonal"
         },
         "memory": {
             "arguments": 1,

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

@@ -517,6 +517,9 @@ modelFun <- function(path) {
     lengthOfByteStringModel <- constantModel ("LengthOfByteString")  ## Just returns a field
     indexByteStringModel    <- constantModel ("IndexByteString")     ## Constant-time array access
 
+    ## NOTE: We could also use const_off_diagonal here, but we have to keep
+    ## linear _on_diagonal for backward compatibility for the time being.
+    ## See Note [Backward compatibility for costing functions].
     equalsByteStringModel <- {
         fname <- "EqualsByteString"
         filtered <- data %>%
@@ -527,9 +530,9 @@ modelFun <- function(path) {
 
         constant <- min(filtered$t)
         ## FIXME.  The `constant` value above is the above-diagonal cost, which we
-        ## don't collect benchmarking data for.  Collect some data and infer it
+        ## don't collect benchmarking data for.  Collect some data and infer it.
 
-        mk.result(m, "const_off_diagonal", constant=constant, subtype="linear_in_x")
+        mk.result(m, "linear_on_diagonal", constant=constant)
     }
 
     lessThanByteStringModel <- {
@@ -580,6 +583,9 @@ modelFun <- function(path) {
         mk.result(m, "added_sizes")
     }
 
+    ## NOTE: We could also use const_off_diagonal here, but we have to keep
+    ## linear _on_diagonal for backward compatibility for the time being.
+    ## See Note [Backward compatibility for costing functions].
     equalsStringModel <- {
         fname <- "EqualsString"
         filtered <- data %>%
@@ -593,7 +599,7 @@ modelFun <- function(path) {
         ## we don't collect benchmarking data for.  We might want to collect
         ## some data and infer it.
 
-        mk.result(m, "const_off_diagonal", constant=constant, subtype="linear_in_x")
+        mk.result(m, "linear_on_diagonal", constant=constant)
     }
 
     decodeUtf8Model <- linearInX ("DecodeUtf8")

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

@@ -26,6 +26,7 @@ module PlutusCore.Evaluation.Machine.BuiltinCostModel
     , ModelSubtractedSizes(..)
     , ModelConstantOrOneArgument(..)
     , ModelConstantOrTwoArguments(..)
+    , ModelConstantOrLinear(..)  -- Deprecated: see Note [Backward compatibility for costing functions]
     , ModelOneArgument(..)
     , ModelTwoArguments(..)
     , ModelThreeArguments(..)

plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/CostingFun/Core.hs

@@ -21,6 +21,7 @@ module PlutusCore.Evaluation.Machine.CostingFun.Core
     , TwoVariableLinearFunction(..)
     , OneVariableQuadraticFunction(..)
     , ModelSubtractedSizes(..)
+    , ModelConstantOrLinear(..)  -- Deprecated: see below.
     , ModelConstantOrOneArgument(..)
     , ModelConstantOrTwoArguments(..)
     , ModelOneArgument(..)
@@ -308,7 +309,17 @@ data ModelSubtractedSizes = ModelSubtractedSizes
     } deriving stock (Show, Eq, Generic, Lift)
     deriving anyclass (NFData)
 
--- | if p then f(x) else c; p depends on usage
+-- | NB: this is subsumed by ModelConstantOrOneArgument, but we have to keep it
+-- for the time being.  See Note [Backward compatibility for costing functions].
+-- | if p then s*x else c; p depends on usage
+data ModelConstantOrLinear = ModelConstantOrLinear
+    { modelConstantOrLinearConstant  :: CostingInteger
+    , modelConstantOrLinearIntercept :: Intercept
+    , modelConstantOrLinearSlope     :: Slope
+    } deriving stock (Show, Eq, Generic, Lift)
+    deriving anyclass (NFData)
+
+  -- | if p then f(x) else c; p depends on usage
 data ModelConstantOrOneArgument = ModelConstantOrOneArgument
     { modelConstantOrOneArgumentConstant :: CostingInteger
     , modelConstantOrOneArgumentModel    :: ModelOneArgument
@@ -322,6 +333,21 @@ data ModelConstantOrTwoArguments = ModelConstantOrTwoArguments
     } deriving stock (Show, Eq, Generic, Lift)
     deriving anyclass (NFData)
 
+{- Note [Backward compatibility for costing functions].  The PR at
+   https://github.com/IntersectMBO/plutus/pull/5857 generalised the costing
+   function types and made them more composable: in particular,
+   ModelTwoArgumentsLinearOnDiagonal was replaced by
+   ModelTwoArgumentsConstOffDiagonal and ModelConstantOrLinear was removed.
+   However, this changes some of the tags (specifically, for `equalsByteString`
+   and `equalsString`) in builtinCostModel.json, and these are used in the
+   Alonzo genesis file and so shouldn't be changed.  For the time being we've
+   restored the ModelTwoArgumentsLinearOnDiagonal constructor so that we can
+   still deal with the old tags.  New builtins should use
+   ModelTwoArgumentsConstOffDiagonal instead.  A better long-term solution might
+   be to adapt the JSON conversion code to translate linear_on_diagonal objects
+   to ConstOffDiagonal objects (and perhaps back, although configurable cost
+   models may mean that we don't need to do that).
+-}
 
 data ModelTwoArguments =
     ModelTwoArgumentsConstantCost        CostingInteger
@@ -333,6 +359,7 @@ data ModelTwoArguments =
   | ModelTwoArgumentsMultipliedSizes     OneVariableLinearFunction
   | ModelTwoArgumentsMinSize             OneVariableLinearFunction
   | ModelTwoArgumentsMaxSize             OneVariableLinearFunction
+  | ModelTwoArgumentsLinearOnDiagonal    ModelConstantOrLinear
   | ModelTwoArgumentsConstOffDiagonal    ModelConstantOrOneArgument
   | ModelTwoArgumentsConstAboveDiagonal  ModelConstantOrTwoArguments
   | ModelTwoArgumentsConstBelowDiagonal  ModelConstantOrTwoArguments
@@ -422,6 +449,16 @@ runTwoArgumentModel
     (ModelTwoArgumentsLinearInXAndY (TwoVariableLinearFunction intercept slope1 slope2)) =
         lazy $ \costs1 costs2 ->
             scaleLinearlyTwoVariables intercept slope1 costs1 slope2 costs2
+runTwoArgumentModel
+    -- See Note [Backward compatibility for costing functions]
+    -- Off the diagonal, return the constant.  On the diagonal, run the one-variable linear model.
+    (ModelTwoArgumentsLinearOnDiagonal (ModelConstantOrLinear c intercept slope)) =
+        lazy $ \costs1 costs2 -> do
+            let !size1 = sumCostStream costs1
+                !size2 = sumCostStream costs2
+            if size1 == size2
+                then scaleLinearly intercept slope $ CostLast size1
+                else CostLast c
 runTwoArgumentModel
     -- Off the diagonal, return the constant.  On the diagonal, run the other model.
     (ModelTwoArgumentsConstOffDiagonal (ModelConstantOrOneArgument c m)) =

plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/CostingFun/JSON.hs

@@ -93,3 +93,8 @@ deriving via ModelJSON "modelConstantOrTwoArguments" ModelConstantOrTwoArguments
     instance FromJSON ModelConstantOrTwoArguments
 deriving via ModelJSON "modelConstantOrTwoArguments" ModelConstantOrTwoArguments
     instance ToJSON ModelConstantOrTwoArguments
+-- See Note [Backward compatibility for costing functions] for ModelConstantOrLinear
+deriving via ModelJSON "modelConstantOrLinear" ModelConstantOrLinear
+    instance FromJSON ModelConstantOrLinear
+deriving via ModelJSON "modelConstantOrLinear" ModelConstantOrLinear
+    instance ToJSON ModelConstantOrLinear

plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/CostingFun/SimpleJSON.hs

@@ -93,15 +93,27 @@ instance FromJSON Model where
                "quadratic_in_y"              -> QuadraticInY          <$> parseJSON args
                "quadratic_in_z"              -> QuadraticInZ          <$> parseJSON args
                "literal_in_y_or_linear_in_z" -> LiteralInYOrLinearInZ <$> parseJSON args
-               "subtracted_sizes"            ->
+               "subtracted_sizes" ->
                   SubtractedSizes       <$> parseJSON args <*> objOf args .: "minimum"
-               "const_above_diagonal"        ->
-                  ConstAboveDiagonal    <$> objOf args .: "constant" <*> objOf args .: "model"
-               "const_below_diagonal"        ->
-                  ConstBelowDiagonal    <$> objOf args .: "constant" <*> objOf args .: "model"
-               "const_off_diagonal"      ->
-                  ConstOffDiagonal      <$> objOf args .: "constant" <*> objOf args .: "model"
-               _                             -> errorWithoutStackTrace $ "Unknown model type " ++ show ty
+               "const_above_diagonal" ->
+                 let o = objOf args in ConstAboveDiagonal <$>  o .: "constant" <*> o .: "model"
+               "const_below_diagonal" ->
+                 let o = objOf args in ConstBelowDiagonal <$> o .: "constant" <*> o .: "model"
+               "const_off_diagonal" ->
+                 let o = objOf args in ConstOffDiagonal <$> o .: "constant" <*> o .: "model"
+               -- An adaptor to deal with the old "linear_on_diagonal" tag.  See Note [Backward
+               -- compatibility for costing functions].  We never want to convert back to JSON here,
+               -- so it's OK to forget that we originally got something tagged with
+               -- "linear_on_diagonal".
+               "linear_on_diagonal" ->
+                 let o = objOf args
+                 in do
+                   constant   <- o  .: "constant"
+                   intercept  <- o .: "intercept"
+                   slope      <- o .: "slope"
+                   pure $ ConstOffDiagonal constant (LinearInX $ LinearFunction intercept slope)
+
+               _ -> errorWithoutStackTrace $ "Unknown model type " ++ show ty
 
                where objOf (Object o) = o
                      objOf _          =

plutus-core/plutus-core/test/CostModelInterface/defaultCostModelParams.json

@@ -104,8 +104,8 @@
   "encodeUtf8-memory-arguments-intercept": 4,
   "encodeUtf8-memory-arguments-slope": 2,
   "equalsByteString-cpu-arguments-constant": 245000,
-  "equalsByteString-cpu-arguments-model-arguments-intercept": 216773,
-  "equalsByteString-cpu-arguments-model-arguments-slope": 62,
+  "equalsByteString-cpu-arguments-intercept": 216773,
+  "equalsByteString-cpu-arguments-slope": 62,
   "equalsByteString-memory-arguments": 1,
   "equalsData-cpu-arguments-intercept": 1060367,
   "equalsData-cpu-arguments-slope": 12586,
@@ -114,8 +114,8 @@
   "equalsInteger-cpu-arguments-slope": 421,
   "equalsInteger-memory-arguments": 1,
   "equalsString-cpu-arguments-constant": 187000,
-  "equalsString-cpu-arguments-model-arguments-intercept": 1000,
-  "equalsString-cpu-arguments-model-arguments-slope": 52998,
+  "equalsString-cpu-arguments-intercept": 1000,
+  "equalsString-cpu-arguments-slope": 52998,
   "equalsString-memory-arguments": 1,
   "fstPair-cpu-arguments": 80436,
   "fstPair-memory-arguments": 32,

plutus-ledger-api/src/PlutusLedgerApi/V1/ParamName.hs

@@ -75,8 +75,8 @@ data ParamName =
   | EncodeUtf8'memory'arguments'intercept
   | EncodeUtf8'memory'arguments'slope
   | EqualsByteString'cpu'arguments'constant
-  | EqualsByteString'cpu'arguments'model'arguments'intercept
-  | EqualsByteString'cpu'arguments'model'arguments'slope
+  | EqualsByteString'cpu'arguments'intercept
+  | EqualsByteString'cpu'arguments'slope
   | EqualsByteString'memory'arguments
   | EqualsData'cpu'arguments'intercept
   | EqualsData'cpu'arguments'slope
@@ -85,8 +85,8 @@ data ParamName =
   | EqualsInteger'cpu'arguments'slope
   | EqualsInteger'memory'arguments
   | EqualsString'cpu'arguments'constant
-  | EqualsString'cpu'arguments'model'arguments'intercept
-  | EqualsString'cpu'arguments'model'arguments'slope
+  | EqualsString'cpu'arguments'intercept
+  | EqualsString'cpu'arguments'slope
   | EqualsString'memory'arguments
   | FstPair'cpu'arguments
   | FstPair'memory'arguments

plutus-ledger-api/src/PlutusLedgerApi/V2/ParamName.hs

@@ -75,8 +75,8 @@ data ParamName =
   | EncodeUtf8'memory'arguments'intercept
   | EncodeUtf8'memory'arguments'slope
   | EqualsByteString'cpu'arguments'constant
-  | EqualsByteString'cpu'arguments'model'arguments'intercept
-  | EqualsByteString'cpu'arguments'model'arguments'slope
+  | EqualsByteString'cpu'arguments'intercept
+  | EqualsByteString'cpu'arguments'slope
   | EqualsByteString'memory'arguments
   | EqualsData'cpu'arguments'intercept
   | EqualsData'cpu'arguments'slope
@@ -85,8 +85,8 @@ data ParamName =
   | EqualsInteger'cpu'arguments'slope
   | EqualsInteger'memory'arguments
   | EqualsString'cpu'arguments'constant
-  | EqualsString'cpu'arguments'model'arguments'intercept
-  | EqualsString'cpu'arguments'model'arguments'slope
+  | EqualsString'cpu'arguments'intercept
+  | EqualsString'cpu'arguments'slope
   | EqualsString'memory'arguments
   | FstPair'cpu'arguments
   | FstPair'memory'arguments

plutus-ledger-api/src/PlutusLedgerApi/V3/ParamName.hs

@@ -75,8 +75,8 @@ data ParamName =
   | EncodeUtf8'memory'arguments'intercept
   | EncodeUtf8'memory'arguments'slope
   | EqualsByteString'cpu'arguments'constant
-  | EqualsByteString'cpu'arguments'model'arguments'intercept
-  | EqualsByteString'cpu'arguments'model'arguments'slope
+  | EqualsByteString'cpu'arguments'intercept -- TODO: this should change in the PlutusV3 cost model
+  | EqualsByteString'cpu'arguments'slope     -- TODO: this should change in the PlutusV3 cost model
   | EqualsByteString'memory'arguments
   | EqualsData'cpu'arguments'intercept
   | EqualsData'cpu'arguments'slope
@@ -85,8 +85,8 @@ data ParamName =
   | EqualsInteger'cpu'arguments'slope
   | EqualsInteger'memory'arguments
   | EqualsString'cpu'arguments'constant
-  | EqualsString'cpu'arguments'model'arguments'intercept
-  | EqualsString'cpu'arguments'model'arguments'slope
+  | EqualsString'cpu'arguments'intercept    -- TODO: this should change in the PlutusV3 cost model
+  | EqualsString'cpu'arguments'slope        -- TODO: this should change in the PlutusV3 cost model
   | EqualsString'memory'arguments
   | FstPair'cpu'arguments
   | FstPair'memory'arguments