Costing for caseList and caseData

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

@@ -1,13 +1,19 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns      #-}
 
 module Benchmarks.Data (makeBenchmarks) where
 
 import Common
 import Generators
 
 import PlutusCore hiding (Constr)
+import PlutusCore.Compiler.Erase (eraseTerm)
 import PlutusCore.Data
+import PlutusCore.MkPlc (builtin, mkConstant, mkIterAppNoAnn, mkIterInstNoAnn)
 
+import Control.DeepSeq (force)
 import Criterion.Main
 import System.Random (StdGen)
 
@@ -21,7 +27,6 @@ import System.Random (StdGen)
          | B ByteString
 -}
 
-
 isConstr :: Data -> Bool
 isConstr = \case {Constr {} -> True; _ -> False}
 
@@ -45,11 +50,11 @@ isB = \case {B {} -> True; _ -> False}
 -- fortunately 'chooseData' is parametric in its last five arguments so we can
 -- just give it integers for those.
 benchChooseData :: Benchmark
-benchChooseData = bgroup (show name) [mkBM d | d <- take 100 dataSample]
+benchChooseData = bgroup (show name) [mkBM d | d <- take 30 dataSample]
                   where name = ChooseData
                         mkBM d = benchDefault (showMemoryUsage d) $
                                  mkApp6 name [integer] d (111::Integer) (222::Integer)
-                                            (333::Integer) (444::Integer) (555::Integer)
+                                 (333::Integer) (444::Integer) (555::Integer)
 
 
 ---------------- Construction ----------------
@@ -133,6 +138,60 @@ benchSerialiseData =
     -- does the internal structure of a Data object influence serialisation
     -- time?  What causes a Data object to be quick or slow to serialise?
 
+{- Benchmark `caseData`.  The first argument is `lam x. lam y. ()` and the next
+   four are all `lam x. ()` (and the final one is a `data` object). This is to
+   minimise the amount of extra work that the evaluator has to do after the
+   builtin returns (which will be included in the cost of the builtin). We can't
+   re-use the functions that we use for other benchmarks because the term
+   arguments whave to be treated separately, so there's quite a bit of extra
+   machinery in here; it seems unlikely to be more generally useful, so for the
+   time being it's kept local to this function. -}
+{- Experiments show that the function takes the about ame amount of time for each
+   constructor, even for `Constr` which might be expected to take longer because
+   it has two arguments. -}
+benchCaseData :: Benchmark
+benchCaseData =
+  let name = CaseData
+      -- Thirty data objects for each constructor, in separate batches so that
+      -- we can check that they all take about the same amount of time.
+      inputs = (take 30 $ filter isConstr dataSample)
+               ++ (take 30 $ filter isMap dataSample)
+               ++ (take 30 $ filter isList dataSample)
+               ++ (take 30 $ filter isI dataSample)
+               ++ (take 30 $ filter isB dataSample)
+      y = Name "y" (Unique 1)
+      ys = Name "ys" (Unique 2)
+      -- lam y (con unit ())
+      mkCase1 ty = LamAbs () y ty (mkConstant () ())
+      -- lam y (lam ys (con unit ()))
+      mkCase2 ty1 ty2 = LamAbs () y ty1 (LamAbs () ys ty2 (mkConstant () ()))
+      -- Like mkApp6, but the first five arguments are terms (in fact values)
+      mkApp6' !fun !tys !term1 !term2 !term3 !term4 !term5 (force -> !d) =
+        eraseTerm $ mkIterAppNoAnn instantiated [term1, term2, term3, term4, term5, mkConstant () d]
+        where instantiated = mkIterInstNoAnn (builtin () fun) tys
+
+      mkBMs l =
+        let caseConstr = mkCase2 integer (list tydata)
+            caseMap    = mkCase1 (list (pair tydata tydata))
+            caseList   = mkCase1 (list tydata)
+            caseI      = mkCase1 integer
+            caseB      = mkCase1 bytestring
+        in [ bgroup "1"  -- Fake size for term arguments
+             [ bgroup "1"
+               [ bgroup "1"
+                 [ bgroup "1"
+                   [ bgroup "1"
+                     [ benchDefault
+                       (showMemoryUsage d)
+                       (mkApp6' name [unit] caseConstr caseMap caseList caseI caseB d)
+                     ]
+                   ]
+                 ]
+               ]
+             ]
+           | d <- l ]
+  in bgroup (show name) $ mkBMs inputs
+
 makeBenchmarks :: StdGen -> [Benchmark]
 makeBenchmarks gen =
     [ benchChooseData
@@ -148,4 +207,5 @@ makeBenchmarks gen =
     , benchUnBData
     , benchEqualsData
     , benchSerialiseData
+    , benchCaseData
     ]

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

@@ -1,17 +1,23 @@
-module Benchmarks.Lists (makeBenchmarks) where
+{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns      #-}
+
+module Benchmarks.Lists where
 
 import Common
 import Generators
 
 import PlutusCore
+import PlutusCore.Compiler.Erase (eraseTerm)
+import PlutusCore.Evaluation.Machine.ExMemoryUsage (IntegerCostedLiterally (..))
+import PlutusCore.MkPlc (builtin, mkConstant, mkIterAppNoAnn, mkIterInstNoAnn)
 
+import Control.DeepSeq (force)
 import Criterion.Main
 import Data.ByteString (ByteString)
 import Hedgehog qualified as H
-import PlutusCore.Evaluation.Machine.ExMemoryUsage (IntegerCostedLiterally (..))
 import System.Random (StdGen, randomR)
 
-
 {- Some functions for generating lists of sizes integers/bytestrings The time
    behaviour of the list functions should be independent of the sizes and types
    of the arguments (and in fact constant), but we benchmark them with both
@@ -41,6 +47,12 @@ makeListOfByteStringLists seed ((count, size):rest) =
 intLists :: StdGen -> [[Integer]]
 intLists gen = makeListOfIntegerLists gen [(count,size) | count <- [0..7], size <- [1..7]]
 
+biggerIntLists :: StdGen -> [[Integer]]
+biggerIntLists gen =
+  makeListOfIntegerLists gen [ (count,size)
+                             | count <- [0, 10, 20, 50, 100, 500, 1000]
+                             , size <- [1..7] ]
+
 -- Make a list of n integers whose value is less than or equal to m
 intMaxList :: Integer -> Integer -> StdGen -> [Integer]
 intMaxList 0 _ _ = []
@@ -54,6 +66,12 @@ byteStringLists :: H.Seed -> [[ByteString]]
 byteStringLists seed =
     makeListOfByteStringLists seed [(count,size) | count <- [0..7], size <- [0, 500..3000]]
 
+biggerByteStringLists :: H.Seed -> [[ByteString]]
+biggerByteStringLists seed =
+    makeListOfByteStringLists seed [ (count,size)
+                                   | count <- [0, 10, 20, 50, 100, 500, 1000]
+                                   , size <- [0, 500..3000] ]
+
 nonEmptyByteStringLists :: H.Seed -> [[ByteString]]
 nonEmptyByteStringLists seed =
     makeListOfByteStringLists seed [(count,size) | count <- [1..7], size <- [0, 500..3000]]
@@ -71,11 +89,11 @@ benchChooseList gen =
         intInputs = take 10 $ intLists gen
         bsInputs  = take 10 $ byteStringLists seedA
         mkBMs tys inputs = [ bgroup (showMemoryUsage x)
-                           [ bgroup (showMemoryUsage r1)
-                            [ benchDefault (showMemoryUsage r2) $ mkApp3 name tys x r1 r2
-                            | r2 <- results2 ]
-                           | r1 <- results1 ]
-                          | x <- inputs ]
+                             [ bgroup (showMemoryUsage r1)
+                               [ benchDefault (showMemoryUsage r2) $ mkApp3 name tys x r1 r2
+                               | r2 <- results2 ]
+                             | r1 <- results1 ]
+                           | x <- inputs ]
     in bgroup (show name) (mkBMs [integer,bytestring] intInputs
                             ++ mkBMs [bytestring,bytestring] bsInputs)
 
@@ -119,11 +137,55 @@ benchDropList gen =
     in createTwoTermBuiltinBenchElementwiseWithWrappers
            (IntegerCostedLiterally, id) name [bytestring] inputs
 
+
+{- Benchmark `caseList (con unit ()) (lam x (lam y (con unit ()))) l` to minimise
+the amount of extra work the evaluator has to do to compute the final result
+after the builtin returns (which will be included in the cost of the builtin)..
+We can't re-use the functions that we use for other benchmarks because the term
+arguments have to be treated separately, so there's quite a bit of extra
+machinery in here; it seems unlikely to be more generally useful, so for the
+time being it's kept local to this function.
+-}
+benchCaseList :: StdGen -> Benchmark
+benchCaseList gen =
+    let name = CaseList
+        y = Name "y" (Unique 1)
+        ys = Name "ys" (Unique 2)
+        -- lam y (con unit ())
+        mkCase1 ty = LamAbs () y ty (mkConstant () ())
+        -- lam y (lam ys (con unit ()))
+        mkCase2 ty = LamAbs () y ty (LamAbs () ys (list ty) (mkConstant () ()))
+        -- Two different types of inputs, just to make sure there's no difference
+        -- Use `take` just in case we make the list bigger later
+        intInputs = take 50 $ biggerIntLists gen
+        bsInputs  = take 50 $ biggerByteStringLists seedA
+        -- Like mkApp3, but the first two arguments are terms (in fact values)
+        mkApp3' !fun !tys !term1 !term2 (force -> !l) =
+          eraseTerm $ mkIterAppNoAnn instantiated [term1, term2, mkConstant () l]
+          where instantiated = mkIterInstNoAnn (builtin () fun) tys
+
+        mkBMs ty inputs =
+          let case1 = mkCase1 ty
+              case2 = mkCase2 ty
+          in [ bgroup "1" -- Fake size for term arguments
+               [ bgroup "1"
+                 [ benchDefault
+                   -- Strictly it might be better to cost the list by length
+                   -- here, but it's constant time anyway so it shouldn't
+                   -- matter.
+                   (showMemoryUsage l)
+                   (mkApp3' name [ty, unit] case1 case2 l)
+                 ]
+               ]
+             | l <- inputs ]
+    in bgroup (show name) (mkBMs integer intInputs ++ mkBMs bytestring bsInputs)
+
 makeBenchmarks :: StdGen -> [Benchmark]
 makeBenchmarks gen = [ benchChooseList gen
                      , benchMkCons gen
                      , benchNonEmptyList gen HeadList
                      , benchNonEmptyList gen TailList
                      , benchNullList gen
                      , benchDropList gen
+                     , benchCaseList gen
                      ]