4dbdf47 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Remove the alloc cost from poke op

4dbdf47Harendra Kumar3 years ago

benchmark/Streamly/Benchmark/Data/Serialize.hs+71−32

compare with master

unifiedsplit

@@ -270,7 +270,6 @@ runQC = quickCheckWith stdArgs {maxSuccess = 100} prop

270-- Helpers

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

272

273−

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

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

275{-# INLINE loop #-}

274{-# INLINE loop #-}

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

275loop :: Int -> (a -> IO b) -> a -> IO ()

@@ -282,16 +281,41 @@ loop count f val = go count val

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

281 then f x >> go (n-1) x

283 else return ()

282 else return ()

284

283

284+-- The first arg of "f" is the environment which is not threaded around in the

285+-- loop.

285−{-# INLINE poke #-}

286+{-# INLINE loopWith #-}

287+loopWith :: Int -> (env -> a -> IO b) -> env -> a -> IO ()

288+loopWith count f e val = go count val

289+ where

290+

291+ go n x = do

292+ if n > 0

293+ then f e x >> go (n-1) x

294+ else return ()

295+

296+{-# INLINE pokeWithSize #-}

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

297+pokeWithSize :: SERIALIZE_CLASS a => MutableByteArray -> a -> IO ()

287−poke val = do

298+pokeWithSize arr val = do

299+ let n = getSize val

300+ n `seq` SERIALIZE_OP 0 arr val >> return ()

301+

302+{-# INLINE pokeTimesWithSize #-}

303+pokeTimesWithSize :: SERIALIZE_CLASS a => a -> Int -> IO ()

304+pokeTimesWithSize val times = do

288 let n = getSize val

305 let n = getSize val

289 arr <- newBytes n

306 arr <- newBytes n

307+ loopWith times pokeWithSize arr val

308+

309+{-# INLINE poke #-}

310+poke :: SERIALIZE_CLASS a => MutableByteArray -> a -> IO ()

290− SERIALIZE_OP 0 arr val >> return ()

311+poke arr val = SERIALIZE_OP 0 arr val >> return ()

291

312

292{-# INLINE pokeTimes #-}

313{-# INLINE pokeTimes #-}

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

314pokeTimes :: SERIALIZE_CLASS a => a -> Int -> IO ()

294−pokeTimes val times = loop times poke val

315+pokeTimes val times = do

316+ let n = getSize val

317+ arr <- newBytes n

318+ loopWith times poke arr val

295

319

296{-# INLINE peek #-}

320{-# INLINE peek #-}

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

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

@@ -299,23 +323,26 @@ peek val arr = do

299#ifdef USE_UNBOX

323#ifdef USE_UNBOX

300 val1

324 val1

301#else

325#else

302− (_, val1)

326+ (_, val1 :: a)

303#endif

327#endif

304 <- DESERIALIZE_OP 0 arr

328 <- DESERIALIZE_OP 0 arr

305 -- Ensure that we are actually constructing the type and using it.

329 -- Ensure that we are actually constructing the type and using it.

306 -- Otherwise we may just read the values and discard them.

330 -- Otherwise we may just read the values and discard them.

307 -- The comparison adds to the cost though.

331 -- The comparison adds to the cost though.

308 --

332 --

333+ {-

309 if (val1 /= val)

334 if (val1 /= val)

310 then error "peek: no match"

335 then error "peek: no match"

311 else return ()

336 else return ()

337+ -}

338+ return ()

312

339

313{-# INLINE peekTimes #-}

340{-# INLINE peekTimes #-}

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

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

315peekTimes n val times = do

342peekTimes n val times = do

316 arr <- newBytes n

343 arr <- newBytes n

317 _ <- SERIALIZE_OP 0 arr val

344 _ <- SERIALIZE_OP 0 arr val

318− loop times (peek val) arr

345+ loopWith times peek val arr

319

346

320{-# INLINE trip #-}

347{-# INLINE trip #-}

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

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

@@ -331,9 +358,12 @@ trip val = do

331 <- DESERIALIZE_OP 0 arr

358 <- DESERIALIZE_OP 0 arr

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

359 assert (val == val1) (pure ())

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

360 -- So that the compiler does not optimize it out

361+ {-

334 if (val1 /= val)

362 if (val1 /= val)

335 then error "roundtrip: no match"

363 then error "roundtrip: no match"

336 else return ()

364 else return ()

365+ -}

366+ return ()

337

367

338{-# INLINE roundtrip #-}

368{-# INLINE roundtrip #-}

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

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

@@ -346,6 +376,31 @@ benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))

346-- Benchmarks

376-- Benchmarks

347-------------------------------------------------------------------------------

377-------------------------------------------------------------------------------

348

378

379+{-# INLINE benchPoke #-}

380+benchPoke :: String -> (forall a. SERIALIZE_CLASS a =>

381+ a -> Int -> IO ()) -> BinTree Int -> [Int] -> Int -> Benchmark

382+benchPoke gname f tInt lInt times =

383+ bgroup gname

384+ [ benchSink "C1" times

385+ (f CDT1C1)

386+ , benchSink "C2" (times `div` 2)

387+ (f (CDT1C2 5))

388+ , benchSink "C3" (times `div` 3)

389+ (f (CDT1C3 5 2))

390+ , benchSink "Sum2" times

391+ (f Sum21)

392+ , benchSink "Sum25" times

393+ (f Sum2525)

394+ , benchSink "Product25" (times `div` 26)

395+ (f (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))

396+#ifndef USE_UNBOX

397+ , benchSink "bintree-int" 1

398+ (f tInt)

399+ , benchSink "list-int" 1

400+ (f lInt)

401+#endif

402+ ]

403+

349-- Times is scaled by the number of constructors to normalize

404-- Times is scaled by the number of constructors to normalize

350#ifdef USE_UNBOX

405#ifdef USE_UNBOX

351allBenchmarks :: Int -> [Benchmark]

406allBenchmarks :: Int -> [Benchmark]

@@ -361,26 +416,8 @@ allBenchmarks tInt lInt times =

361 , bench "list-int" $ nf sizeOfOnce lInt

416 , bench "list-int" $ nf sizeOfOnce lInt

362#endif

417#endif

363 ]

418 ]

364− , bgroup "poke"

419+ , benchPoke "poke" pokeTimes tInt lInt times

365− [ benchSink "C1" times

420+ , benchPoke "pokeWithSize" pokeTimesWithSize tInt lInt times

366− (pokeTimes CDT1C1)

367− , benchSink "C2" (times `div` 2)

368− (pokeTimes (CDT1C2 5))

369− , benchSink "C3" (times `div` 3)

370− (pokeTimes (CDT1C3 5 2))

371− , benchSink "Sum2" times

372− (pokeTimes Sum21)

373− , benchSink "Sum25" times

374− (pokeTimes Sum2525)

375− , benchSink "Product25" (times `div` 26)

376− (pokeTimes (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))

377−#ifndef USE_UNBOX

378− , benchSink "bintree-int" 1

379− (pokeTimes tInt)

380− , benchSink "list-int" 1

381− (pokeTimes lInt)

382−#endif

383− ]

384 , bgroup "peek"

421 , bgroup "peek"

385 [ let !n = getSize Unit

422 [ let !n = getSize Unit

386 in benchSink "Unit" times (peekTimes n Unit)

423 in benchSink "Unit" times (peekTimes n Unit)

@@ -459,14 +496,16 @@ main = do

459 -- Check the .dump-simpl output

496 -- Check the .dump-simpl output

460 let value = 100000

497 let value = 100000

461 -- print $ getSize (CDT1C3 4 2)

498 -- print $ getSize (CDT1C3 4 2)

499+ -- print $ sizeOfOnce tInt

500+ -- print $ sizeOfOnce lInt

501+

502+ -- pokeTimes tInt 1

503+

462 -- peekTimes ((CDT1C2 (5 :: Int)) :: CustomDT1) value

504 -- peekTimes ((CDT1C2 (5 :: Int)) :: CustomDT1) value

463 -- peekTimes (Sum2525) value

505 -- peekTimes (Sum2525) 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

506 -- 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

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

466− -- print $ sizeOfOnce tInt

467− -- print $ sizeOfOnce lInt

468− pokeTimes tInt 1

469 -- peekTimes tInt 1

507 -- peekTimes tInt 1

508+

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

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

471 return ()

510 return ()

472#endif

511#endif