From b81fb5e8c52d3ebab9407010c0324b3ccf0144c6 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Mon, 21 Aug 2023 10:18:05 +1000 Subject: [PATCH 1/3] Bench: UMap.size on a monomorphic UMap Run this using `cabal bench umap`. --- libs/cardano-ledger-core/bench/UMap.hs | 56 +++++++++++++++++++ .../cardano-ledger-core.cabal | 18 ++++++ 2 files changed, 74 insertions(+) create mode 100644 libs/cardano-ledger-core/bench/UMap.hs diff --git a/libs/cardano-ledger-core/bench/UMap.hs b/libs/cardano-ledger-core/bench/UMap.hs new file mode 100644 index 00000000000..ae1838aa1c8 --- /dev/null +++ b/libs/cardano-ledger-core/bench/UMap.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +import Cardano.Ledger.Crypto (StandardCrypto) +import Cardano.Ledger.UMap (UMap) +import qualified Cardano.Ledger.UMap as UMap + +import Control.Monad (replicateM) + +import Criterion (Benchmark, bench, env, nf) +import Criterion.Main (defaultMain) + +import qualified Data.Map.Strict as Map + +import Test.Cardano.Ledger.Core.Arbitrary () +import Test.QuickCheck (arbitrary, generate) + +main :: IO () +main = do + defaultMain $ + map (\c -> env (generateUMap c) umapSizeBench) (map (* 10000) [1 .. 2]) + where + umapSizeBench :: UMap StandardCrypto -> Benchmark + umapSizeBench umap = + bench ("compositeSize (" ++ show (compositeSize umap) ++ ")") (nf compositeSize umap) + +-- ------------------------------------------------------------------------------------------------- + +compositeSize :: UMap StandardCrypto -> Int +compositeSize umap = + sum + [ UMap.size (UMap.RewDepUView umap) + , UMap.size (UMap.PtrUView umap) + , UMap.size (UMap.SPoolUView umap) + , UMap.size (UMap.DRepUView umap) + ] + +-- Generate a UView of exactly the size specified. +generateUMap :: Int -> IO (UMap StandardCrypto) +generateUMap size = + generate $ do + ptrs <- replicateM size arbitrary + sPools <- replicateM size arbitrary + dReps <- replicateM size arbitrary + creds <- replicateM size arbitrary + rdPairs <- replicateM size arbitrary + pure $ + UMap.unify + (Map.fromList $ zip creds rdPairs) + (Map.fromList $ zip ptrs creds) + (Map.fromList $ zip creds sPools) + (Map.fromList $ zip creds dReps) diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal index 19d097ccf0e..f08b2d7b4ca 100644 --- a/libs/cardano-ledger-core/cardano-ledger-core.cabal +++ b/libs/cardano-ledger-core/cardano-ledger-core.cabal @@ -191,3 +191,21 @@ test-suite tests genvalidity, genvalidity-scientific, scientific + +benchmark umap + type: exitcode-stdio-1.0 + main-is: UMap.hs + hs-source-dirs: bench + default-language: Haskell2010 + ghc-options: + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints -Wunused-packages + -threaded -rtsopts -O2 + + build-depends: + base, + cardano-ledger-core, + testlib, + containers, + criterion, + QuickCheck From b2deaefb8c60bd4a54662eaa06a3181493ec7c88 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Fri, 25 Aug 2023 11:41:14 +1000 Subject: [PATCH 2/3] Bench: Address decoding The code decode function is `decodeAddrStateAllowLeftoverT` and we bench this via `decodeAddrEither`. Run this with `cabal bench addr`. --- libs/cardano-ledger-core/bench/Addr.hs | 47 +++++++++++++++++++ .../cardano-ledger-core.cabal | 18 +++++++ 2 files changed, 65 insertions(+) create mode 100644 libs/cardano-ledger-core/bench/Addr.hs diff --git a/libs/cardano-ledger-core/bench/Addr.hs b/libs/cardano-ledger-core/bench/Addr.hs new file mode 100644 index 00000000000..2e8d32ebcb5 --- /dev/null +++ b/libs/cardano-ledger-core/bench/Addr.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +import Cardano.Ledger.Address (Addr, decodeAddrEither, serialiseAddr) +import Cardano.Ledger.Crypto (StandardCrypto) + +import Control.Monad (replicateM) + +import Criterion (Benchmark, bench, env, nf) +import Criterion.Main (defaultMain) + +import Data.ByteString.Char8 (ByteString) +import Data.Either (lefts) + +import Test.Cardano.Ledger.Core.Arbitrary () +import Test.QuickCheck (arbitrary, generate) + +main :: IO () +main = do + defaultMain $ + map (\c -> env (generateAddrAsBytestring c) decodeAddrBench) (map (* 500) [1 .. 2]) + where + decodeAddrBench :: [ByteString] -> Benchmark + decodeAddrBench xs = + bench ("decodeAddr (" ++ show (length xs) ++ ")") (nf tryDecodeAddr xs) + +-- ------------------------------------------------------------------------------------------------- + +generateAddrAsBytestring :: Int -> IO [ByteString] +generateAddrAsBytestring count = + replicateM count (serialiseAddr <$> genAddr) + where + genAddr :: IO (Addr StandardCrypto) + genAddr = generate arbitrary + +tryDecodeAddr :: [ByteString] -> () +tryDecodeAddr xs = + case lefts $ map decode xs of + [] -> () + ys -> error $ "tryDecodeAddr: " ++ show ys + where + decode :: ByteString -> Either String (Addr StandardCrypto) + decode = decodeAddrEither diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal index f08b2d7b4ca..b87edada79f 100644 --- a/libs/cardano-ledger-core/cardano-ledger-core.cabal +++ b/libs/cardano-ledger-core/cardano-ledger-core.cabal @@ -209,3 +209,21 @@ benchmark umap containers, criterion, QuickCheck + +benchmark addr + type: exitcode-stdio-1.0 + main-is: Addr.hs + hs-source-dirs: bench + default-language: Haskell2010 + ghc-options: + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints -Wunused-packages + -threaded -rtsopts -O2 + + build-depends: + base, + bytestring, + cardano-ledger-core, + testlib, + criterion, + QuickCheck From c590e2a488c77a20a0e04f2e9fbd1d4ac2a7f0cb Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Mon, 28 Aug 2023 09:33:30 +1000 Subject: [PATCH 3/3] Update hie.yaml --- hie.yaml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/hie.yaml b/hie.yaml index de364e24d59..fd5948b3148 100644 --- a/hie.yaml +++ b/hie.yaml @@ -186,6 +186,12 @@ cradle: - path: "libs/cardano-ledger-core/test" component: "cardano-ledger-core:test:tests" + - path: "libs/cardano-ledger-core/bench/UMap.hs" + component: "cardano-ledger-core:bench:umap" + + - path: "libs/cardano-ledger-core/bench/Addr.hs" + component: "cardano-ledger-core:bench:addr" + - path: "libs/cardano-ledger-pretty/src" component: "lib:cardano-ledger-pretty"