09ec14b · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Fix performance issue in snoc, add snocLinear

09ec14bHarendra Kumar5 years ago

src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+139−24

compare with master

unifiedsplit

@@ -43,6 +43,7 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type

43 , putIndexUnsafe

44 , snocUnsafe

45 , snoc

46+ , snocLinear

47 -- * Casting

48 -- * Casting

48 , cast

49 , cast

@@ -108,6 +109,7 @@ import Control.Exception (assert)

108import Control.DeepSeq (NFData(..))

109import Control.DeepSeq (NFData(..))

109import Control.Monad (when, void)

110import Control.Monad (when, void)

110import Control.Monad.IO.Class (MonadIO(..))

111import Control.Monad.IO.Class (MonadIO(..))

112+import Data.Bits ((.&.))

111import Data.Functor.Identity (runIdentity)

113import Data.Functor.Identity (runIdentity)

112#if __GLASGOW_HASKELL__ < 808

114#if __GLASGOW_HASKELL__ < 808

113import Data.Semigroup (Semigroup(..))

115import Data.Semigroup (Semigroup(..))

@@ -331,6 +333,49 @@ putIndexUnsafe Array{..} i x =

331 assert (i >= 0 && elemPtr `plusPtr` elemSize <= aEnd) (return ())

333 assert (i >= 0 && elemPtr `plusPtr` elemSize <= aEnd) (return ())

332 liftIO $ poke elemPtr x

334 liftIO $ poke elemPtr x

333

335

336+-------------------------------------------------------------------------------

337+-- Rounding

338+-------------------------------------------------------------------------------

339+

340+-- XXX Should we use bitshifts in calculations or it gets optimized by the

341+-- compiler/processor itself?

342+--

343+-- | The page or block size used by the GHC allocator. Allocator allocates at

344+-- least a block and then allocates smaller allocations from within a block.

345+blockSize :: Int

346+blockSize = 4 * 1024

347+

348+-- | Allocations larger than 'largeObjectThreshold' are in multiples of block

349+-- size and are always pinned. The space beyond the end of a large object up to

350+-- the end of the block is unused.

351+largeObjectThreshold :: Int

352+largeObjectThreshold = (blockSize * 8) `div` 10

353+

354+-- | Round up an array larger than 'largeObjectThreshold' to use the whole

355+-- block.

356+{-# INLINE roundUpLargeArray #-}

357+roundUpLargeArray :: Int -> Int

358+roundUpLargeArray size =

359+ if size >= largeObjectThreshold

360+ then

361+ assert

362+ (blockSize /= 0 && ((blockSize .&. (blockSize - 1)) == 0))

363+ ((size + blockSize - 1) .&. negate blockSize)

364+ else size

365+

366+{-

367+roundUpToPower2 :: Int -> Int

368+roundUpToPower2 = undefined

369+-}

370+

371+-- XXX remove mkChunkSize, it is not required.

372+-- | The default chunk size by which the array creation routines increase the

373+-- size of the array when the array is grown linearly.

374+--

375+{-# INLINE arrayChunkSize #-}

376+arrayChunkSize :: Int

377+arrayChunkSize = mkChunkSize 1024

378+

334-------------------------------------------------------------------------------

379-------------------------------------------------------------------------------

335-- Snoc

380-- Snoc

336-------------------------------------------------------------------------------

381-------------------------------------------------------------------------------

@@ -357,32 +402,102 @@ snocUnsafe :: forall m a. (MonadIO m, Storable a) =>

357snocUnsafe arr@Array{..} =

402snocUnsafe arr@Array{..} =

358 snocNewEnd (aEnd `plusPtr` sizeOf (undefined :: a)) arr

403 snocNewEnd (aEnd `plusPtr` sizeOf (undefined :: a)) arr

359

404

405+reallocWith :: forall m a. (MonadIO m , Storable a) =>

406+ String

407+ -> (Int -> Int)

408+ -> Int

409+ -> Array a

410+ -> m (Array a)

411+reallocWith label allocSize reqSize arr = do

412+ let oldSize = aEnd arr `minusPtr` unsafeForeignPtrToPtr (aStart arr)

413+ newSize = allocSize oldSize

414+ safeSize = max newSize (oldSize + reqSize)

415+ rounded = roundUpLargeArray safeSize

416+ assert (newSize >= oldSize + reqSize || error badSize) (return ())

417+ assert (rounded >= safeSize) (return ())

418+ realloc rounded arr

419+

420+ where

421+

422+ badSize = concat

423+ [ label

424+ , ": new array size is less than required size "

425+ , show reqSize

426+ , ". Please check the sizing function passed."

427+ ]

428+

429+-- NOINLINE to move it out of the way and not pollute the instruction cache.

430+{-# NOINLINE snocWithRealloc #-}

431+snocWithRealloc :: forall m a. (MonadIO m, Storable a) =>

432+ (Int -> Int)

433+ -> Array a

434+ -> a

435+ -> m (Array a)

436+snocWithRealloc allocSize arr x = do

437+ let elemSize = sizeOf (undefined :: a)

438+ arr1 <- liftIO $ reallocWith "snocWith" allocSize elemSize arr

439+ snocUnsafe arr1 x

440+

441+-- | @snocWith newSize arr elem@ mutates @arr@ to append @elem@, the length of

442+-- the array increases by 1.

443+--

444+-- If there is no reserved space available in @arr@ it is reallocated to a size

445+-- in bytes determined by the @newSize oldSize@ function, where @oldSize@ is

446+-- the original size of the array in bytes.

447+--

448+-- If the new array size is more than 'largeObjectThreshold' we automatically

449+-- round it up to 'blockSize'.

450+--

451+-- Note that the returned array may be a mutated version of the original array.

452+--

453+-- /Pre-release/

454+{-# INLINE snocWith #-}

455+snocWith :: forall m a. (MonadIO m, Storable a) =>

456+ (Int -> Int)

457+ -> Array a

458+ -> a

459+ -> m (Array a)

460+snocWith allocSize arr x = liftIO $ do

461+ let newEnd = aEnd arr `plusPtr` sizeOf (undefined :: a)

462+ if newEnd <= aBound arr

463+ then snocNewEnd newEnd arr x

464+ else snocWithRealloc allocSize arr x

465+

466+-- | The array is mutated to append an additional element to it. If there

467+-- is no reserved space available in the array then it is reallocated to grow

468+-- it by 'arrayChunkSize' rounded up to 'blockSize' when the size becomes more

469+-- than 'largeObjectThreshold'.

470+--

471+-- Note that the returned array may be a mutated version of the original array.

472+--

473+-- >>> snocLinear = snocWith (+ arrayChunkSize)

474+--

475+-- Performs O(n^2) copies to grow but is thrifty on memory.

476+--

477+-- /Pre-release/

478+{-# INLINE snocLinear #-}

479+snocLinear :: forall m a. (MonadIO m, Storable a) => Array a -> a -> m (Array a)

480+snocLinear = snocWith (+ arrayChunkSize)

481+

482+-- XXX round it to next power of 2.

483+--

484+-- | The array is mutated to append an additional element to it. If there is no

485+-- reserved space available in the array then it is reallocated to double the

486+-- original size.

487+--

488+-- This is useful to reduce allocations when appending unknown number of

489+-- elements.

490+--

491+-- Note that the returned array may be a mutated version of the original array.

492+--

493+-- >>> snoc = snocWith (* 2)

494+--

495+-- Performs O(n * log n) copies to grow, but is liberal with memory allocation.

496+--

497+-- /Pre-release/

360{-# INLINE snoc #-}

498{-# INLINE snoc #-}

361snoc :: forall m a. (MonadIO m, Storable a) => Array a -> a -> m (Array a)

499snoc :: forall m a. (MonadIO m, Storable a) => Array a -> a -> m (Array a)

362−snoc arr@Array {..} x =

500+snoc = snocWith (* 2)

363− if aEnd == aBound

364− then do

365− let oldStart = unsafeForeignPtrToPtr aStart

366− size = aEnd `minusPtr` oldStart

367− newSize = size + sizeOf (undefined :: a)

368− newPtr <- liftIO $

369− Malloc.mallocForeignPtrAlignedBytes

370− newSize

371− (alignment (undefined :: a))

372− unsafeWithForeignPtrM newPtr $ \pNew -> liftIO $ do

373− memcpy (castPtr pNew) (castPtr oldStart) size

374− poke (pNew `plusPtr` size) x

375− touchForeignPtr aStart

376− return $

377− Array

378− { aStart = newPtr

379− , aEnd = pNew `plusPtr` (size + sizeOf (undefined :: a))

380− , aBound = pNew `plusPtr` newSize

381− }

382− else liftIO $ do

383− poke aEnd x

384− touchForeignPtr aStart

385− return $ arr {aEnd = aEnd `plusPtr` sizeOf (undefined :: a)}

386

501

387-------------------------------------------------------------------------------

502-------------------------------------------------------------------------------

388-- Resizing

503-- Resizing