Add some benchmarks for a list matching task (#5683)

This mirrors what some DEXs do, and is very expensive since you do
quadratic work. It would be much faster with an array primitive.

plutus-benchmark/lists/src/PlutusBenchmark/Lists/Lookup/Compiled.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+module PlutusBenchmark.Lists.Lookup.Compiled where
+
+import PlutusTx qualified as Tx
+import PlutusTx.Builtins qualified as B
+import PlutusTx.Builtins.Internal qualified as BI
+import PlutusTx.Lift ()
+import PlutusTx.List qualified as L
+import PlutusTx.Prelude qualified as P
+
+{-
+A simple matching workload:
+- Two lists of indices (rather than a list of pairs to avoid having to put pairs in a
+builtin list)
+- Two lists of numbers
+
+The task is to go through the indices in sync, taking the corresponding number from each
+list, and adding them all.
+
+This is naturally quadratic for a linked-list.
+-}
+type Workload f = (f Integer, f Integer, f Integer, f Integer)
+
+workloadOfSize :: Integer -> Workload []
+workloadOfSize sz =
+  let
+    lixs = [0 .. (sz-1)]
+    rixs = reverse lixs
+    ls = take (fromIntegral sz) [1,3 ..]
+    rs = take (fromIntegral sz) [1,2..]
+  in (lixs, rixs, ls, rs)
+
+workloadLToBl :: Workload [] -> Workload BI.BuiltinList
+workloadLToBl (lixs, rixs, ls, rs) =
+  (BI.BuiltinList lixs, BI.BuiltinList rixs, BI.BuiltinList ls, BI.BuiltinList rs)
+
+matchWithLists :: Workload [] -> Integer
+matchWithLists (lixs, rixs, ls, rs) = go lixs rixs 0
+  where
+    go (lix:lrest) (rix:rrest) acc =
+      go lrest rrest ((ls L.!! lix) `B.addInteger` (rs L.!! rix) `B.addInteger` acc)
+    go _ _ acc = acc
+
+mkMatchWithListsCode :: Workload [] -> Tx.CompiledCode Integer
+mkMatchWithListsCode l = $$(Tx.compile [|| matchWithLists ||]) `Tx.unsafeApplyCode` Tx.liftCodeDef l
+
+matchWithBuiltinLists :: Workload BI.BuiltinList -> Integer
+matchWithBuiltinLists (lixs, rixs, ls, rs) = go lixs rixs 0
+  where
+    go ltodo rtodo acc =
+      B.matchList
+        ltodo
+        acc
+        (\lix lrest -> B.matchList rtodo acc
+          (\rix rrest -> go lrest rrest
+            ((ls !! lix) `B.addInteger` (rs !! rix) `B.addInteger` acc)))
+    l !! ix =
+      B.matchList
+        l
+        (\() -> P.traceError "empty list")
+        (\h t -> \() -> if ix P.== 0 then h else t !! (ix `B.subtractInteger` 1))
+        ()
+
+mkMatchWithBuiltinListsCode :: Workload [] -> Tx.CompiledCode Integer
+mkMatchWithBuiltinListsCode l =
+  $$(Tx.compile [|| matchWithBuiltinLists ||]) `Tx.unsafeApplyCode` Tx.liftCodeDef (workloadLToBl l)

plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.eval.golden

@@ -0,0 +1,2 @@
+({cpu: 282508764
+| mem: 856552})

plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.eval.golden

@@ -0,0 +1,2 @@
+({cpu: 23474602554
+| mem: 69678832})

plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.eval.golden

@@ -0,0 +1,2 @@
+({cpu: 85015834
+| mem: 263092})

plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.eval.golden

@@ -0,0 +1,2 @@
+({cpu: 5996604004
+| mem: 17844232})

plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.eval.golden

@@ -0,0 +1,2 @@
+({cpu: 188350620
+| mem: 557080})

plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.eval.golden

@@ -0,0 +1,2 @@
+({cpu: 14193534300
+| mem: 39720400})

plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.eval.golden

@@ -0,0 +1,2 @@
+({cpu: 61018710
+| mem: 188240})

plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.eval.golden

@@ -0,0 +1,2 @@
+({cpu: 3672944700
+| mem: 10355000})

plutus-benchmark/lists/test/Lookup/Spec.hs

@@ -0,0 +1,25 @@
+module Lookup.Spec (tests) where
+
+import Test.Tasty
+import Test.Tasty.Extras (TestNested, runTestGroupNestedGhc)
+
+import PlutusBenchmark.Lists.Lookup.Compiled qualified as Compiled
+
+import PlutusTx.Test qualified as Tx
+
+-- Make a set of golden tests with results stored in a given subdirectory
+-- inside a subdirectory determined by the GHC version.
+testGroupGhcIn :: [FilePath] -> [TestNested] -> TestTree
+testGroupGhcIn dir = runTestGroupNestedGhc (["lists", "test"] ++ dir)
+
+tests :: TestTree
+tests =
+  testGroupGhcIn ["Lookup"] $
+    flip concatMap sizes $ \sz ->
+      [ Tx.goldenBudget ("match-scott-list-" ++ show sz) $
+        Compiled.mkMatchWithListsCode (Compiled.workloadOfSize sz)
+      , Tx.goldenBudget ("match-builtin-list-" ++ show sz) $
+        Compiled.mkMatchWithBuiltinListsCode (Compiled.workloadOfSize sz)
+      ]
+  where
+    sizes = [5, 10, 50, 100]

plutus-benchmark/lists/test/Spec.hs

@@ -6,6 +6,7 @@ module Main (main) where
 
 import Test.Tasty
 
+import Lookup.Spec qualified as Lookup
 import Sort.Spec qualified as Sort
 import Sum.Spec qualified as Sum
 
@@ -14,6 +15,7 @@ allTests =
   testGroup "plutus-benchmark list tests"
     [ Sort.tests
     , Sum.tests
+    , Lookup.tests
     ]
 
 main :: IO ()

plutus-benchmark/plutus-benchmark.cabal

@@ -180,6 +180,7 @@ library lists-internal
   ghc-options:     -Wno-unused-packages
   hs-source-dirs:  lists/src
   exposed-modules:
+    PlutusBenchmark.Lists.Lookup.Compiled
     PlutusBenchmark.Lists.Sort
     PlutusBenchmark.Lists.Sum.Compiled
     PlutusBenchmark.Lists.Sum.HandWritten
@@ -226,6 +227,7 @@ test-suite plutus-benchmark-lists-tests
   main-is:        Spec.hs
   hs-source-dirs: lists/test
   other-modules:
+    Lookup.Spec
     Sort.Spec
     Sum.Spec