Costing for expModIntger, take two.

plutus-conformance/agda/Spec.hs

@@ -147,9 +147,8 @@ failingEvaluationTests =
 -}
 failingBudgetTests :: [FilePath]
 failingBudgetTests =
-  -- These currently fail because (a) the Agda code doesn't know about the
-  -- IntegerCostedLiterally size measure used by `replicateByte`, and (b)
-  -- GHC 8.0 can't deal with `dropList`.
+  -- These currently fail because the Agda code doesn't know about the
+  -- IntegerCostedLiterally size measure used by `replicateByte` and `dropList`.
   [ "test-cases/uplc/evaluation/builtin/semantics/replicateByte/case-07"
   , "test-cases/uplc/evaluation/builtin/semantics/replicateByte/case-09"
   , "test-cases/uplc/evaluation/builtin/semantics/dropList/dropList-01"

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/expModInteger/expMod-01/expMod-01.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 100000112100
-| mem: 100000000800})
+({cpu: 1004094
+| mem: 801})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/expModInteger/expMod-02/expMod-02.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 100000112100
-| mem: 100000000800})
+({cpu: 1004094
+| mem: 801})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/expModInteger/expMod-03/expMod-03.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 100000112100
-| mem: 100000000800})
+({cpu: 1004094
+| mem: 801})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/expModInteger/expMod-04/expMod-04.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 100000112100
-| mem: 100000000800})
+({cpu: 1004094
+| mem: 801})

plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/expModInteger/expMod-05/expMod-05.uplc.budget.expected

@@ -1,2 +1,2 @@
-({cpu: 100000112100
-| mem: 100000000800})
+({cpu: 1004094
+| mem: 801})

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

@@ -2,10 +2,10 @@ module Benchmarks.Integers (makeBenchmarks) where
 
 import Common
 import Generators
-
 import PlutusCore
 
 import Criterion.Main
+import GHC.Num.Integer
 import System.Random (StdGen)
 
 ---------------- Integer builtins ----------------
@@ -43,6 +43,47 @@ benchSameTwoIntegers gen builtinName =
    createTwoTermBuiltinBenchElementwise builtinName [] $ pairWith copyInteger numbers
     where (numbers,_) = makeBiggerIntegerArgs gen
 
+{- `expModInteger a e m` calculates `a^e` modulo `m`; if `e` is negative then the
+function fails unless gcd(a,m) = 1, in which case there is an integer `a'` such
+that `a*a'` is congruent to 1 modulo `m`, and then `expModInteger a e m` is
+defined to be `expModInteger a' (-e) m`.  If `0 <= a <= m-1` and `e>=0` then the
+time taken by expModInteger varies linearly with the size of `e` (and the worst
+case is when `e` is one less than a power of two) and quadratically with the
+size of `m`.  A good model can be obtained by fitting a function of the form A +
+Byz + Cyz^2 (y=size(e), z=size(m)) to the results of the benchmarks.  For most
+values of `a` (except for things like 0 and 1), the time taken for
+exponentiation is independent of the size of `a` because many intermediate
+powers have to be calculated, and these quickly grow so that their size is
+similar to that of `m`.  In the benchmarks we use `a = m div 3` to start with a
+value of reasonable size.
+
+For exponents `e<0` a little extra time is required to perform an initial
+modular inversion, but this only adds a percent or two to the execution time so
+for simplicity we benchmark only with positive values of `e`. For values of `a`
+with `size(a)>size(m)` an extra modular reduction has to be performed before
+starting the main calculation.  It is difficult to model the effect of this
+precisely, so we impose an extra charge by increasing the cost of
+`expModInteger` by 50% for values of `a` with large sizes; to avoid the penalty,
+call `modInteger` before calling `expModInteger`.
+-}
+benchExpModInteger :: StdGen -> Benchmark
+benchExpModInteger _gen =
+  let fun = ExpModInteger
+      pow (a::Integer) (b::Integer) = a^b
+      moduli = fmap (\n -> pow 2 (32*n) - 11) [1, 3..31]
+      -- ^ 16 entries, sizes = 4, 12, ..., 124 bytes (memoryUsage = 1,2,...,16)
+      es = fmap (\n -> pow 2 (fromIntegral $ integerLog2 n) - 1) moduli
+      -- ^ Largest number less than modulus with binary expansion 1111...1.
+      -- This is the worst case.
+
+  in bgroup (show fun)
+     [bgroup (showMemoryUsage (m `div` 3))
+       [bgroup (showMemoryUsage e)
+         [mkBM a e m | a <- [m `div` 3] ] | e <- es ] | m <- moduli ]
+  where mkBM a e m =
+          benchDefault (showMemoryUsage m) $
+          mkApp3 ExpModInteger [] a e m
+
 makeBenchmarks :: StdGen -> [Benchmark]
 makeBenchmarks gen =
        [benchTwoIntegers gen makeLargeIntegerArgs AddInteger]-- SubtractInteger behaves identically.
@@ -52,3 +93,5 @@ makeBenchmarks gen =
                                      , LessThanInteger
                                      , LessThanEqualsInteger
                                      ])
+    <> [-- benchExpModInteger gen,
+        benchExpModInteger gen]

plutus-core/cost-model/budgeting-bench/Common.hs

@@ -277,6 +277,29 @@ createTwoTermBuiltinBenchWithFlag fun tys flag ys zs =
                        [bgroup (showMemoryUsage y) [mkBM y z | z <- zs] | y <- ys]]
   where mkBM y z = benchDefault (showMemoryUsage z) $ mkApp3 fun tys flag y z
 
+{- | Given a builtin function f of type a * b -> _ together with lists xs::[a] and
+   ys::[b], create a collection of benchmarks which run f on all pairs in
+   {(x,y}: x in xs, y in ys}. -}
+createTwoTermBuiltinBenchWithWrappers
+  :: ( fun ~ DefaultFun
+     , uni ~ DefaultUni
+     , uni `HasTermLevel` a
+     , uni `HasTermLevel` b
+     , ExMemoryUsage a'
+     , ExMemoryUsage b'
+     , NFData a
+     , NFData b
+     )
+  => (a -> a', b-> b')
+  -> fun
+  -> [Type tyname uni ()]
+  -> [a]
+  -> [b]
+  -> Benchmark
+createTwoTermBuiltinBenchWithWrappers (wrapX, wrapY) fun tys xs ys =
+  bgroup (show fun) [bgroup (showMemoryUsage (wrapX x)) [mkBM x y | y <- ys] | x <- xs]
+  where mkBM x y = benchDefault (showMemoryUsage (wrapY y)) $ mkApp2 fun tys x y
+
 {- | Given a builtin function f of type a * b -> _ together with a list of (a,b)
    pairs, create a collection of benchmarks which run f on all of the pairs in
    the list.  This can be used when the worst-case execution time of a
@@ -379,3 +402,32 @@ createThreeTermBuiltinBenchElementwiseWithWrappers (wrapX, wrapY, wrapZ) fun tys
   )
   inputs
   where mkBM x y z = benchDefault (showMemoryUsage $ wrapZ z) $ mkApp3 fun tys x y z
+
+
+createThreeTermBuiltinBenchWithWrappers
+  :: ( fun ~ DefaultFun
+     , uni ~ DefaultUni
+     , uni `HasTermLevel` a
+     , uni `HasTermLevel` b
+     , uni `HasTermLevel` c
+     , ExMemoryUsage a'
+     , ExMemoryUsage b'
+     , ExMemoryUsage c'
+     , NFData a
+     , NFData b
+     , NFData c
+     )
+  => (a -> a', b-> b', c -> c')
+  -> fun
+  -> [Type tyname uni ()]
+  -> [a]
+  -> [b]
+  -> [c]
+  -> Benchmark
+createThreeTermBuiltinBenchWithWrappers (wrapX, wrapY, wrapZ) fun tys xs ys zs =
+  bgroup (show fun)
+   [bgroup (showMemoryUsage (wrapX x))
+    [bgroup (showMemoryUsage (wrapY y))
+      [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
+

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

@@ -160,7 +160,7 @@ builtinMemoryModels = BuiltinCostModelBase
   , paramWriteBits                       = Id $ ModelThreeArgumentsLinearInX identityFunction
   -- The empty bytestring has memory usage 1, so we add an extra memory unit here to make sure that
   -- the memory cost of `replicateByte` is always nonzero. That means that we're charging one unit
-  -- ore than we perhaps should for nonempty bytestrings, but that's negligible (plus there's some
+  -- more than we perhaps should for nonempty bytestrings, but that's negligible (plus there's some
   -- overhead for bytesrings anyway).  Note also that `replicateByte`'s argument is costed as a
   -- literal size.
   , paramReplicateByte                   = Id $ ModelTwoArgumentsLinearInX $ OneVariableLinearFunction 1 1
@@ -169,7 +169,7 @@ builtinMemoryModels = BuiltinCostModelBase
   , paramCountSetBits                    = Id $ ModelOneArgumentConstantCost 1
   , paramFindFirstSetBit                 = Id $ ModelOneArgumentConstantCost 1
   , paramRipemd_160                      = Id $ hashMemModel Hash.ripemd_160
-  , paramExpModInteger                   = Id $ ModelThreeArgumentsConstantCost 100000000000 -- FIXME: stub
+  , paramExpModInteger                   = Id $ ModelThreeArgumentsLinearInZ identityFunction
   -- paramCaseList
   -- paramCaseData
   , paramDropList                        = Id $ ModelTwoArgumentsConstantCost 4

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

@@ -361,6 +361,14 @@ readTwoVariableQuadraticFunction var1 var2 e = do
   c02 <- Coefficient02 <$> getCoeff (printf "I(%s^2)" var2) e
   pure $ TwoVariableQuadraticFunction minVal c00 c10 c01 c20 c11 c02
 
+-- Specialised version of readTwoVariableQuadraticFunction for a*YZ^2 + b*YZ
+readExpModCostingFunction :: MonadR m => String -> String -> SomeSEXP (Region m) -> m ExpModCostingFunction
+readExpModCostingFunction var1 var2 e = do
+  c00 <- Coefficient00 <$> getCoeff "(Intercept)" e
+  c11 <- Coefficient11 <$> getCoeff (printf "I(%s * %s)" var1 var2) e
+  c12 <- Coefficient12 <$> getCoeff (printf "I(%s * %s^2)" var1 var2) e
+  pure $ ExpModCostingFunction c00 c11 c12
+
 -- | A two-variable costing function which is constant on one region of the
 -- plane and something else elsewhere.
 readTwoVariableFunConstOr :: MonadR m => SomeSEXP (Region m) -> m ModelConstantOrTwoArguments
@@ -429,6 +437,7 @@ readCF3 e = do
     "quadratic_in_z"              -> ModelThreeArgumentsQuadraticInZ          <$> readOneVariableQuadraticFunction "z_mem" e
     "linear_in_y_and_z"           -> ModelThreeArgumentsLinearInYAndZ         <$> readTwoVariableLinearFunction "y_mem" "z_mem" e
     "literal_in_y_or_linear_in_z" -> ModelThreeArgumentsLiteralInYOrLinearInZ <$> error "literal"
+    "exp_mod_cost"                -> ModelThreeArgumentsExpModCost            <$> readExpModCostingFunction "y_mem" "z_mem" e
     _                             -> error $ "Unknown three-variable model type: " ++ ty
 
 readCF6 :: MonadR m => SomeSEXP (Region m) -> m ModelSixArguments