4fdc836 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Include the size/alloc op costs in poke/roundtrip

4fdc836Harendra Kumar3 years ago

benchmark/Streamly/Benchmark/Data/Serialize.hs+49−31

compare with master

unifiedsplit

@@ -19,7 +19,6 @@ module Main (main) where

20import Control.DeepSeq (NFData(..))

21import Control.Exception (assert)

22−import Control.Monad (replicateM_)

23import GHC.Generics (Generic)

22import GHC.Generics (Generic)

24import System.Random (randomRIO)

23import System.Random (randomRIO)

25#ifndef USE_UNBOX

24#ifndef USE_UNBOX

@@ -32,7 +31,7 @@ import Streamly.Internal.Data.Unbox

32#else

31#else

33import Control.DeepSeq (force)

32import Control.DeepSeq (force)

34import Test.QuickCheck (oneof, generate)

33import Test.QuickCheck (oneof, generate)

35−import Streamly.Internal.Data.Unbox (newBytes)

34+import Streamly.Internal.Data.Unbox (newBytes, MutableByteArray)

36import Streamly.Internal.Data.Serialize

35import Streamly.Internal.Data.Serialize

37#endif

36#endif

@@ -271,22 +270,32 @@ runQC = quickCheckWith stdArgs {maxSuccess = 100} prop

271-- Helpers

270-- Helpers

272-------------------------------------------------------------------------------

271-------------------------------------------------------------------------------

273

272

273+

274+-- Parts of "f" that are dependent on val will not be optimized out.

274−{-# INLINE pokeTimes #-}

275+{-# INLINE loop #-}

276+loop :: Int -> (a -> IO b) -> a -> IO ()

277+loop count f val = go count val

278+ where

279+

280+ go n x = do

281+ if n > 0

282+ then f x >> go (n-1) x

283+ else return ()

284+

285+{-# INLINE poke #-}

275−pokeTimes :: forall a. SERIALIZE_CLASS a => a -> Int -> IO ()

286+poke :: SERIALIZE_CLASS a => a -> IO ()

276−pokeTimes val times = do

287+poke val = do

277− -- XXX Size computation should also be part of the loop measuring

278− -- serialization cost.

279 let n = getSize val

288 let n = getSize val

280 arr <- newBytes n

289 arr <- newBytes n

281− replicateM_ times $ do

282− SERIALIZE_OP 0 arr val

290+ SERIALIZE_OP 0 arr val >> return ()

283

291

284−{-# INLINE peekTimes #-}

292+{-# INLINE pokeTimes #-}

293+pokeTimes :: SERIALIZE_CLASS a => a -> Int -> IO ()

294+pokeTimes val times = loop times poke val

295+

296+{-# INLINE peek #-}

285−peekTimes :: forall a. (Eq a, SERIALIZE_CLASS a) => Int -> a -> Int -> IO ()

297+peek :: forall a. (Eq a, SERIALIZE_CLASS a) => a -> MutableByteArray -> IO ()

286−peekTimes n val times = do

298+peek val arr = do

287− arr <- newBytes n

288− _ <- SERIALIZE_OP 0 arr val

289− replicateM_ times $ do

290#ifdef USE_UNBOX

299#ifdef USE_UNBOX

291 val1

300 val1

292#else

301#else

@@ -301,26 +310,34 @@ peekTimes n val times = do

301 then error "peek: no match"

310 then error "peek: no match"

302 else return ()

311 else return ()

303

312

304−{-# INLINE roundtrip #-}

313+{-# INLINE peekTimes #-}

314+peekTimes :: (Eq a, SERIALIZE_CLASS a) => Int -> a -> Int -> IO ()

315+peekTimes n val times = do

316+ arr <- newBytes n

317+ _ <- SERIALIZE_OP 0 arr val

318+ loop times (peek val) arr

319+

320+{-# INLINE trip #-}

305−roundtrip :: forall a. (Eq a, SERIALIZE_CLASS a) => a -> Int -> IO ()

321+trip :: forall a. (Eq a, SERIALIZE_CLASS a) => a -> IO ()

306−roundtrip val times = do

322+trip val = do

307− -- XXX Size computation should also be part of the loop measuring

308− -- serialization cost.

309 let n = getSize val

323 let n = getSize val

310 arr <- newBytes n

324 arr <- newBytes n

311− replicateM_ times $ do

312− _ <- SERIALIZE_OP 0 arr val

325+ _ <- SERIALIZE_OP 0 arr val

313#ifdef USE_UNBOX

326#ifdef USE_UNBOX

314− val1

327+ val1

315#else

328#else

316− (_, val1)

329+ (_, val1)

317#endif

330#endif

318− <- DESERIALIZE_OP 0 arr

331+ <- DESERIALIZE_OP 0 arr

319− assert (val == val1) (pure ())

332+ assert (val == val1) (pure ())

320− -- So that the compiler does not optimize it out

333+ -- So that the compiler does not optimize it out

321− if (val1 /= val)

334+ if (val1 /= val)

322− then error "roundtrip: no match"

335+ then error "roundtrip: no match"

323− else return ()

336+ else return ()

337+

338+{-# INLINE roundtrip #-}

339+roundtrip :: (Eq a, SERIALIZE_CLASS a) => a -> Int -> IO ()

340+roundtrip val times = loop times trip val

324

341

325benchSink :: NFData b => String -> Int -> (Int -> IO b) -> Benchmark

342benchSink :: NFData b => String -> Int -> (Int -> IO b) -> Benchmark

326benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))

343benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))

@@ -447,7 +464,8 @@ main = do

447 -- peekTimes (Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25) value

464 -- peekTimes (Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25) value

448 -- !(tInt :: BinTree Int) <- force <$> mkBinTree 16

465 -- !(tInt :: BinTree Int) <- force <$> mkBinTree 16

449 -- print $ sizeOfOnce tInt

466 -- print $ sizeOfOnce tInt

450− print $ sizeOfOnce lInt

467+ -- print $ sizeOfOnce lInt

468+ pokeTimes tInt 1

451 -- peekTimes tInt 1

469 -- peekTimes tInt 1

452 -- roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1) value

470 -- roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1) value

453 return ()

471 return ()