From 6957f6d1620d026f9980592594f3b74c09e84aa8 Mon Sep 17 00:00:00 2001 From: archaephyrryx Date: Thu, 27 Aug 2020 17:05:46 -0400 Subject: [PATCH] Adds benchmarks for {elem,find}Ind{ex,ices} Adds separate benchmark suite for comparing the relative performance of findIndex, findIndices, elemIndex, and elemIndices over first occurence and second occurence in sparse strict bytestring Also includes benchmark for performance of uninlined versus inlined equality test as predicate for findIndex and findIndices --- bench/BenchIndices.hs | 136 +++++++++++++++++++++++++++++++++++ bench/bench-bytestring.cabal | 19 +++++ 2 files changed, 155 insertions(+) create mode 100644 bench/BenchIndices.hs diff --git a/bench/BenchIndices.hs b/bench/BenchIndices.hs new file mode 100644 index 000000000..70cf4d0d8 --- /dev/null +++ b/bench/BenchIndices.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE BangPatterns #-} +-- | +-- Copyright : (c) 2011 Simon Meier +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Simon Meier +-- Stability : experimental +-- Portability : tested on GHC only +-- +-- Benchmark all 'Builder' functions. +module Main (main) where + +import Data.Foldable (foldMap) +import Data.Monoid +import Data.String +import Gauge +import Prelude hiding (words) +import GHC.Word (Word8, eqWord8) + +import qualified Data.ByteString as S +import qualified Data.ByteString.Unsafe as S + + +------------------------------------------------------------------------------ +-- Benchmark +------------------------------------------------------------------------------ + + + +-- lines of 200 letters from a to e, followed by repeated letter f +absurdlong :: S.ByteString +absurdlong = S.replicate 200 0x61 <> S.singleton 0xa + <> S.replicate 200 0x62 <> S.singleton 0xa + <> S.replicate 200 0x63 <> S.singleton 0xa + <> S.replicate 200 0x64 <> S.singleton 0xa + <> S.replicate 200 0x65 <> S.singleton 0xa + <> S.replicate 999999 0x66 +{-# NOINLINE absurdlong #-} + +main :: IO () +main = do + Gauge.defaultMain + [ bgroup "ByteString strict first index" $ + [ bench "FindIndices" $ nf bench_find_indices_first absurdlong + , bench "ElemIndices" $ nf bench_elem_indices_first absurdlong + , bench "FindIndex" $ nf bench_find_index_first absurdlong + , bench "ElemIndex" $ nf bench_elem_index_first absurdlong + ] + , bgroup "ByteString strict second index" $ + [ bench "FindIndices" $ nf bench_find_indices_second absurdlong + , bench "ElemIndices" $ nf bench_elem_indices_second absurdlong + , bench "FindIndex" $ nf bench_find_index_second absurdlong + , bench "ElemIndex" $ nf bench_elem_index_second absurdlong + ] + , bgroup "ByteString index equality inlining" $ + [ bench "FindIndices/inlined" $ nf bench_find_indices_inline absurdlong + , bench "FindIndices/non-inlined" $ nf bench_find_indices_noinline absurdlong + , bench "FindIndex/inlined" $ nf bench_find_index_inline absurdlong + , bench "FindIndex/non-inlined" $ nf bench_find_index_noinline absurdlong + ] + ] + +safeHead :: [Int] -> Maybe Int +safeHead (!x:_) = Just x +safeHead _ = Nothing +{-# INLINE safeHead #-} + +bench_find_indices :: S.ByteString -> [Int] +bench_find_indices = S.findIndices (== 0xa) +{-# INLINE bench_find_indices #-} + +bench_elem_indices :: S.ByteString -> [Int] +bench_elem_indices = S.elemIndices 0xa +{-# INLINE bench_elem_indices #-} + +bench_find_index_first :: S.ByteString -> Maybe Int +bench_find_index_first = S.findIndex (== 0xa) +{-# INLINE bench_find_index_first #-} + +bench_elem_index_first :: S.ByteString -> Maybe Int +bench_elem_index_first = S.elemIndex 0xa +{-# INLINE bench_elem_index_first #-} + +bench_find_indices_first :: S.ByteString -> Maybe Int +bench_find_indices_first = safeHead . bench_find_indices +{-# INLINE bench_find_indices_first #-} + +bench_elem_indices_first :: S.ByteString -> Maybe Int +bench_elem_indices_first = safeHead . bench_elem_indices +{-# INLINE bench_elem_indices_first #-} + + + +bench_find_index_second :: S.ByteString -> Maybe Int +bench_find_index_second bs = + let isNl = (== 0xa) + in case S.findIndex isNl bs of + Just !i -> S.findIndex isNl (S.unsafeDrop (i+1) bs) + Nothing -> Nothing +{-# INLINE bench_find_index_second #-} + +bench_elem_index_second :: S.ByteString -> Maybe Int +bench_elem_index_second bs = + let nl = 0xa + in case S.elemIndex nl bs of + Just !i -> S.elemIndex nl (S.unsafeDrop (i+1) bs) + Nothing -> Nothing +{-# INLINE bench_elem_index_second #-} + +bench_find_indices_second :: S.ByteString -> Maybe Int +bench_find_indices_second = safeHead . tail . bench_find_indices +{-# INLINE bench_find_indices_second #-} + +bench_elem_indices_second :: S.ByteString -> Maybe Int +bench_elem_indices_second = safeHead . tail . bench_elem_indices +{-# INLINE bench_elem_indices_second #-} + +nilEq :: Word8 -> Word8 -> Bool +{-# NOINLINE nilEq #-} +nilEq = eqWord8 + +bench_find_indices_inline :: S.ByteString -> [Int] +bench_find_indices_inline = S.findIndices (== 0xa) +{-# INLINE bench_find_indices_inline #-} + +bench_find_index_inline :: S.ByteString -> Maybe Int +bench_find_index_inline = S.findIndex (== 0xa) +{-# INLINE bench_find_index_inline #-} + +bench_find_indices_noinline :: S.ByteString -> [Int] +bench_find_indices_noinline = S.findIndices (nilEq 0xa) +{-# INLINE bench_find_indices_noinline #-} + +bench_find_index_noinline :: S.ByteString -> Maybe Int +bench_find_index_noinline = S.findIndex (nilEq 0xa) +{-# INLINE bench_find_index_noinline #-} \ No newline at end of file diff --git a/bench/bench-bytestring.cabal b/bench/bench-bytestring.cabal index 5637239d4..907796757 100644 --- a/bench/bench-bytestring.cabal +++ b/bench/bench-bytestring.cabal @@ -198,3 +198,22 @@ benchmark bench-builder-csv -fdicts-cheap -fspec-constr-count=6 default-language: Haskell2010 + +benchmark bench-strict-indices + hs-source-dirs: .. . + main-is: BenchIndices.hs + other-modules: Data.ByteString + Data.ByteString.Internal + Data.ByteString.Unsafe + type: exitcode-stdio-1.0 + build-depends: base >= 4.4 && < 5 + , ghc-prim + , deepseq >= 1.2 + , gauge >= 0.2.5 + -- we require bytestring due to benchmarking against + -- blaze-textual, which uses blaze-builder + ghc-options: -O2 + -fmax-simplifier-iterations=10 + -fdicts-cheap + -fspec-constr-count=6 + default-language: Haskell2010