@@ -19,7 +19,6 @@ module Main (main) where
1919
2020import Control.DeepSeq (NFData(..))
2121import Control.Exception (assert)
22−import Control.Monad (replicateM_)
2322import GHC.Generics (Generic)
2423import System.Random (randomRIO)
2524#ifndef USE_UNBOX
@@ -32,7 +31,7 @@ import Streamly.Internal.Data.Unbox
3231#else
3332import Control.DeepSeq (force)
3433import Test.QuickCheck (oneof, generate)
35−import Streamly.Internal.Data.Unbox (newBytes)
34+import Streamly.Internal.Data.Unbox (newBytes, MutableByteArray)
3635import Streamly.Internal.Data.Serialize
3736#endif
3837
@@ -271,22 +270,32 @@ runQC = quickCheckWith stdArgs {maxSuccess = 100} prop
271270-- Helpers
272271-------------------------------------------------------------------------------
273272
274−{-# INLINE pokeTimes #-}
275−pokeTimes :: forall a. SERIALIZE_CLASS a => a -> Int -> IO ()
276−pokeTimes val times = do
277− -- XXX Size computation should also be part of the loop measuring
278− -- serialization cost.
273+
274+-- Parts of "f" that are dependent on val will not be optimized out.
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 #-}
286+poke :: SERIALIZE_CLASS a => a -> IO ()
287+poke val = do
279288 let n = getSize val
280289 arr <- newBytes n
281− replicateM_ times $ do
282− SERIALIZE_OP 0 arr val
290+ SERIALIZE_OP 0 arr val >> return ()
283291
284−{-# INLINE peekTimes #-}
285−peekTimes :: forall a. (Eq a, SERIALIZE_CLASS a) => Int -> a -> Int -> IO ()
286−peekTimes n val times = do
287− arr <- newBytes n
288− _ <- SERIALIZE_OP 0 arr val
289− replicateM_ times $ do
292+{-# INLINE pokeTimes #-}
293+pokeTimes :: SERIALIZE_CLASS a => a -> Int -> IO ()
294+pokeTimes val times = loop times poke val
295+
296+{-# INLINE peek #-}
297+peek :: forall a. (Eq a, SERIALIZE_CLASS a) => a -> MutableByteArray -> IO ()
298+peek val arr = do
290299#ifdef USE_UNBOX
291300 val1
292301#else
@@ -301,26 +310,34 @@ peekTimes n val times = do
301310 then error "peek: no match"
302311 else return ()
303312
304−{-# INLINE roundtrip #-}
305−roundtrip :: forall a. (Eq a, SERIALIZE_CLASS a) => a -> Int -> IO ()
306−roundtrip val times = do
307− -- XXX Size computation should also be part of the loop measuring
308− -- serialization cost.
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 #-}
321+trip :: forall a. (Eq a, SERIALIZE_CLASS a) => a -> IO ()
322+trip val = do
309323 let n = getSize val
310324 arr <- newBytes n
311− replicateM_ times $ do
312− _ <- SERIALIZE_OP 0 arr val
325+ _ <- SERIALIZE_OP 0 arr val
313326#ifdef USE_UNBOX
314− val1
327+ val1
315328#else
316− (_, val1)
329+ (_, val1)
317330#endif
318− <- DESERIALIZE_OP 0 arr
319− assert (val == val1) (pure ())
320− -- So that the compiler does not optimize it out
321− if (val1 /= val)
322− then error "roundtrip: no match"
323− else return ()
331+ <- DESERIALIZE_OP 0 arr
332+ assert (val == val1) (pure ())
333+ -- So that the compiler does not optimize it out
334+ if (val1 /= val)
335+ then error "roundtrip: no match"
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
324341
325342benchSink :: NFData b => String -> Int -> (Int -> IO b) -> Benchmark
326343benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))
@@ -447,7 +464,8 @@ main = do
447464 -- 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
448465 -- !(tInt :: BinTree Int) <- force <$> mkBinTree 16
449466 -- print $ sizeOfOnce tInt
450− print $ sizeOfOnce lInt
467+ -- print $ sizeOfOnce lInt
468+ pokeTimes tInt 1
451469 -- peekTimes tInt 1
452470 -- roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1) value
453471 return ()