ba01fcd · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Rename and move unboxed array APIs

ba01fcdAdithya Kumar4 years ago

core/src/Streamly/Data/Array/Unboxed/Mut.hs+2−1

compare with master

unifiedsplit

@@ -19,7 +19,8 @@ module Streamly.Data.Array.Unboxed.Mut

19 -- ** Construction

21 -- Uninitialized Arrays

22− , newArray

22+ , new

23+ , newPinned

24 -- From containers

25 -- From containers

25 , fromListN

26 , fromListN

core/src/Streamly/Internal/Data/Array/Unboxed.hs+1−1

@@ -284,7 +284,7 @@ writeLastN n

284 in fmap f $ liftIO $ RB.new n

285

286 done (Tuple3Fused' rb rh i) = do

287− arr <- liftIO $ MA.newArray n

287+ arr <- liftIO $ MA.newPinned n

288 foldFunc i rh snoc' arr rb

289

290 -- XXX We should write a read unfold for ring.

core/src/Streamly/Internal/Data/Array/Unboxed/Mut/Type.hs+65−68

@@ -18,7 +18,6 @@ module Streamly.Internal.Data.Array.Unboxed.Mut.Type

18 -- $arrayNotes

19 Array (..)

20 , MutableByteArray

21− , nilArrayContents

22 , touch

21 , touch

23 , pin

22 , pin

24 , unpin

23 , unpin

@@ -28,11 +27,11 @@ module Streamly.Internal.Data.Array.Unboxed.Mut.Type

28 , nil

27 , nil

30 -- *** Uninitialized Arrays

29 -- *** Uninitialized Arrays

31− , newArray

30+ , newPinned

32− , newPinnedArrayBytes

31+ , newPinnedBytes

33− , newArrayAligned

32+ , newAlignedPinned

33+ , new

34 , newArrayWith

35− , newAlignedArrayContents

37 -- *** Initialized Arrays

36 -- *** Initialized Arrays

38 , withNewArrayUnsafe

37 , withNewArrayUnsafe

@@ -234,9 +233,11 @@ import Streamly.Internal.Data.Unboxed

234 , touch

233 , touch

235 )

234 )

236import GHC.Base

235import GHC.Base

237− ( IO(..), byteArrayContents#

236+ ( IO(..)

238− , Int(..), newAlignedPinnedByteArray#

237+ , Int(..)

238+ , byteArrayContents#

239− , copyMutableByteArray#, compareByteArrays#

239+ , compareByteArrays#

240+ , copyMutableByteArray#

240 )

241 )

241import GHC.Base (noinline)

242import GHC.Base (noinline)

242import GHC.Exts (unsafeCoerce#)

243import GHC.Exts (unsafeCoerce#)

@@ -248,7 +249,6 @@ import Streamly.Internal.Data.Stream.Type (Stream)

248import Streamly.Internal.Data.SVar.Type (adaptState, defState)

249import Streamly.Internal.Data.SVar.Type (adaptState, defState)

249import Streamly.Internal.Data.Unfold.Type (Unfold(..))

250import Streamly.Internal.Data.Unfold.Type (Unfold(..))

250import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)

251import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)

251−import System.IO.Unsafe (unsafePerformIO)

252

253import qualified Streamly.Internal.Data.Fold.Type as FL

254import qualified Streamly.Internal.Data.Producer as Producer

@@ -385,6 +385,8 @@ unpin arr@Array{..} = do

385-- Alignment must be greater than or equal to machine word size and a power of

386-- 2.

387--

388+-- Alignment is ignored if the allocator allocates unpinned memory.

389+--

388-- /Pre-release/

390-- /Pre-release/

389{-# INLINE newArrayWith #-}

391{-# INLINE newArrayWith #-}

390newArrayWith :: forall m a. (MonadIO m, Unboxed a)

392newArrayWith :: forall m a. (MonadIO m, Unboxed a)

@@ -399,61 +401,25 @@ newArrayWith alloc alignSize count = do

399 , arrBound = size

401 , arrBound = size

400 }

402 }

401

403

402−-- XXX Move this to Unboxed and rename this to newPinnedAlignedBytes?

403−-- XXX Similarly have newUnpinnedBytes

404−{-# INLINE newAlignedArrayContents #-}

405−newAlignedArrayContents :: Int -> Int -> IO (MutableByteArray a)

406−newAlignedArrayContents nbytes _align | nbytes < 0 =

407− errorWithoutStackTrace "newAlignedArrayContents: size must be >= 0"

408−newAlignedArrayContents (I# nbytes) (I# align) = IO $ \s ->

409− case newAlignedPinnedByteArray# nbytes align s of

410− (# s', mbarr# #) ->

411− let c = MutableByteArray mbarr#

412− in (# s', c #)

413−

414−{-# NOINLINE nilArrayContents #-}

415−nilArrayContents :: MutableByteArray a

416−nilArrayContents =

417− unsafePerformIO $ newAlignedArrayContents 0 0

418−

419nil ::

404nil ::

420#ifdef DEVBUILD

405#ifdef DEVBUILD

421 Unboxed a =>

406 Unboxed a =>

422#endif

407#endif

423 Array a

408 Array a

424−nil = Array nilArrayContents 0 0 0

409+nil = Array Unboxed.nil 0 0 0

425−

426−-- | Like 'newArrayWith' but using an allocator that aligns the memory to the

427−-- alignment dictated by the 'Unboxed' instance of the type.

428−--

429−-- /Internal/

430−{-# INLINE newArrayAligned #-}

431−newArrayAligned :: (MonadIO m, Unboxed a) => Int -> Int -> m (Array a)

432−newArrayAligned = newArrayWith (\s a -> liftIO $ newAlignedArrayContents s a)

433

410

434−-- XXX Intead of newArray, make newPinnedArray and newUnpinnedArray. Make it

435−-- more explicit.

436−-- XXX can unaligned allocation be more efficient when alignment is not needed?

437−--

438−-- | Allocates an empty array that can hold 'count' items. The memory of the

439−-- array is uninitialized and the allocation is aligned as per the 'Unboxed'

440−-- instance of the type.

441−--

442−-- /Pre-release/

443−{-# INLINE newArray #-}

444−newArray :: forall m a. (MonadIO m, Unboxed a) => Int -> m (Array a)

445−newArray = newArrayAligned (alignment (undefined :: a))

446

411

447-- | Allocates a pinned empty array that can hold 'count' items. The memory of

412-- | Allocates a pinned empty array that can hold 'count' items. The memory of

448-- the array is uninitialized and the allocation is aligned as per the

413-- the array is uninitialized and the allocation is aligned as per the

449-- 'Unboxed' instance of the type.

414-- 'Unboxed' instance of the type.

450--

415--

451-- /Pre-release/

416-- /Pre-release/

452−{-# INLINE newPinnedArrayBytes #-}

417+{-# INLINE newPinnedBytes #-}

453−newPinnedArrayBytes :: forall m a. (MonadIO m, Unboxed a) => Int -> m (Array a)

418+newPinnedBytes :: forall m a. (MonadIO m, Unboxed a) => Int -> m (Array a)

454−newPinnedArrayBytes bytes = do

419+newPinnedBytes bytes = do

455 contents <-

420 contents <-

421+ liftIO

456− liftIO $ newAlignedArrayContents bytes (alignment (undefined :: a))

422+ $ Unboxed.newAlignedPinnedBytes bytes (alignment (undefined :: a))

457 return $ Array

423 return $ Array

458 { arrContents = contents

424 { arrContents = contents

459 , arrStart = 0

425 , arrStart = 0

@@ -461,6 +427,37 @@ newPinnedArrayBytes bytes = do

461 , arrBound = bytes

427 , arrBound = bytes

462 }

428 }

463

429

430+-- | Like 'newArrayWith' but using an allocator is a pinned memory allocator and

431+-- the alignment is dictated by the 'Unboxed' instance of the type.

432+--

433+-- /Internal/

434+{-# INLINE newAlignedPinned #-}

435+newAlignedPinned :: (MonadIO m, Unboxed a) => Int -> Int -> m (Array a)

436+newAlignedPinned =

437+ newArrayWith (\s a -> liftIO $ Unboxed.newAlignedPinnedBytes s a)

438+

439+-- XXX can unaligned allocation be more efficient when alignment is not needed?

440+--

441+-- | Allocates an empty pinned array that can hold 'count' items. The memory of

442+-- the array is uninitialized and the allocation is aligned as per the 'Unboxed'

443+-- instance of the type.

444+--

445+-- /Pre-release/

446+{-# INLINE newPinned #-}

447+newPinned :: forall m a. (MonadIO m, Unboxed a) => Int -> m (Array a)

448+newPinned = newAlignedPinned (alignment (undefined :: a))

449+

450+-- | Allocates an empty unpinned array that can hold 'count' items. The memory

451+-- of the array is uninitialized.

452+--

453+-- /Pre-release/

454+{-# INLINE new #-}

455+new :: (MonadIO m, Unboxed a) => Int -> m (Array a)

456+new =

457+ newArrayWith

458+ (\s _ -> liftIO $ Unboxed.newUnpinnedBytes s)

459+ (error "new: alignment is not used in unpinned arrays.")

460+

464-- | Allocate an Array of the given size and run an IO action passing the array

461-- | Allocate an Array of the given size and run an IO action passing the array

465-- start pointer.

462-- start pointer.

466--

463--

@@ -469,7 +466,7 @@ newPinnedArrayBytes bytes = do

469withNewArrayUnsafe ::

466withNewArrayUnsafe ::

470 (MonadIO m, Unboxed a) => Int -> (Ptr a -> m ()) -> m (Array a)

467 (MonadIO m, Unboxed a) => Int -> (Ptr a -> m ()) -> m (Array a)

471withNewArrayUnsafe count f = do

468withNewArrayUnsafe count f = do

472− arr <- newArray count

469+ arr <- newPinned count

473 asPtrUnsafe arr

470 asPtrUnsafe arr

474 $ \p -> f p >> return arr

471 $ \p -> f p >> return arr

475

472

@@ -719,7 +716,7 @@ reallocAligned elemSize alignSize newCapacityInBytes Array{..} = do

719

716

720 -- Allocate new array

717 -- Allocate new array

721 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes

718 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes

722− contents <- newAlignedArrayContents newCapMaxInBytes alignSize

719+ contents <- Unboxed.newAlignedPinnedBytes newCapMaxInBytes alignSize

723 let !(MutableByteArray mbarrFrom#) = arrContents

720 let !(MutableByteArray mbarrFrom#) = arrContents

724 !(MutableByteArray mbarrTo#) = contents

721 !(MutableByteArray mbarrTo#) = contents

725

722

@@ -1310,7 +1307,7 @@ arraysOf n (D.Stream step state) =

1310 error $ "Streamly.Internal.Data.Array.Unboxed.Mut.Type.arraysOf: "

1307 error $ "Streamly.Internal.Data.Array.Unboxed.Mut.Type.arraysOf: "

1311 ++ "the size of arrays [" ++ show n

1308 ++ "the size of arrays [" ++ show n

1312 ++ "] must be a natural number"

1309 ++ "] must be a natural number"

1313− Array contents start end bound <- liftIO $ newArray n

1310+ Array contents start end bound <- liftIO $ newPinned n

1314 return $ D.Skip (GroupBuffer st contents start end bound)

1311 return $ D.Skip (GroupBuffer st contents start end bound)

1315

1312

1316 step' gst (GroupBuffer st contents start end bound) = do

1313 step' gst (GroupBuffer st contents start end bound) = do

@@ -1749,13 +1746,13 @@ writeNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial

1749-- conditional in the step function blocks fusion causing 10x performance

1746-- conditional in the step function blocks fusion causing 10x performance

1750-- slowdown.

1747-- slowdown.

1751--

1748--

1752−-- >>> writeNUnsafe = Array.writeNWithUnsafe Array.newArray

1749+-- >>> writeNUnsafe = Array.writeNWithUnsafe Array.newPinned

1753--

1750--

1754-- @since 0.7.0

1751-- @since 0.7.0

1755{-# INLINE_NORMAL writeNUnsafe #-}

1752{-# INLINE_NORMAL writeNUnsafe #-}

1756writeNUnsafe :: forall m a. (MonadIO m, Unboxed a)

1753writeNUnsafe :: forall m a. (MonadIO m, Unboxed a)

1757 => Int -> Fold m a (Array a)

1754 => Int -> Fold m a (Array a)

1758−writeNUnsafe = writeNWithUnsafe newArray

1755+writeNUnsafe = writeNWithUnsafe newPinned

1759

1756

1760-- | @writeNWith alloc n@ folds a maximum of @n@ elements into an array

1757-- | @writeNWith alloc n@ folds a maximum of @n@ elements into an array

1761-- allocated using the @alloc@ function.

1758-- allocated using the @alloc@ function.

@@ -1771,14 +1768,14 @@ writeNWith alloc n = FL.take n (writeNWithUnsafe alloc n)

1771-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an

1768-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an

1772-- 'Array'.

1769-- 'Array'.

1773--

1770--

1774−-- >>> writeN = Array.writeNWith Array.newArray

1771+-- >>> writeN = Array.writeNWith Array.newPinned

1775-- >>> writeN n = Fold.take n (Array.writeNUnsafe n)

1772-- >>> writeN n = Fold.take n (Array.writeNUnsafe n)

1776−-- >>> writeN n = Array.appendN (Array.newArray n) n

1773+-- >>> writeN n = Array.appendN (Array.newPinned n) n

1777--

1774--

1778-- @since 0.7.0

1775-- @since 0.7.0

1779{-# INLINE_NORMAL writeN #-}

1776{-# INLINE_NORMAL writeN #-}

1780writeN :: forall m a. (MonadIO m, Unboxed a) => Int -> Fold m a (Array a)

1777writeN :: forall m a. (MonadIO m, Unboxed a) => Int -> Fold m a (Array a)

1781−writeN = writeNWith newArray

1778+writeN = writeNWith newPinned

1782

1779

1783-- | Like writeNWithUnsafe but writes the array in reverse order.

1780-- | Like writeNWithUnsafe but writes the array in reverse order.

1784--

1781--

@@ -1814,20 +1811,20 @@ writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)

1814-- /Pre-release/

1811-- /Pre-release/

1815{-# INLINE_NORMAL writeRevN #-}

1812{-# INLINE_NORMAL writeRevN #-}

1816writeRevN :: forall m a. (MonadIO m, Unboxed a) => Int -> Fold m a (Array a)

1813writeRevN :: forall m a. (MonadIO m, Unboxed a) => Int -> Fold m a (Array a)

1817−writeRevN = writeRevNWith newArray

1814+writeRevN = writeRevNWith newPinned

1818

1815

1819-- | @writeNAligned align n@ folds a maximum of @n@ elements from the input

1816-- | @writeNAligned align n@ folds a maximum of @n@ elements from the input

1820-- stream to an 'Array' aligned to the given size.

1817-- stream to an 'Array' aligned to the given size.

1821--

1818--

1822−-- >>> writeNAligned align = Array.writeNWith (Array.newArrayAligned align)

1819+-- >>> writeNAligned align = Array.writeNWith (Array.newAlignedPinned align)

1823−-- >>> writeNAligned align n = Array.appendN (Array.newArrayAligned align n) n

1820+-- >>> writeNAligned align n = Array.appendN (Array.newAlignedPinned align n) n

1824--

1821--

1825-- /Pre-release/

1822-- /Pre-release/

1826--

1823--

1827{-# INLINE_NORMAL writeNAligned #-}

1824{-# INLINE_NORMAL writeNAligned #-}

1828writeNAligned :: forall m a. (MonadIO m, Unboxed a)

1825writeNAligned :: forall m a. (MonadIO m, Unboxed a)

1829 => Int -> Int -> Fold m a (Array a)

1826 => Int -> Int -> Fold m a (Array a)

1830−writeNAligned align = writeNWith (newArrayAligned align)

1827+writeNAligned align = writeNWith (newAlignedPinned align)

1831

1828

1832-- XXX Buffer to a list instead?

1829-- XXX Buffer to a list instead?

1833--

1830--

@@ -1870,7 +1867,7 @@ writeChunks n = FL.many (writeN n) FL.toStreamK

1870--

1867--

1871-- /Caution! Do not use this on infinite streams./

1868-- /Caution! Do not use this on infinite streams./

1872--

1869--

1873−-- >>> f n = Array.appendWith (* 2) (Array.newArray n)

1870+-- >>> f n = Array.appendWith (* 2) (Array.newPinned n)

1874-- >>> writeWith n = Fold.rmapM Array.rightSize (f n)

1871-- >>> writeWith n = Fold.rmapM Array.rightSize (f n)

1875-- >>> writeWith n = Fold.rmapM Array.fromArrayStreamK (Array.writeChunks n)

1872-- >>> writeWith n = Fold.rmapM Array.fromArrayStreamK (Array.writeChunks n)

1876--

1873--

@@ -1878,7 +1875,7 @@ writeChunks n = FL.many (writeN n) FL.toStreamK

1878{-# INLINE_NORMAL writeWith #-}

1875{-# INLINE_NORMAL writeWith #-}

1879writeWith :: forall m a. (MonadIO m, Unboxed a)

1876writeWith :: forall m a. (MonadIO m, Unboxed a)

1880 => Int -> Fold m a (Array a)

1877 => Int -> Fold m a (Array a)

1881−-- writeWith n = FL.rmapM rightSize $ appendWith (* 2) (newArray n)

1878+-- writeWith n = FL.rmapM rightSize $ appendWith (* 2) (newPinned n)

1882writeWith elemCount =

1879writeWith elemCount =

1883 FL.rmapM extract $ FL.foldlM' step initial

1880 FL.rmapM extract $ FL.foldlM' step initial

1884

1881

@@ -1890,7 +1887,7 @@ writeWith elemCount =

1890

1887

1891 initial = do

1888 initial = do

1892 when (elemCount < 0) $ error "writeWith: elemCount is negative"

1889 when (elemCount < 0) $ error "writeWith: elemCount is negative"

1893− liftIO $ newArrayAligned (alignment (undefined :: a)) elemCount

1890+ liftIO $ newAlignedPinned (alignment (undefined :: a)) elemCount

1894 step arr@(Array _ start end bound) x

1891 step arr@(Array _ start end bound) x

1895 | INDEX_NEXT(end,a) > bound = do

1892 | INDEX_NEXT(end,a) > bound = do

1896 let oldSize = end - start

1893 let oldSize = end - start

@@ -1931,7 +1928,7 @@ fromStreamDN :: forall m a. (MonadIO m, Unboxed a)

1931 => Int -> D.Stream m a -> m (Array a)

1928 => Int -> D.Stream m a -> m (Array a)

1932-- fromStreamDN n = D.fold (writeN n)

1929-- fromStreamDN n = D.fold (writeN n)

1933fromStreamDN limit str = do

1930fromStreamDN limit str = do

1934− arr <- liftIO $ newArray limit

1931+ arr <- liftIO $ newPinned limit

1935 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str

1932 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str

1936 return $ arr {arrEnd = end}

1933 return $ arr {arrEnd = end}

1937

1934

@@ -2038,7 +2035,7 @@ spliceCopy arr1 arr2 = liftIO $ do

2038 len2 = arrEnd arr2 - start2

2035 len2 = arrEnd arr2 - start2

2039 newArrContents <-

2036 newArrContents <-

2040 liftIO

2037 liftIO

2041− $ newAlignedArrayContents

2038+ $ Unboxed.newAlignedPinnedBytes

2042 (len1 + len2)

2039 (len1 + len2)

2043 (alignment (undefined :: a))

2040 (alignment (undefined :: a))

2044 let len = len1 + len2

2041 let len = len1 + len2

core/src/Streamly/Internal/Data/Array/Unboxed/Stream.hs+3−3

@@ -473,7 +473,7 @@ foldlM' step begin = D.foldlM' step begin . S.toStreamD

473spliceArraysLenUnsafe :: (MonadIO m, Unboxed a)

474 => Int -> Stream m (MA.Array a) -> m (MA.Array a)

475spliceArraysLenUnsafe len buffered = do

476− arr <- liftIO $ MA.newArray len

476+ arr <- liftIO $ MA.newPinned len

477 foldlM' MA.spliceUnsafe (return arr) buffered

478

479{-# INLINE _spliceArrays #-}

@@ -482,7 +482,7 @@ _spliceArrays :: (MonadIO m, Unboxed a)

482_spliceArrays s = do

483 buffered <- S.foldr S.cons S.nil s

484 len <- S.fold FL.sum (fmap Array.length buffered)

485− arr <- liftIO $ MA.newArray len

485+ arr <- liftIO $ MA.newPinned len

486 final <- foldlM' writeArr (return arr) s

487 return $ A.unsafeFreeze final

488

@@ -503,7 +503,7 @@ spliceArraysRealloced :: forall m a. (MonadIO m, Unboxed a)

503 => Stream m (Array a) -> m (Array a)

504spliceArraysRealloced s = do

505 let n = allocBytesToElemCount (undefined :: a) (4 * 1024)

506− idst = liftIO $ MA.newArray n

506+ idst = liftIO $ MA.newPinned n

507

508 arr <- foldlM' MA.spliceExp idst (fmap A.unsafeThaw s)

509 liftIO $ A.unsafeFreeze <$> MA.rightSize arr

core/src/Streamly/Internal/Data/Array/Unboxed/Type.hs+3−2

@@ -94,12 +94,13 @@ import Text.Read (readPrec, readListPrec, readListPrecDefault)

95import Prelude hiding (length, foldr, read, unlines, splitAt)

97+import qualified GHC.Exts as Exts

97import qualified Streamly.Internal.Data.Array.Unboxed.Mut.Type as MA

98import qualified Streamly.Internal.Data.Array.Unboxed.Mut.Type as MA

98import qualified Streamly.Internal.Data.Stream.StreamD.Type as D

99import qualified Streamly.Internal.Data.Stream.StreamD.Type as D

99import qualified Streamly.Internal.Data.Stream.StreamK.Type as K

100import qualified Streamly.Internal.Data.Stream.StreamK.Type as K

100import qualified Streamly.Internal.Data.Stream.Type as Stream

101import qualified Streamly.Internal.Data.Stream.Type as Stream

102+import qualified Streamly.Internal.Data.Unboxed as Unboxed

101import qualified Streamly.Internal.Data.Unfold.Type as Unfold

103import qualified Streamly.Internal.Data.Unfold.Type as Unfold

102−import qualified GHC.Exts as Exts

103

104

104import Streamly.Internal.System.IO (unsafeInlineIO, defaultChunkSize)

105import Streamly.Internal.System.IO (unsafeInlineIO, defaultChunkSize)

105

106

@@ -595,7 +596,7 @@ nil ::

595 Unboxed a =>

596 Unboxed a =>

596#endif

597#endif

597 Array a

598 Array a

598−nil = Array MA.nilArrayContents 0 0

599+nil = Array Unboxed.nil 0 0

599

600

600instance Unboxed a => Monoid (Array a) where

601instance Unboxed a => Monoid (Array a) where

601 mempty = nil

602 mempty = nil

core/src/Streamly/Internal/Data/Fold.hs+1−1

@@ -2812,7 +2812,7 @@ topBy cmp n = Fold step initial extract

2812 where

2813

2814 initial = do

2815− arr <- MA.newArray n

2815+ arr <- MA.newPinned n

2816 if n <= 0

2817 then return $ Done arr

2818 else return $ Partial (arr, 0)

core/src/Streamly/Internal/Data/IORef/Unboxed.hs+2−2

@@ -45,7 +45,7 @@ import Streamly.Internal.Data.Unboxed

45 , sizeOf

46 , peekWith

47 , pokeWith

48− , newUnpinnedArrayContents

48+ , newUnpinnedBytes

49 )

51import qualified Streamly.Internal.Data.Stream.StreamD.Type as D

@@ -59,7 +59,7 @@ newtype IORef a = IORef (MutableByteArray a)

59{-# INLINE newIORef #-}

60newIORef :: forall a. Unboxed a => a -> IO (IORef a)

61newIORef x = do

62− var <- newUnpinnedArrayContents (sizeOf (undefined :: a))

62+ var <- newUnpinnedBytes (sizeOf (undefined :: a))

63 pokeWith var 0 x

64 return $ IORef var

core/src/Streamly/Internal/Data/Ring/Unboxed.hs+1−1

@@ -579,7 +579,7 @@ slidingWindowWith n (Fold step1 initial1 extract1) = Fold step initial extract

579 Done b -> Done b

580

581 toArray foldRing rb rh = do

582− arr <- liftIO $ MA.newArray n

582+ arr <- liftIO $ MA.newPinned n

583 let snoc' b a = liftIO $ MA.snocUnsafe b a

584 foldRing rh snoc' arr rb

585

core/src/Streamly/Internal/Data/Unboxed.hs+23−6

@@ -14,7 +14,9 @@ module Streamly.Internal.Data.Unboxed

14 , getMutableByteArray#

15 , pin

16 , unpin

17− , newUnpinnedArrayContents

17+ , newUnpinnedBytes

18+ , newAlignedPinnedBytes

19+ , nil

18 ) where

20 ) where

20#include "MachDeps.h"

22#include "MachDeps.h"

@@ -36,6 +38,7 @@ import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))

36#if MIN_VERSION_base(4,15,0)

38#if MIN_VERSION_base(4,15,0)

37import GHC.RTS.Flags (IoSubSystem(..))

39import GHC.RTS.Flags (IoSubSystem(..))

38#endif

40#endif

41+import System.IO.Unsafe (unsafePerformIO)

40import GHC.Exts

43import GHC.Exts

@@ -63,16 +66,30 @@ touch (MutableByteArray contents) =

63-- Creation

66-- Creation

64--------------------------------------------------------------------------------

67--------------------------------------------------------------------------------

66−{-# INLINE newUnpinnedArrayContents #-}

69+{-# NOINLINE nil #-}

70+nil :: MutableByteArray a

71+nil = unsafePerformIO $ newUnpinnedBytes 0

72+

73+{-# INLINE newUnpinnedBytes #-}

67−newUnpinnedArrayContents :: Int -> IO (MutableByteArray a)

74+newUnpinnedBytes :: Int -> IO (MutableByteArray a)

68−newUnpinnedArrayContents nbytes | nbytes < 0 =

75+newUnpinnedBytes nbytes | nbytes < 0 =

69− errorWithoutStackTrace "newUnpinnedArrayContents: size must be >= 0"

76+ errorWithoutStackTrace "newUnpinnedBytes: size must be >= 0"

70−newUnpinnedArrayContents (I# nbytes) = IO $ \s ->

77+newUnpinnedBytes (I# nbytes) = IO $ \s ->

71 case newByteArray# nbytes s of

78 case newByteArray# nbytes s of

72 (# s', mbarr# #) ->

79 (# s', mbarr# #) ->

73 let c = MutableByteArray mbarr#

80 let c = MutableByteArray mbarr#

74 in (# s', c #)

81 in (# s', c #)

83+{-# INLINE newAlignedPinnedBytes #-}

84+newAlignedPinnedBytes :: Int -> Int -> IO (MutableByteArray a)

85+newAlignedPinnedBytes nbytes _align | nbytes < 0 =

86+ errorWithoutStackTrace "newAlignedPinnedBytes: size must be >= 0"

87+newAlignedPinnedBytes (I# nbytes) (I# align) = IO $ \s ->

88+ case newAlignedPinnedByteArray# nbytes align s of

89+ (# s', mbarr# #) ->

90+ let c = MutableByteArray mbarr#

91+ in (# s', c #)

92+

76-------------------------------------------------------------------------------

93-------------------------------------------------------------------------------

77-- Pinning & Unpinning

94-- Pinning & Unpinning

78-------------------------------------------------------------------------------

95-------------------------------------------------------------------------------

core/src/Streamly/Internal/FileSystem/Handle.hs+1−1

@@ -180,7 +180,7 @@ import qualified Streamly.Internal.Data.Stream.StreamK.Type as K (mkStream)

180{-# INLINABLE getChunk #-}

181getChunk :: MonadIO m => Int -> Handle -> m (Array Word8)

182getChunk size h = liftIO $ do

183− arr <- MArray.newPinnedArrayBytes size

183+ arr <- MArray.newPinnedBytes size

184 -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))

185 MArray.asPtrUnsafe arr $ \p -> do

186 n <- hGetBufSome h p size

src/Streamly/Internal/FileSystem/FD.hs+2−2

@@ -146,7 +146,7 @@ import qualified Streamly.Internal.System.IOVec.Type as RawIO

146import qualified Streamly.Data.Array.Unboxed as A

147import qualified Streamly.Data.Fold as FL

148import qualified Streamly.Internal.Data.Array.Unboxed.Mut as MArray

149− (Array(..), newPinnedArrayBytes, asPtrUnsafe)

149+ (Array(..), newPinnedBytes, asPtrUnsafe)

150import qualified Streamly.Internal.Data.Array.Unboxed.Stream as AS

151import qualified Streamly.Internal.Data.Stream as S

152import qualified Streamly.Internal.Data.Stream.StreamD.Type as D

@@ -217,7 +217,7 @@ openFile path mode = Handle . fst <$> FD.openFile path mode True

217{-# INLINABLE readArrayUpto #-}

218readArrayUpto :: Int -> Handle -> IO (Array Word8)

219readArrayUpto size (Handle fd) = do

220− arr <- MArray.newPinnedArrayBytes size

220+ arr <- MArray.newPinnedBytes size

221 -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))

222 MArray.asPtrUnsafe arr $ \p -> do

223 -- n <- hGetBufSome h p size

src/Streamly/Internal/Network/Socket.hs+2−2

@@ -104,7 +104,7 @@ import qualified Streamly.Data.Fold as FL

104import qualified Streamly.Internal.Data.Array.Unboxed.Type as A

105 (unsafeFreeze, asPtrUnsafe, byteLength, writeNUnsafe)

106import qualified Streamly.Internal.Data.Array.Unboxed.Mut as MArray

107− (Array(..), newPinnedArrayBytes, asPtrUnsafe)

107+ (Array(..), newPinnedBytes, asPtrUnsafe)

108import qualified Streamly.Internal.Data.Array.Unboxed.Stream as AS

109import qualified Streamly.Internal.Data.Stream as S

110import qualified Streamly.Internal.Data.Stream.StreamD.Type as D

@@ -261,7 +261,7 @@ readArrayUptoWith

261 -> h

262 -> IO (Array Word8)

263readArrayUptoWith f size h = do

264− arr <- MArray.newPinnedArrayBytes size

264+ arr <- MArray.newPinnedBytes size

265 -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))

266 MArray.asPtrUnsafe arr $ \p -> do

267 n <- f h p size

test/Streamly/Test/Data/Array/Unboxed.hs+2−2

@@ -155,7 +155,7 @@ testBubbleWith asc =

155 else MA.bubble (flip compare) arr

156 return arr

157 )

158− (MA.newArray $ length ls)

158+ (MA.newPinned $ length ls)

159

160testBubbleAsc :: Property

161testBubbleAsc = testBubbleWith True

@@ -165,7 +165,7 @@ testBubbleDesc = testBubbleWith False

165

166testByteLengthWithMA :: forall a. Unboxed a => a -> IO ()

167testByteLengthWithMA _ = do

168− arrA <- MA.newArray 100 :: IO (MA.Array a)

168+ arrA <- MA.newPinned 100 :: IO (MA.Array a)

169 let arrW8 = MA.castUnsafe arrA :: MA.Array Word8

170 MA.byteLength arrA `shouldBe` MA.length arrW8

171

test/Streamly/Test/Data/Array/Unboxed/Mut.hs+1−1

@@ -42,7 +42,7 @@ testAppend =

43 action ls = do

44 x <- Stream.fold

45− (MArray.append (MArray.newArray 0))

45+ (MArray.append (MArray.newPinned 0))

46 (Stream.fromList (ls::[Int]))

47 lst <- MArray.toList x

48 assert (ls == lst)