Skip to content

Commit 3541e40

Browse files
hasufellhasufell
committed
Add benchmarks
1 parent d06d98f commit 3541e40

File tree

6 files changed

+377
-0
lines changed

6 files changed

+377
-0
lines changed

‎bench/Bench.hs

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
module Main (main) where
2+
3+
import Test.Tasty.Bench
4+
import qualified BenchOsString
5+
import qualified BenchPosixString
6+
import qualified BenchWindowsString
7+
8+
9+
main :: IO ()
10+
main = do
11+
defaultMain [ BenchOsString.benchMark
12+
, BenchPosixString.benchMark
13+
, BenchWindowsString.benchMark
14+
]
15+

‎bench/BenchOsString.hs

Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE BangPatterns #-}
3+
{-# LANGUAGE PackageImports #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE MagicHash #-}
6+
{-# LANGUAGE OverloadedStrings #-}
7+
{-# LANGUAGE QuasiQuotes #-}
8+
{-# LANGUAGE TypeApplications #-}
9+
10+
#define OSSTR osstr
11+
#define OS_STRING OsString
12+
#define OS_CHAR OsChar
13+
14+
15+
module BenchOsString (benchMark) where
16+
17+
import System.OsString (osstr)
18+
import qualified System.OsString as S
19+
import System.OsString.Internal.Types (OsString(..), OsChar(..), PosixChar(..), WindowsChar(..))
20+
21+
#include "Common.hs"
22+
23+
benchStr :: String
24+
benchStr = "OsString"
25+
26+
w :: Int -> OsChar
27+
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
28+
w i = OsChar (WindowsChar (fromIntegral i))
29+
#else
30+
w i = OsChar (PosixChar (fromIntegral i))
31+
#endif
32+
33+
hashWord8 :: OsChar -> OsChar
34+
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
35+
hashWord8 (OsChar (WindowsChar w)) = OsChar . WindowsChar . fromIntegral . hashInt . fromIntegral $ w
36+
#else
37+
hashWord8 (OsChar (PosixChar w)) = OsChar . PosixChar . fromIntegral . hashInt . fromIntegral $ w
38+
#endif
39+
40+
iw :: OsChar -> Int
41+
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
42+
iw (OsChar (WindowsChar w)) = fromIntegral w
43+
#else
44+
iw (OsChar (PosixChar w)) = fromIntegral w
45+
#endif
46+

‎bench/BenchPosixString.hs

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE BangPatterns #-}
3+
{-# LANGUAGE PackageImports #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE MagicHash #-}
6+
{-# LANGUAGE OverloadedStrings #-}
7+
{-# LANGUAGE QuasiQuotes #-}
8+
{-# LANGUAGE TypeApplications #-}
9+
10+
#define OSSTR pstr
11+
#define OS_STRING PosixString
12+
#define OS_CHAR PosixChar
13+
14+
15+
module BenchPosixString (benchMark) where
16+
17+
import System.OsString.Posix (PosixString, pstr)
18+
import qualified System.OsString.Posix as S
19+
import System.OsString.Internal.Types (PosixChar(..))
20+
21+
#include "Common.hs"
22+
23+
benchStr :: String
24+
benchStr = "PosixString"
25+
26+
w :: Int -> PosixChar
27+
w i = PosixChar (fromIntegral i)
28+
29+
hashWord8 :: PosixChar -> PosixChar
30+
hashWord8 (PosixChar w) = PosixChar . fromIntegral . hashInt . fromIntegral $ w
31+
32+
iw :: PosixChar -> Int
33+
iw (PosixChar w) = fromIntegral w
34+

‎bench/BenchWindowsString.hs

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE BangPatterns #-}
3+
{-# LANGUAGE PackageImports #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE MagicHash #-}
6+
{-# LANGUAGE OverloadedStrings #-}
7+
{-# LANGUAGE QuasiQuotes #-}
8+
{-# LANGUAGE TypeApplications #-}
9+
10+
#define OSSTR pstr
11+
#define OS_STRING WindowsString
12+
#define OS_CHAR WindowsChar
13+
14+
15+
module BenchWindowsString (benchMark) where
16+
17+
import System.OsString.Windows (WindowsString, WindowsChar, pstr)
18+
import qualified System.OsString.Windows as S
19+
import System.OsString.Internal.Types (WindowsChar(..))
20+
21+
#include "Common.hs"
22+
23+
benchStr :: String
24+
benchStr = "WindowsString"
25+
26+
w :: Int -> WindowsChar
27+
w i = WindowsChar (fromIntegral i)
28+
29+
hashWord8 :: WindowsChar -> WindowsChar
30+
hashWord8 (WindowsChar w) = WindowsChar . fromIntegral . hashInt . fromIntegral $ w
31+
32+
iw :: WindowsChar -> Int
33+
iw (WindowsChar w) = fromIntegral w
34+

‎bench/Common.hs

Lines changed: 230 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,230 @@
1+
import Control.DeepSeq (force)
2+
import Data.Foldable (foldMap)
3+
import Data.Maybe (listToMaybe, fromJust)
4+
import Data.Monoid
5+
import Data.String
6+
import Prelude hiding (words, head, tail)
7+
8+
import Test.Tasty.Bench
9+
import Data.ByteString.Builder
10+
import Data.ByteString.Builder.Extra (byteStringCopy, byteStringInsert, intHost)
11+
import Data.ByteString.Builder.Internal (ensureFree)
12+
import Data.ByteString.Builder.Prim (BoundedPrim, FixedPrim, (>$<))
13+
import qualified Data.ByteString.Builder.Prim as P
14+
import qualified Data.ByteString.Builder.Prim.Internal as PI
15+
16+
import Foreign
17+
18+
import System.Random
19+
import Data.Bifunctor (first)
20+
21+
------------------------------------------------------------------------------
22+
-- Benchmark
23+
------------------------------------------------------------------------------
24+
25+
-- input data (NOINLINE to ensure memoization)
26+
----------------------------------------------
27+
28+
-- | Few-enough repetitions to avoid making GC too expensive.
29+
nRepl :: Int
30+
nRepl = 10000
31+
32+
{-# NOINLINE intData #-}
33+
intData :: [Int]
34+
intData = [1..nRepl]
35+
36+
{-# NOINLINE byteStringData #-}
37+
byteStringData :: S.OS_STRING
38+
byteStringData = S.pack $ map w intData
39+
40+
{-# NOINLINE loremIpsum #-}
41+
loremIpsum :: S.OS_STRING
42+
loremIpsum = [OSSTR|incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis
43+
nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.
44+
Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu
45+
fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in
46+
culpa qui officia deserunt mollit anim id est laborum.|]
47+
48+
-- benchmark wrappers
49+
---------------------
50+
51+
{-# INLINE benchB' #-}
52+
benchB'
53+
:: String -> a -> (a -> OS_STRING) -> Benchmark
54+
benchB' name x b = bench name $ whnf (S.length . b) x
55+
56+
57+
-- We use this construction of just looping through @n,n-1,..,1@ to ensure that
58+
-- we measure the speed of the encoding and not the speed of generating the
59+
-- values to be encoded.
60+
{-# INLINE benchIntEncodingB #-}
61+
benchIntEncodingB :: Int -- ^ Maximal 'Int' to write
62+
-> BoundedPrim Int -- ^ 'BoundedPrim' to execute
63+
-> IO () -- ^ 'IO' action to benchmark
64+
benchIntEncodingB n0 w
65+
| n0 <= 0 = return ()
66+
| otherwise = do
67+
fpbuf <- mallocForeignPtrBytes (n0 * PI.sizeBound w)
68+
withForeignPtr fpbuf (loop n0) >> return ()
69+
where
70+
loop !n !op
71+
| n <= 0 = return op
72+
| otherwise = PI.runB w n op >>= loop (n - 1)
73+
74+
75+
-- Helpers
76+
-------------
77+
78+
hashInt :: Int -> Int
79+
hashInt x = iterate step x !! 10
80+
where
81+
step a = e
82+
where b = (a `xor` 61) `xor` (a `shiftR` 16)
83+
c = b + (b `shiftL` 3)
84+
d = c `xor` (c `shiftR` 4)
85+
e = d * 0x27d4eb2d
86+
f = e `xor` (e `shiftR` 15)
87+
88+
89+
foldInputs'
90+
:: [[ OS_CHAR ]]
91+
foldInputs' = force (S.unpack <$> foldInputs)
92+
93+
foldInputs :: [S.OS_STRING]
94+
foldInputs = map (\k -> S.pack . map w $ if k <= 6 then take (2 ^ k) [32..95] else concat (replicate (2 ^ (k - 6)) [32..95])) [0..16]
95+
96+
largeTraversalInput :: S.OS_STRING
97+
largeTraversalInput = S.concat (replicate 10 byteStringData)
98+
99+
smallTraversalInput :: S.OS_STRING
100+
smallTraversalInput = [OSSTR|The quick brown fox|]
101+
102+
zeroes :: S.OS_STRING
103+
zeroes = S.replicate 10000 (w 0)
104+
105+
partitionStrict p = nf (S.partition p) . randomStrict $ mkStdGen 98423098
106+
where randomStrict = fst . S.unfoldrN 10000 (Just . first S.unsafeFromChar . random)
107+
108+
-- ASCII \n to ensure no typos
109+
nl :: OS_CHAR
110+
nl = w 0xa
111+
{-# INLINE nl #-}
112+
113+
-- non-inlined equality test
114+
nilEq :: OS_CHAR -> OS_CHAR -> Bool
115+
{-# NOINLINE nilEq #-}
116+
nilEq = (==)
117+
118+
-- lines of 200 letters from a to e, followed by repeated letter f
119+
absurdlong :: S.OS_STRING
120+
absurdlong = (S.replicate 200 (w 0x61) <> S.singleton nl
121+
<> S.replicate 200 (w 0x62) <> S.singleton nl
122+
<> S.replicate 200 (w 0x63) <> S.singleton nl
123+
<> S.replicate 200 (w 0x64) <> S.singleton nl
124+
<> S.replicate 200 (w 0x65) <> S.singleton nl)
125+
<> S.replicate 999999 (w 0x66)
126+
127+
bench_find_index_second :: OS_STRING -> Maybe Int
128+
bench_find_index_second bs =
129+
let isNl = (== nl)
130+
in case S.findIndex isNl bs of
131+
Just !i -> S.findIndex isNl (S.drop (i+1) bs)
132+
Nothing -> Nothing
133+
{-# INLINE bench_find_index_second #-}
134+
135+
bench_elem_index_second :: OS_STRING -> Maybe Int
136+
bench_elem_index_second bs =
137+
case S.elemIndex nl bs of
138+
Just !i -> S.elemIndex nl (S.drop (i+1) bs)
139+
Nothing -> Nothing
140+
{-# INLINE bench_elem_index_second #-}
141+
142+
143+
144+
-- benchmarks
145+
-------------
146+
147+
benchMark :: Benchmark
148+
benchMark = absurdlong `seq` bgroup benchStr
149+
[ bgroup "Small payload"
150+
[ benchB' "mempty" () (const mempty)
151+
, benchB' "UTF-8 String (naive)" "hello world\0" (fromJust . S.encodeUtf)
152+
, benchB' "String (naive)" "hello world!" (fromJust . S.encodeUtf)
153+
]
154+
, bgroup "intercalate"
155+
[ bench "intercalate (large)" $ whnf (S.intercalate $ [OSSTR| and also |]) (replicate 300 [OSSTR|expression|])
156+
, bench "intercalate (small)" $ whnf (S.intercalate [OSSTR|&|]) (replicate 30 [OSSTR|foo|])
157+
, bench "intercalate (tiny)" $ whnf (S.intercalate [OSSTR|&|]) [[OSSTR|foo|], [OSSTR|bar|], [OSSTR|baz|]]
158+
]
159+
, bgroup "partition"
160+
[
161+
bgroup "strict"
162+
[
163+
bench "mostlyTrueFast" $ partitionStrict (< (w 225))
164+
, bench "mostlyFalseFast" $ partitionStrict (< (w 10))
165+
, bench "balancedFast" $ partitionStrict (< (w 128))
166+
167+
, bench "mostlyTrueSlow" $ partitionStrict (\x -> hashWord8 x < w 225)
168+
, bench "mostlyFalseSlow" $ partitionStrict (\x -> hashWord8 x < w 10)
169+
, bench "balancedSlow" $ partitionStrict (\x -> hashWord8 x < w 128)
170+
]
171+
]
172+
, bgroup "folds"
173+
[ bgroup "strict"
174+
[ bgroup "foldl" $ map (\s -> bench (show $ S.length s) $
175+
nf (S.foldl (\acc x -> acc + iw x) (0 :: Int)) s) foldInputs
176+
, bgroup "foldl'" $ map (\s -> bench (show $ S.length s) $
177+
nf (S.foldl' (\acc x -> acc + iw x) (0 :: Int)) s) foldInputs
178+
, bgroup "foldr" $ map (\s -> bench (show $ S.length s) $
179+
nf (S.foldr (\x acc -> iw x + acc) (0 :: Int)) s) foldInputs
180+
, bgroup "foldr'" $ map (\s -> bench (show $ S.length s) $
181+
nf (S.foldr' (\x acc -> iw x + acc) (0 :: Int)) s) foldInputs
182+
, bgroup "foldr1'" $ map (\s -> bench (show $ S.length s) $
183+
nf (S.foldr1' (\x acc -> w $ iw x + iw acc)) s) foldInputs
184+
, bgroup "unfoldrN" $ map (\s -> bench (show $ S.length s) $
185+
nf (S.unfoldrN (S.length s) (\a -> Just (w a, a + 1))) 0) foldInputs
186+
, bgroup "filter" $ map (\s -> bench (show $ S.length s) $
187+
nf (S.filter (odd . iw)) s) foldInputs
188+
]
189+
]
190+
, bgroup "findIndexOrLength"
191+
[ bench "takeWhile" $ nf (S.takeWhile (even . iw)) zeroes
192+
, bench "dropWhile" $ nf (S.dropWhile (even . iw)) zeroes
193+
, bench "break" $ nf (S.break (odd . iw)) zeroes
194+
]
195+
, bgroup "findIndex_"
196+
[ bench "findIndices" $ nf (sum . S.findIndices (\x -> x == w 129 || x == w 72)) byteStringData
197+
, bench "find" $ nf (S.find (>= w 198)) byteStringData
198+
]
199+
, bgroup "traversals"
200+
[ bench "map (+1) large" $ nf (S.map (w . (+ 1) . iw)) largeTraversalInput
201+
, bench "map (+1) small" $ nf (S.map (w . (+ 1) . iw)) smallTraversalInput
202+
]
203+
, bgroup (benchStr <> " strict first index") $
204+
[ bench "FindIndices" $ nf (listToMaybe . S.findIndices (== nl)) absurdlong
205+
, bench "ElemIndices" $ nf (listToMaybe . S.elemIndices nl) absurdlong
206+
, bench "FindIndex" $ nf (S.findIndex (== nl)) absurdlong
207+
, bench "ElemIndex" $ nf (S.elemIndex nl) absurdlong
208+
]
209+
, bgroup (benchStr <> " strict second index") $
210+
[ bench "FindIndices" $ nf (listToMaybe . drop 1 . S.findIndices (== nl)) absurdlong
211+
, bench "ElemIndices" $ nf (listToMaybe . drop 1 . S.elemIndices nl) absurdlong
212+
, bench "FindIndex" $ nf bench_find_index_second absurdlong
213+
, bench "ElemIndex" $ nf bench_elem_index_second absurdlong
214+
]
215+
, bgroup (benchStr <> " index equality inlining") $
216+
[ bench "FindIndices/inlined" $ nf (S.findIndices (== nl)) absurdlong
217+
, bench "FindIndices/non-inlined" $ nf (S.findIndices (nilEq nl)) absurdlong
218+
, bench "FindIndex/inlined" $ nf (S.findIndex (== nl)) absurdlong
219+
, bench "FindIndex/non-inlined" $ nf (S.findIndex (nilEq nl)) absurdlong
220+
]
221+
, bgroup (benchStr <> " conversions") $
222+
[ bgroup "unpack" $ map (\s -> bench (show $ S.length s) $
223+
nf (\x -> S.unpack x) s) foldInputs
224+
, bgroup "pack" $ map (\s -> bench (show $ length s) $
225+
nf S.pack s) foldInputs'
226+
, bench "unpack and get last element" $ nf (\x -> last . S.unpack $ x) absurdlong
227+
, bench "unpack and get first 120 elements" $ nf (\x -> take 120 . S.unpack $ x) absurdlong
228+
]
229+
]
230+

‎os-string.cabal

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ description:
3131
extra-source-files:
3232
System/OsString/Common.hs
3333
tests/bytestring-tests/Properties/Common.hs
34+
bench/Common.hs
3435

3536
extra-doc-files:
3637
changelog.md
@@ -90,3 +91,20 @@ test-suite bytestring-tests
9091
, os-string
9192
, QuickCheck >=2.7 && <2.15
9293

94+
benchmark bench
95+
main-is: Bench.hs
96+
other-modules: BenchOsString
97+
BenchPosixString
98+
BenchWindowsString
99+
type: exitcode-stdio-1.0
100+
hs-source-dirs: bench
101+
default-language: Haskell2010
102+
ghc-options: -O2 "-with-rtsopts=-A32m"
103+
if impl(ghc >= 8.6)
104+
ghc-options: -fproc-alignment=64
105+
build-depends: base,
106+
bytestring,
107+
os-string,
108+
deepseq,
109+
tasty-bench,
110+
random

0 commit comments

Comments
 (0)