Skip to content

Commit 8feb70e

Browse files
clyringBodigrim
clyring
authored and
Bodigrim
committed
Improve benchmarks for small Builders (#680)
* Improve benchmarks for small Builders * Do not measure the overhead of allocating destination chunks * Add several more benchmarks for P.cstring and P.cstringUtf8 * More benchmark fiddling * Update "since" markers for new NFData instances
1 parent f0edbfe commit 8feb70e

File tree

2 files changed

+99
-19
lines changed

2 files changed

+99
-19
lines changed

‎Data/ByteString/Builder/Internal.hs

+12
Original file line numberDiff line numberDiff line change
@@ -128,6 +128,7 @@ module Data.ByteString.Builder.Internal (
128128
) where
129129

130130
import Control.Arrow (second)
131+
import Control.DeepSeq (NFData(..))
131132

132133
import Data.Semigroup (Semigroup(..))
133134
import Data.List.NonEmpty (NonEmpty(..))
@@ -155,11 +156,22 @@ import System.IO.Unsafe (unsafeDupablePerformIO)
155156
data BufferRange = BufferRange {-# UNPACK #-} !(Ptr Word8) -- First byte of range
156157
{-# UNPACK #-} !(Ptr Word8) -- First byte /after/ range
157158

159+
-- | @since 0.12.2.0
160+
instance NFData BufferRange where
161+
rnf !_ = ()
162+
158163
-- | A 'Buffer' together with the 'BufferRange' of free bytes. The filled
159164
-- space starts at offset 0 and ends at the first free byte.
160165
data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8)
161166
{-# UNPACK #-} !BufferRange
162167

168+
-- | Like the @NFData@ instance for @StrictByteString@,
169+
-- this does not force the @ForeignPtrContents@ field
170+
-- of the underlying @ForeignPtr@.
171+
--
172+
-- @since 0.12.2.0
173+
instance NFData Buffer where
174+
rnf !_ = ()
163175

164176
-- | Combined size of the filled and free space in the buffer.
165177
{-# INLINE bufferSize #-}

‎bench/BenchAll.hs

+87-19
Original file line numberDiff line numberDiff line change
@@ -14,26 +14,29 @@ import Data.Monoid
1414
import Data.Semigroup
1515
import Data.String
1616
import Test.Tasty.Bench
17+
1718
import Prelude hiding (words)
1819
import qualified Data.List as List
1920
import Control.DeepSeq
21+
import Control.Exception
2022

2123
import qualified Data.ByteString as S
2224
import qualified Data.ByteString.Char8 as S8
2325
import qualified Data.ByteString.Lazy as L
2426
import qualified Data.ByteString.Lazy.Char8 as L8
2527

2628
import Data.ByteString.Builder
27-
import Data.ByteString.Builder.Extra (byteStringCopy,
28-
byteStringInsert,
29-
intHost)
30-
import Data.ByteString.Builder.Internal (ensureFree)
29+
import qualified Data.ByteString.Builder.Extra as Extra
30+
import qualified Data.ByteString.Builder.Internal as BI
3131
import Data.ByteString.Builder.Prim (BoundedPrim, FixedPrim,
3232
(>$<))
3333
import qualified Data.ByteString.Builder.Prim as P
3434
import qualified Data.ByteString.Builder.Prim.Internal as PI
3535

3636
import Foreign
37+
import Foreign.ForeignPtr
38+
import qualified GHC.Exts as Exts
39+
import GHC.Ptr (Ptr(..))
3740

3841
import System.Random
3942

@@ -121,15 +124,45 @@ loremIpsum = S8.unlines $ map S8.pack
121124
-- benchmark wrappers
122125
---------------------
123126

124-
{-# INLINE benchB #-}
125127
benchB :: String -> a -> (a -> Builder) -> Benchmark
126-
benchB name x b =
127-
bench (name ++" (" ++ show nRepl ++ ")") $
128-
whnf (L.length . toLazyByteString . b) x
128+
{-# INLINE benchB #-}
129+
benchB name x b = benchB' (name ++" (" ++ show nRepl ++ ")") x b
129130

130-
{-# INLINE benchB' #-}
131131
benchB' :: String -> a -> (a -> Builder) -> Benchmark
132-
benchB' name x b = bench name $ whnf (L.length . toLazyByteString . b) x
132+
{-# INLINE benchB' #-}
133+
benchB' name x mkB =
134+
env (BI.newBuffer BI.defaultChunkSize) $ \buf ->
135+
bench name $ whnfAppIO (runBuildStepOn buf . BI.runBuilder . mkB) x
136+
137+
benchB'_ :: String -> Builder -> Benchmark
138+
{-# INLINE benchB'_ #-}
139+
benchB'_ name b =
140+
env (BI.newBuffer BI.defaultChunkSize) $ \buf ->
141+
bench name $ whnfIO (runBuildStepOn buf (BI.runBuilder b))
142+
143+
-- | @runBuilderOn@ runs a @BuildStep@'s actions all on the same @Buffer@.
144+
-- It is used to avoid measuring driver allocation overhead.
145+
runBuildStepOn :: BI.Buffer -> BI.BuildStep () -> IO ()
146+
{-# NOINLINE runBuildStepOn #-}
147+
runBuildStepOn (BI.Buffer fp br@(BI.BufferRange op ope)) b = go b
148+
where
149+
!len = ope `minusPtr` op
150+
151+
go :: BI.BuildStep () -> IO ()
152+
go bs = BI.fillWithBuildStep bs doneH fullH insertChunkH br
153+
154+
doneH :: Ptr Word8 -> () -> IO ()
155+
doneH _ _ = touchForeignPtr fp
156+
-- 'touchForeignPtr' is adequate because the given BuildStep
157+
-- will always terminate. (We won't measure an infinite loop!)
158+
159+
fullH :: Ptr Word8 -> Int -> BI.BuildStep () -> IO ()
160+
fullH _ minLen nextStep
161+
| len < minLen = throwIO (ErrorCall "runBuilderOn: action expects too long of a BufferRange")
162+
| otherwise = go nextStep
163+
164+
insertChunkH :: Ptr Word8 -> S.ByteString -> BI.BuildStep () -> IO ()
165+
insertChunkH _ _ nextStep = go nextStep
133166

134167
{-# INLINE benchBInts #-}
135168
benchBInts :: String -> ([Int] -> Builder) -> Benchmark
@@ -247,18 +280,53 @@ largeTraversalInput = S.concat (replicate 10 byteStringData)
247280
smallTraversalInput :: S.ByteString
248281
smallTraversalInput = S8.pack "The quick brown fox"
249282

283+
asciiBuf, utf8Buf, halfNullBuf, allNullBuf :: Ptr Word8
284+
asciiBuf = Ptr "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"#
285+
utf8Buf = Ptr "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\xc0\x80xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"#
286+
halfNullBuf = Ptr "\xc0\x80xx\xc0\x80x\xc0\x80\xc0\x80x\xc0\x80\xc0\x80xx\xc0\x80\xc0\x80xxx\xc0\x80x\xc0\x80x\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80xxx\xc0\x80x\xc0\x80xx\xc0\x80\xc0\x80xxxxxxxxxx\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80x\xc0\x80\xc0\x80x\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80xxx"#
287+
allNullBuf = Ptr "\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80"#
288+
289+
asciiLit, utf8Lit :: Ptr Word8 -> Builder
290+
asciiLit (Ptr p#) = P.cstring p#
291+
utf8Lit (Ptr p#) = P.cstringUtf8 p#
292+
293+
asciiStr, utf8Str :: String
294+
asciiStr = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
295+
utf8Str = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\0xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
296+
250297
main :: IO ()
251298
main = do
252299
defaultMain
253300
[ bgroup "Data.ByteString.Builder"
254301
[ bgroup "Small payload"
255-
[ benchB' "mempty" () (const mempty)
256-
, benchB' "ensureFree 8" () (const (ensureFree 8))
257-
, benchB' "intHost 1" 1 intHost
258-
, benchB' "UTF-8 String (naive)" "hello world\0" fromString
259-
, benchB' "UTF-8 String" () $ \() -> P.cstringUtf8 "hello world\0"#
260-
, benchB' "String (naive)" "hello world!" fromString
261-
, benchB' "String" () $ \() -> P.cstring "hello world!"#
302+
[ benchB'_ "mempty" mempty
303+
, bench "toLazyByteString mempty" $ nf toLazyByteString mempty
304+
, benchB'_ "empty (10000 times)" $
305+
stimes (10000 :: Int) (Exts.lazy BI.empty)
306+
, benchB'_ "ensureFree 8" (BI.ensureFree 8)
307+
, benchB' "intHost 1" 1 Extra.intHost
308+
, benchB' "UTF-8 String (12B, naive)" "hello world\0" fromString
309+
, benchB'_ "UTF-8 String (12B)" $ utf8Lit (Ptr "hello world\xc0\x80"#)
310+
, benchB' "UTF-8 String (64B, naive)" utf8Str fromString
311+
, benchB'_ "UTF-8 String (64B, one null)" $ utf8Lit utf8Buf
312+
, benchB'
313+
"UTF-8 String (64B, one null, no shared work)"
314+
utf8Buf
315+
utf8Lit
316+
, benchB'_ "UTF-8 String (64B, half nulls)" $ utf8Lit halfNullBuf
317+
, benchB'_ "UTF-8 String (64B, all nulls)" $ utf8Lit allNullBuf
318+
, benchB'
319+
"UTF-8 String (64B, all nulls, no shared work)"
320+
allNullBuf
321+
utf8Lit
322+
, benchB'
323+
"UTF-8 String (1 byte, no shared work)"
324+
(Ptr "\xc0\x80"#)
325+
utf8Lit
326+
, benchB' "ASCII String (12B, naive)" "hello world!" fromString
327+
, benchB'_ "ASCII String (12B)" $ asciiLit (Ptr "hello wurld!"#)
328+
, benchB' "ASCII String (64B, naive)" asciiStr fromString
329+
, benchB'_ "ASCII String (64B)" $ asciiLit asciiBuf
262330
]
263331

264332
, bgroup "Encoding wrappers"
@@ -275,11 +343,11 @@ main = do
275343
]
276344
, bgroup "ByteString insertion" $
277345
[ benchB "foldMap byteStringInsert" byteStringChunksData
278-
(foldMap byteStringInsert)
346+
(foldMap Extra.byteStringInsert)
279347
, benchB "foldMap byteString" byteStringChunksData
280348
(foldMap byteString)
281349
, benchB "foldMap byteStringCopy" byteStringChunksData
282-
(foldMap byteStringCopy)
350+
(foldMap Extra.byteStringCopy)
283351
]
284352

285353
, bgroup "Non-bounded encodings"

0 commit comments

Comments
 (0)