SOP vs Scott bench

plutus-benchmark/plutus-benchmark.cabal

@@ -277,6 +277,52 @@ benchmark casing
     , plutus-benchmark-common
     , plutus-ledger-api        ^>=1.54
 
+---------------- casing ----------------
+
+library sop-internal
+  import:          lang, ghc-version-support, os-support
+  hs-source-dirs:  sop/src
+  exposed-modules:
+    PlutusBenchmark.SOP.Big.Scott
+    PlutusBenchmark.SOP.Big.SOP
+    PlutusBenchmark.SOP.Common
+    PlutusBenchmark.SOP.List.Scott
+    PlutusBenchmark.SOP.List.SOP
+
+  build-depends:
+    , base              >=4.9   && <5
+    , plutus-core       ^>=1.54
+    , plutus-tx
+    , plutus-tx-plugin
+
+benchmark sop-exbudget
+  import:         lang, ghc-version-support, os-support
+  type:           exitcode-stdio-1.0
+  main-is:        Main.hs
+  hs-source-dirs: sop/exe
+  build-depends:
+    , base                         >=4.9 && <5
+    , plutus-benchmark-common
+    , plutus-core
+    , plutus-tx
+    , plutus-tx:plutus-tx-testlib
+    , sop-internal
+
+benchmark sop
+  import:         lang, ghc-version-support, os-support
+  type:           exitcode-stdio-1.0
+  main-is:        Main.hs
+  hs-source-dirs: sop/bench
+  build-depends:
+    , base                         >=4.9 && <5
+    , criterion
+    , plutus-benchmark-common
+    , plutus-core
+    , plutus-ledger-api
+    , plutus-tx
+    , plutus-tx:plutus-tx-testlib
+    , sop-internal
+
 ---------------- data ----------------
 
 library data-internal

plutus-benchmark/sop/README.md

@@ -0,0 +1,71 @@
+# SOP vs Scott
+
+This benchmark compares SOP encoded values and Scott encoded values in terms of their ExBudget usage. 
+
+## Cases
+### List 
+```hs
+data List x = Cons x (List x) | Nil
+```
+
+Tests `replicate` for measuring construction and `sum` for destruction.
+
+### Big
+```hs
+data Big
+  = BigA Integer Integer Integer Integer Integer Big
+  | BigB Integer Integer Integer Integer Integer Big
+  | BigC Integer Integer Integer Integer Integer Big
+  | BigD Integer Integer Integer Integer Integer Big
+  | BigE Integer Integer Integer Integer Integer Big
+  | BigNil
+```
+
+Tests `replicate` for measuring construction and `sum` for destruction. 
+
+`replicate` is implemented like
+```hs
+replicate :: Integer -> Integer -> ScottBig
+replicate 0 _ = ScottBigNil
+replicate n x =
+  ScottBigA x x x x x
+   (ScottBigB x x x x x
+    (ScottBigC x x x x x
+     (ScottBigD x x x x x
+      (ScottBigE x x x x x (replicate (n - 1) x)))))
+```
+
+`sum` adds up all integer in the `Big` structure.
+
+## Result
+## List, replicate 50
+
+| Category |      Scott |        SOP | % Difference |
+|----------|-----------:|-----------:|-------------:|
+| CPU      | 38,870,686 | 38,070,686 |       -2.06% |
+| MEM      |    173,402 |    168,402 |       -2.88% |
+| Size     |         62 |         51 |      -17.74% |
+
+## List, sum
+
+| Category |      Scott |        SOP | % Difference |
+|----------|-----------:|-----------:|-------------:|
+| CPU      | 24,548,500 | 18,052,500 |      -26.45% |
+| MEM      |    122,000 |     81,400 |      -33.28% |
+| Size     |        378 |        123 |      -67.46% |
+
+## Big, replicate 10
+
+| Category |     Scott |        SOP | % Difference |
+|----------|----------:|-----------:|-------------:|
+| CPU      | 9,880,382 | 12,280,382 |       24.24% |
+| MEM      |    46,742 |     61,742 |       32.10% |
+| Size     |       157 |         70 |      -55.41% |
+
+## Big, sum
+
+| Category |      Scott |        SOP | % Difference |
+|----------|-----------:|-----------:|-------------:|
+| CPU      | 76,982,100 | 57,494,100 |      -25.30% |
+| MEM      |    323,600 |    201,800 |      -37.61% |
+| Size     |      1,130 |        467 |      -58.67% |

plutus-benchmark/sop/bench/Main.hs

@@ -0,0 +1,114 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module Main where
+
+import Control.Exception
+import Criterion.Main
+import Data.SatInt
+import PlutusBenchmark.Common (benchTermCek, compiledCodeToTerm, getConfig, mkMostRecentEvalCtx)
+import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..))
+import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC
+import PlutusCore.Evaluation.Machine.ExMemory
+import PlutusLedgerApi.Common (EvaluationContext)
+import PlutusTx.Code
+import UntypedPlutusCore qualified as UPLC
+import UntypedPlutusCore.Evaluation.Machine.Cek qualified as Cek
+
+import PlutusBenchmark.SOP.Big.Scott qualified as ScottBig
+import PlutusBenchmark.SOP.Big.SOP qualified as SOPBig
+import PlutusBenchmark.SOP.Common
+import PlutusBenchmark.SOP.List.Scott qualified as ScottList
+import PlutusBenchmark.SOP.List.SOP qualified as SOPList
+
+getBudgetUsage :: CompiledCode a -> Maybe (Integer, Integer, Integer)
+getBudgetUsage (compiledCodeToTerm -> term) =
+    case (\(Cek.CekReport fstT sndT _) -> (Cek.cekResultToEither fstT, sndT)) $
+      Cek.runCekDeBruijn PLC.defaultCekParametersForTesting Cek.counting Cek.noEmitter term
+    of
+      (Left _, _)                 -> Nothing
+      (Right _, Cek.CountingSt c) ->
+          let
+            ExCPU (fromSatInt -> cpu) = exBudgetCPU c
+            ExMemory (fromSatInt -> mem) = exBudgetMemory c
+          in Just $ (cpu, mem, UPLC.unAstSize $ UPLC.termAstSize term)
+
+printBudget :: String -> CompiledCode a -> IO ()
+printBudget name c =
+  case getBudgetUsage c of
+    Nothing -> putStrLn $ name <> " evaluation failed"
+    Just (cpu, mem, size) -> do
+      -- print $ pretty $ getPlcNoAnn c
+      putStrLn $ name <> ", " <> show cpu <> ", " <> show mem <> ", " <> show size
+
+benchmarks :: EvaluationContext -> [Benchmark]
+benchmarks ctx =
+  let
+    sopList :: CompiledCode (SOPList.SOPList Integer)
+    sopList =
+      SOPList.replicateSOPList
+        `app` (liftCode110Norm 50)
+        `app` (liftCode110Norm 42)
+
+    scottList :: CompiledCode (ScottList.ScottList Integer)
+    scottList =
+      ScottList.replicateScottList
+        `app` (liftCode110Norm 50)
+        `app` (liftCode110Norm 42)
+
+    sumSopList :: CompiledCode Integer
+    sumSopList =
+      SOPList.sumSOPList
+        `app` (normCompiledCode sopList)
+
+    sumScottList :: CompiledCode Integer
+    sumScottList =
+      ScottList.sumScottList
+        `app` (normCompiledCode scottList)
+
+    bigNest = 10
+
+    sopBig :: CompiledCode SOPBig.SOPBig
+    sopBig =
+      SOPBig.mkSOPBigFull
+        `app` (liftCode110Norm bigNest)
+        `app` (liftCode110Norm 42)
+
+    scottBig :: CompiledCode ScottBig.ScottBig
+    scottBig =
+      ScottBig.mkScottBigFull
+        `app` (liftCode110Norm bigNest)
+        `app` (liftCode110Norm 42)
+
+    sumSopBig :: CompiledCode Integer
+    sumSopBig =
+      SOPBig.sumSOPBig
+        `app` (normCompiledCode sopBig)
+
+    sumScottBig :: CompiledCode Integer
+    sumScottBig =
+      ScottBig.sumScottBig
+        `app` (normCompiledCode scottBig)
+  in [ bgroup "List, replicate 50"
+       [ bench "scott" $ benchTermCek ctx (UPLC._progTerm $ getPlcNoAnn scottList)
+       , bench "sop" $ benchTermCek ctx (UPLC._progTerm $ getPlcNoAnn sopList)
+       ]
+     , bgroup "List, sum"
+       [ bench "scott" $ benchTermCek ctx (UPLC._progTerm $ getPlcNoAnn sumScottList)
+       , bench "sop" $ benchTermCek ctx (UPLC._progTerm $ getPlcNoAnn sumSopList)
+       ]
+     , bgroup ("Big, replicate " <> show bigNest)
+       [ bench "scott" $ benchTermCek ctx (UPLC._progTerm $ getPlcNoAnn scottBig)
+       , bench "sop" $ benchTermCek ctx (UPLC._progTerm $ getPlcNoAnn sopBig)
+       ]
+     , bgroup "Big, sum "
+       [ bench "scott" $ benchTermCek ctx (UPLC._progTerm $ getPlcNoAnn sumScottBig)
+       , bench "sop" $ benchTermCek ctx (UPLC._progTerm $ getPlcNoAnn sumSopBig)
+       ]
+     ]
+
+main :: IO ()
+main = do
+  -- Run each benchmark for at least 15 seconds.  Change this with -L or --timeout.
+  config <- getConfig 15.0
+  evalCtx <- evaluate mkMostRecentEvalCtx
+  defaultMainWith config $ benchmarks evalCtx

plutus-benchmark/sop/exe/Main.hs

@@ -0,0 +1,104 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module Main where
+
+import Data.SatInt
+import PlutusBenchmark.Common (compiledCodeToTerm)
+import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..))
+import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC
+import PlutusCore.Evaluation.Machine.ExMemory
+import PlutusCore.Pretty
+import PlutusTx.Code
+import UntypedPlutusCore qualified as UPLC
+import UntypedPlutusCore.Evaluation.Machine.Cek qualified as Cek
+
+import PlutusBenchmark.SOP.Big.Scott qualified as ScottBig
+import PlutusBenchmark.SOP.Big.SOP qualified as SOPBig
+import PlutusBenchmark.SOP.Common
+import PlutusBenchmark.SOP.List.Scott qualified as ScottList
+import PlutusBenchmark.SOP.List.SOP qualified as SOPList
+
+getBudgetUsage :: CompiledCode a -> Maybe (Integer, Integer, Integer)
+getBudgetUsage (compiledCodeToTerm -> term) =
+    case (\(Cek.CekReport fstT sndT _) -> (Cek.cekResultToEither fstT, sndT)) $
+      Cek.runCekDeBruijn PLC.defaultCekParametersForTesting Cek.counting Cek.noEmitter term
+    of
+      (Left _, _)                 -> Nothing
+      (Right _, Cek.CountingSt c) ->
+          let
+            ExCPU (fromSatInt -> cpu) = exBudgetCPU c
+            ExMemory (fromSatInt -> mem) = exBudgetMemory c
+          in Just $ (cpu, mem, UPLC.unAstSize $ UPLC.termAstSize term)
+
+printBudget :: String -> CompiledCode a -> IO ()
+printBudget name c =
+  case getBudgetUsage c of
+    Nothing -> putStrLn $ name <> " evaluation failed"
+    Just (cpu, mem, size) -> do
+      -- print $ pretty $ getPlcNoAnn c
+      putStrLn $ name <> ", " <> show cpu <> ", " <> show mem <> ", " <> show size
+
+main :: IO ()
+main = do
+  let
+    sopList :: CompiledCode (SOPList.SOPList Integer)
+    sopList =
+      SOPList.replicateSOPList
+        `app` (liftCode110Norm 50)
+        `app` (liftCode110Norm 42)
+
+    scottList :: CompiledCode (ScottList.ScottList Integer)
+    scottList =
+      ScottList.replicateScottList
+        `app` (liftCode110Norm 50)
+        `app` (liftCode110Norm 42)
+
+    sumSopList :: CompiledCode Integer
+    sumSopList =
+      SOPList.sumSOPList
+        `app` (normCompiledCode sopList)
+
+    sumScottList :: CompiledCode Integer
+    sumScottList =
+      ScottList.sumScottList
+        `app` (normCompiledCode scottList)
+
+    bigNest = 10
+
+    sopBig :: CompiledCode SOPBig.SOPBig
+    sopBig =
+      SOPBig.mkSOPBigFull
+        `app` (liftCode110Norm bigNest)
+        `app` (liftCode110Norm 42)
+
+    scottBig :: CompiledCode ScottBig.ScottBig
+    scottBig =
+      ScottBig.mkScottBigFull
+        `app` (liftCode110Norm bigNest)
+        `app` (liftCode110Norm 42)
+
+    sumSopBig :: CompiledCode Integer
+    sumSopBig =
+      SOPBig.sumSOPBig
+        `app` (normCompiledCode sopBig)
+
+    sumScottBig :: CompiledCode Integer
+    sumScottBig =
+      ScottBig.sumScottBig
+        `app` (normCompiledCode scottBig)
+
+  putStrLn "List, replicate 50"
+  printBudget "SOP" sopList
+  printBudget "Scott" scottList
+
+  putStrLn "List, sum"
+  printBudget "SOP" sumSopList
+  printBudget "Scott" sumScottList
+
+  putStrLn $ "Big, replicate " <> show bigNest
+  printBudget "SOP" sopBig
+  printBudget "Scott" scottBig
+
+  putStrLn "Big, sum"
+  printBudget "SOP" sumSopBig
+  printBudget "Scott" sumScottBig

plutus-benchmark/sop/src/PlutusBenchmark/SOP/Big/SOP.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE DataKinds       #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-}
+{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:datatypes=SumsOfProducts #-}
+
+module PlutusBenchmark.SOP.Big.SOP where
+
+import PlutusTx
+import PlutusTx.Prelude
+import Prelude ()
+
+data SOPBig
+  = SOPBigA Integer Integer Integer Integer Integer SOPBig
+  | SOPBigB Integer Integer Integer Integer Integer SOPBig
+  | SOPBigC Integer Integer Integer Integer Integer SOPBig
+  | SOPBigD Integer Integer Integer Integer Integer SOPBig
+  | SOPBigE Integer Integer Integer Integer Integer SOPBig
+  | SOPBigNil
+
+mkSOPBigFull' :: Integer -> Integer -> SOPBig
+mkSOPBigFull' 0 _ = SOPBigNil
+mkSOPBigFull' n x =
+  SOPBigA x x x x x
+   (SOPBigB x x x x x
+    (SOPBigC x x x x x
+     (SOPBigD x x x x x
+      (SOPBigE x x x x x (mkSOPBigFull' (n - 1) x)))))
+
+sumSOPBig' :: SOPBig -> Integer
+sumSOPBig' (SOPBigA a b c d e rest) =
+  a + b + c + d + e + (sumSOPBig' rest)
+sumSOPBig' (SOPBigB a b c d e rest) =
+  a + b + c + d + e + (sumSOPBig' rest)
+sumSOPBig' (SOPBigC a b c d e rest) =
+  a + b + c + d + e + (sumSOPBig' rest)
+sumSOPBig' (SOPBigD a b c d e rest) =
+  a + b + c + d + e + (sumSOPBig' rest)
+sumSOPBig' (SOPBigE a b c d e rest) =
+  a + b + c + d + e + (sumSOPBig' rest)
+sumSOPBig' SOPBigNil = 0
+
+mkSOPBigFull :: CompiledCode (Integer -> Integer -> SOPBig)
+mkSOPBigFull = $$(compile [||mkSOPBigFull'||])
+
+sumSOPBig :: CompiledCode (SOPBig -> Integer)
+sumSOPBig = $$(compile [||sumSOPBig'||])