34b2b49 · streamly · git.iko.soy

1{-# LANGUAGE UnboxedTuples #-}

2-- |

3−-- Module : Streamly.Internal.Data.Array.Mut.Type

3+-- Module : Streamly.Internal.Data.MutArray.Mut.Type

5-- License : BSD3-3-Clause

6-- Maintainer : streamly@composewell.com

16 (

17 -- * Type

18 -- $arrayNotes

19− Array (..)

19+ MutArray (..)

20 , MutableByteArray

21 , touch

22 , pin

260

261-- $setup

262-- >>> :m

263−-- >>> import qualified Streamly.Internal.Data.Array.Mut.Type as Array

263+-- >>> import qualified Streamly.Internal.Data.Array.Mut.Type as MutArray

264-- >>> import qualified Streamly.Internal.Data.Stream as Stream

265-- >>> import qualified Streamly.Internal.Data.Stream.StreamD as StreamD

266-- >>> import qualified Streamly.Internal.Data.Fold as Fold

299 return $ r == 0

300

301-------------------------------------------------------------------------------

302−-- Array Data Type

302+-- MutArray Data Type

303-------------------------------------------------------------------------------

304

305-- $arrayNotes

306--

307−-- We can use an 'Unboxed' constraint in the Array type and the constraint can

307+-- We can use an 'Unboxed' constraint in the MutArray type and the constraint can

308−-- be automatically provided to a function that pattern matches on the Array

308+-- be automatically provided to a function that pattern matches on the MutArray

309-- type. However, it has huge performance cost, so we do not use it.

310-- Investigate a GHC improvement possiblity.

311

328-- and performance impact due to reallocations when growing or shrinking the

329-- array.

330--

331−data Array a =

331+data MutArray a =

332#ifdef DEVBUILD

333 Unbox a =>

334#endif

335 -- The array is a range into arrContents. arrContents may be a superset of

336 -- the slice represented by the array. All offsets are in bytes.

337− Array

337+ MutArray

338 { arrContents :: {-# UNPACK #-} !MutableByteArray

339 , arrStart :: {-# UNPACK #-} !Int -- ^ index into arrContents

340 , arrEnd :: {-# UNPACK #-} !Int -- ^ index into arrContents

348-------------------------------------------------------------------------------

349

350{-# INLINE pin #-}

351−pin :: Array a -> IO (Array a)

351+pin :: MutArray a -> IO (MutArray a)

352−pin arr@Array{..} = do

352+pin arr@MutArray{..} = do

353 contents <- Unboxed.pin arrContents

354 return $ arr {arrContents = contents}

355

356{-# INLINE unpin #-}

357−unpin :: Array a -> IO (Array a)

357+unpin :: MutArray a -> IO (MutArray a)

358−unpin arr@Array{..} = do

358+unpin arr@MutArray{..} = do

359 contents <- Unboxed.unpin arrContents

360 return $ arr {arrContents = contents}

361

387-- /Pre-release/

388{-# INLINE newArrayWith #-}

389newArrayWith :: forall m a. (MonadIO m, Unbox a)

390− => (Int -> Int -> m MutableByteArray) -> Int -> Int -> m (Array a)

390+ => (Int -> Int -> m MutableByteArray) -> Int -> Int -> m (MutArray a)

391newArrayWith alloc alignSize count = do

392 let size = max (count * SIZE_OF(a)) 0

393 contents <- alloc size alignSize

394− return $ Array

394+ return $ MutArray

395 { arrContents = contents

396 , arrStart = 0

397 , arrEnd = 0

402#ifdef DEVBUILD

403 Unbox a =>

404#endif

405− Array a

405+ MutArray a

406−nil = Array Unboxed.nil 0 0 0

406+nil = MutArray Unboxed.nil 0 0 0

407

408

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

416#ifdef DEVBUILD

417 Unbox a =>

418#endif

419− Int -> m (Array a)

419+ Int -> m (MutArray a)

420newPinnedBytes bytes = do

421 contents <- liftIO $ Unboxed.newPinnedBytes bytes

422− return $ Array

422+ return $ MutArray

423 { arrContents = contents

424 , arrStart = 0

425 , arrEnd = 0

431--

432-- /Internal/

433{-# INLINE newAlignedPinned #-}

434−newAlignedPinned :: (MonadIO m, Unbox a) => Int -> Int -> m (Array a)

434+newAlignedPinned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)

435newAlignedPinned =

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

437

442-- instance of the type.

443--

444{-# INLINE newPinned #-}

445−newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (Array a)

445+newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)

446newPinned =

447 newArrayWith

448 (\s _ -> liftIO $ Unboxed.newPinnedBytes s)

452-- of the array is uninitialized.

453--

454{-# INLINE new #-}

455−new :: (MonadIO m, Unbox a) => Int -> m (Array a)

455+new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)

456new =

457 newArrayWith

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

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

460

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

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

462-- start pointer.

463--

464-- /Internal/

465{-# INLINE withNewArrayUnsafe #-}

466withNewArrayUnsafe ::

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

467+ (MonadIO m, Unbox a) => Int -> (Ptr a -> m ()) -> m (MutArray a)

468withNewArrayUnsafe count f = do

469 arr <- newPinned count

470 asPtrUnsafe arr

480-- /Pre-release/

481{-# INLINE putIndexUnsafe #-}

482putIndexUnsafe :: forall m a. (MonadIO m, Unbox a)

483− => Int -> Array a -> a -> m ()

483+ => Int -> MutArray a -> a -> m ()

484−putIndexUnsafe i Array{..} x = do

484+putIndexUnsafe i MutArray{..} x = do

485 let index = INDEX_OF(arrStart, i, a)

486 assert (i >= 0 && INDEX_VALID(index, arrEnd, a)) (return ())

487 liftIO $ pokeWith arrContents index x

493-- | /O(1)/ Write the given element at the given index in the array.

494-- Performs in-place mutation of the array.

495--

496−-- >>> putIndex ix arr val = Array.modifyIndex ix arr (const (val, ()))

496+-- >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))

497−-- >>> f = Array.putIndices

497+-- >>> f = MutArray.putIndices

498-- >>> putIndex ix arr val = Stream.fold (f arr) (Stream.fromPure (ix, val))

499--

500{-# INLINE putIndex #-}

501−putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> Array a -> a -> m ()

501+putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()

502−putIndex i Array{..} x = do

502+putIndex i MutArray{..} x = do

503 let index = INDEX_OF(arrStart,i,a)

504 if i >= 0 && INDEX_VALID(index,arrEnd,a)

505 then liftIO $ pokeWith arrContents index x

511-- /Pre-release/

512{-# INLINE putIndices #-}

513putIndices :: forall m a. (MonadIO m, Unbox a)

514− => Array a -> Fold m (Int, a) ()

514+ => MutArray a -> Fold m (Int, a) ()

515putIndices arr = FL.foldlM' step (return ())

516

517 where

522--

523-- /Pre-release/

524modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) =>

525− Int -> Array a -> (a -> (a, b)) -> m b

525+ Int -> MutArray a -> (a -> (a, b)) -> m b

526−modifyIndexUnsafe i Array{..} f = liftIO $ do

526+modifyIndexUnsafe i MutArray{..} f = liftIO $ do

527 let index = INDEX_OF(arrStart,i,a)

528 assert (i >= 0 && INDEX_NEXT(index,a) <= arrEnd) (return ())

529 r <- peekWith arrContents index

535--

536-- /Pre-release/

537modifyIndex :: forall m a b. (MonadIO m, Unbox a) =>

538− Int -> Array a -> (a -> (a, b)) -> m b

538+ Int -> MutArray a -> (a -> (a, b)) -> m b

539−modifyIndex i Array{..} f = do

539+modifyIndex i MutArray{..} f = do

540 let index = INDEX_OF(arrStart,i,a)

541 if i >= 0 && INDEX_VALID(index,arrEnd,a)

542 then liftIO $ do

552-- /Pre-release/

553{-# INLINE modifyIndices #-}

554modifyIndices :: forall m a . (MonadIO m, Unbox a)

555− => Array a -> (Int -> a -> a) -> Fold m Int ()

555+ => MutArray a -> (Int -> a -> a) -> Fold m Int ()

556modifyIndices arr f = FL.foldlM' step initial

557

558 where

567--

568-- /Pre-release/

569modify :: forall m a. (MonadIO m, Unbox a)

570− => Array a -> (a -> a) -> m ()

570+ => MutArray a -> (a -> a) -> m ()

571−modify Array{..} f = liftIO $

571+modify MutArray{..} f = liftIO $

572 go arrStart

573

574 where

602-- /Pre-release/

603{-# INLINE unsafeSwapIndices #-}

604unsafeSwapIndices :: forall m a. (MonadIO m, Unbox a)

605− => Int -> Int -> Array a -> m ()

605+ => Int -> Int -> MutArray a -> m ()

606−unsafeSwapIndices i1 i2 Array{..} = liftIO $ do

606+unsafeSwapIndices i1 i2 MutArray{..} = liftIO $ do

607 let t1 = INDEX_OF(arrStart,i1,a)

608 t2 = INDEX_OF(arrStart,i2,a)

609 swapArrayByteIndices (Proxy :: Proxy a) arrContents t1 t2

612--

613-- /Pre-release/

614swapIndices :: forall m a. (MonadIO m, Unbox a)

615− => Int -> Int -> Array a -> m ()

615+ => Int -> Int -> MutArray a -> m ()

616−swapIndices i1 i2 Array{..} = liftIO $ do

616+swapIndices i1 i2 MutArray{..} = liftIO $ do

617 let t1 = INDEX_OF(arrStart,i1,a)

618 t2 = INDEX_OF(arrStart,i2,a)

619 when (i1 < 0 || INDEX_INVALID(t1,arrEnd,a))

717-- which complicates some inspection tests.

718--

719{-# NOINLINE reallocExplicit #-}

720−reallocExplicit :: Int -> Int -> Array a -> IO (Array a)

720+reallocExplicit :: Int -> Int -> MutArray a -> IO (MutArray a)

721−reallocExplicit elemSize newCapacityInBytes Array{..} = do

721+reallocExplicit elemSize newCapacityInBytes MutArray{..} = do

722 assertM(arrEnd <= arrBound)

723

724 -- Allocate new array

739 IO $ \s# -> (# copyMutableByteArray# mbarrFrom# oldStartInBytes#

740 mbarrTo# 0# newLenInBytes# s#, () #)

741

742− return $ Array

742+ return $ MutArray

743 { arrStart = 0

744 , arrContents = contents

745 , arrEnd = newLenInBytes

755-- 'largeObjectThreshold' then it is rounded up to the block size (4K).

756--

757{-# INLINABLE realloc #-}

758−realloc :: forall m a. (MonadIO m, Unbox a) => Int -> Array a -> m (Array a)

758+realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)

759realloc bytes arr = liftIO $ reallocExplicit (SIZE_OF(a)) bytes arr

760

761-- | @reallocWith label capSizer minIncrBytes array@. The label is used

765 String

766 -> (Int -> Int)

767 -> Int

768− -> Array a

768+ -> MutArray a

769− -> m (Array a)

769+ -> m (MutArray a)

770reallocWith label capSizer minIncrBytes arr = do

771 let oldSizeBytes = arrEnd arr - arrStart arr

772 newCapBytes = capSizer oldSizeBytes

796-- /Pre-release/

797{-# INLINE resize #-}

798resize :: forall m a. (MonadIO m, Unbox a) =>

799− Int -> Array a -> m (Array a)

799+ Int -> MutArray a -> m (MutArray a)

800−resize nElems arr@Array{..} = do

800+resize nElems arr@MutArray{..} = do

801 let req = SIZE_OF(a) * nElems

802 len = arrEnd - arrStart

803 if req < len

810-- /Pre-release/

811{-# INLINE resizeExp #-}

812resizeExp :: forall m a. (MonadIO m, Unbox a) =>

813− Int -> Array a -> m (Array a)

813+ Int -> MutArray a -> m (MutArray a)

814−resizeExp nElems arr@Array{..} = do

814+resizeExp nElems arr@MutArray{..} = do

815 let req = roundUpLargeArray (SIZE_OF(a) * nElems)

816 req1 =

817 if req > largeObjectThreshold

831--

832-- /Pre-release/

833{-# INLINE rightSize #-}

834−rightSize :: forall m a. (MonadIO m, Unbox a) => Array a -> m (Array a)

834+rightSize :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m (MutArray a)

835−rightSize arr@Array{..} = do

835+rightSize arr@MutArray{..} = do

836 assert (arrEnd <= arrBound) (return ())

837 let start = arrStart

838 len = arrEnd - start

854-- bound pointers. Using fully mutable handle will ensure that we do not have

855-- multiple references to the same array of different lengths lying around and

856-- potentially misused. In that case "snoc" need not return a new array (snoc

857−-- :: Array a -> a -> m ()), it will just modify the old reference. The array

857+-- :: MutArray a -> a -> m ()), it will just modify the old reference. The array

858-- length will be mutable. This means the length function would also be

859-- monadic. Mutable arrays would behave more like files that grow in that

860-- case.

863--

864-- /Internal/

865{-# INLINE snocNewEnd #-}

866−snocNewEnd :: (MonadIO m, Unbox a) => Int -> Array a -> a -> m (Array a)

866+snocNewEnd :: (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)

867−snocNewEnd newEnd arr@Array{..} x = liftIO $ do

867+snocNewEnd newEnd arr@MutArray{..} x = liftIO $ do

868 assert (newEnd <= arrBound) (return ())

869 pokeWith arrContents arrEnd x

870 return $ arr {arrEnd = newEnd}

876-- /Internal/

877{-# INLINE snocUnsafe #-}

878snocUnsafe :: forall m a. (MonadIO m, Unbox a) =>

879− Array a -> a -> m (Array a)

879+ MutArray a -> a -> m (MutArray a)

880−snocUnsafe arr@Array{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr

880+snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr

881

882-- | Like 'snoc' but does not reallocate when pre-allocated array capacity

883-- becomes full.

885-- /Internal/

886{-# INLINE snocMay #-}

887snocMay :: forall m a. (MonadIO m, Unbox a) =>

888− Array a -> a -> m (Maybe (Array a))

888+ MutArray a -> a -> m (Maybe (MutArray a))

889−snocMay arr@Array{..} x = liftIO $ do

889+snocMay arr@MutArray{..} x = liftIO $ do

890 let newEnd = INDEX_NEXT(arrEnd,a)

891 if newEnd <= arrBound

892 then Just <$> snocNewEnd newEnd arr x

896{-# NOINLINE snocWithRealloc #-}

897snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>

898 (Int -> Int)

899− -> Array a

899+ -> MutArray a

900 -> a

901− -> m (Array a)

901+ -> m (MutArray a)

902snocWithRealloc sizer arr x = do

903 arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr

904 snocUnsafe arr1 x

919{-# INLINE snocWith #-}

920snocWith :: forall m a. (MonadIO m, Unbox a) =>

921 (Int -> Int)

922− -> Array a

922+ -> MutArray a

923 -> a

924− -> m (Array a)

924+ -> m (MutArray a)

925snocWith allocSize arr x = liftIO $ do

926 let newEnd = INDEX_NEXT(arrEnd arr,a)

927 if newEnd <= arrBound arr

939--

940-- /Pre-release/

941{-# INLINE snocLinear #-}

942−snocLinear :: forall m a. (MonadIO m, Unbox a) => Array a -> a -> m (Array a)

942+snocLinear :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)

943snocLinear = snocWith (+ allocBytesToBytes (undefined :: a) arrayChunkBytes)

944

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

951--

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

953--

954−-- >>> snoc = Array.snocWith (* 2)

954+-- >>> snoc = MutArray.snocWith (* 2)

955--

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

957--

958{-# INLINE snoc #-}

959−snoc :: forall m a. (MonadIO m, Unbox a) => Array a -> a -> m (Array a)

959+snoc :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)

960snoc = snocWith f

961

962 where

976--

977-- Unsafe because it does not check the bounds of the array.

978{-# INLINE_NORMAL getIndexUnsafe #-}

979−getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Array a -> m a

979+getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a

980−getIndexUnsafe i Array{..} = do

980+getIndexUnsafe i MutArray{..} = do

981 let index = INDEX_OF(arrStart,i,a)

982 assert (i >= 0 && INDEX_VALID(index,arrEnd,a)) (return ())

983 liftIO $ peekWith arrContents index

985-- | /O(1)/ Lookup the element at the given index. Index starts from 0.

986--

987{-# INLINE getIndex #-}

988−getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> Array a -> m a

988+getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a

989−getIndex i Array{..} = do

989+getIndex i MutArray{..} = do

990 let index = INDEX_OF(arrStart,i,a)

991 if i >= 0 && INDEX_VALID(index,arrEnd,a)

992 then liftIO $ peekWith arrContents index

998-- Slightly faster than computing the forward index and using getIndex.

999--

1000{-# INLINE getIndexRev #-}

1001−getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> Array a -> m a

1001+getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a

1002−getIndexRev i Array{..} = do

1002+getIndexRev i MutArray{..} = do

1003 let index = RINDEX_OF(arrEnd,i,a)

1004 if i >= 0 && index >= arrStart

1005 then liftIO $ peekWith arrContents index

1009 GetIndicesState contents start end st

1010

1011-- | Given an unfold that generates array indices, read the elements on those

1012−-- indices from the supplied Array. An error is thrown if an index is out of

1012+-- indices from the supplied MutArray. An error is thrown if an index is out of

1013-- bounds.

1014--

1015-- /Pre-release/

1016{-# INLINE getIndicesD #-}

1017getIndicesD :: (Monad m, Unbox a) =>

1018− (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (Array a) a

1018+ (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a

1019getIndicesD liftio (D.Stream stepi sti) = Unfold step inject

1020

1021 where

1022

1023− inject (Array contents start end _) =

1023+ inject (MutArray contents start end _) =

1024 return $ GetIndicesState contents start end sti

1025

1026 {-# INLINE_LATE step #-}

1028 r <- stepi defState st

1029 case r of

1030 D.Yield i s -> do

1031− x <- liftio $ getIndex i (Array contents start end undefined)

1031+ x <- liftio $ getIndex i (MutArray contents start end undefined)

1032 return $ D.Yield x (GetIndicesState contents start end s)

1033 D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)

1034 D.Stop -> return D.Stop

1035

1036{-# INLINE getIndices #-}

1037−getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (Array a) a

1037+getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a

1038getIndices = getIndicesD liftIO

1039

1040-------------------------------------------------------------------------------

1054getSliceUnsafe :: forall a. Unbox a

1055 => Int -- ^ from index

1056 -> Int -- ^ length of the slice

1057− -> Array a

1057+ -> MutArray a

1058− -> Array a

1058+ -> MutArray a

1059−getSliceUnsafe index len (Array contents start e _) =

1059+getSliceUnsafe index len (MutArray contents start e _) =

1060 let fp1 = INDEX_OF(start,index,a)

1061 end = fp1 + (len * SIZE_OF(a))

1062 in assert

1063 (index >= 0 && len >= 0 && end <= e)

1064 -- Note: In a slice we always use bound = end so that the slice

1065 -- user cannot overwrite elements beyond the end of the slice.

1066− (Array contents fp1 end end)

1066+ (MutArray contents fp1 end end)

1067

1068-- | /O(1)/ Slice an array in constant time. Throws an error if the slice

1069-- extends out of the array bounds.

1073getSlice :: forall a. Unbox a =>

1074 Int -- ^ from index

1075 -> Int -- ^ length of the slice

1076− -> Array a

1076+ -> MutArray a

1077− -> Array a

1077+ -> MutArray a

1078−getSlice index len (Array contents start e _) =

1078+getSlice index len (MutArray contents start e _) =

1079 let fp1 = INDEX_OF(start,index,a)

1080 end = fp1 + (len * SIZE_OF(a))

1081 in if index >= 0 && len >= 0 && end <= e

1082 -- Note: In a slice we always use bound = end so that the slice user

1083 -- cannot overwrite elements beyond the end of the slice.

1084− then Array contents fp1 end end

1084+ then MutArray contents fp1 end end

1085 else error

1086 $ "getSlice: invalid slice, index "

1087 ++ show index ++ " length " ++ show len

1098-- of cache locality and when you do not want to allocate additional memory.

1099--

1100{-# INLINE reverse #-}

1101−reverse :: forall m a. (MonadIO m, Unbox a) => Array a -> m ()

1101+reverse :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m ()

1102−reverse Array{..} = liftIO $ do

1102+reverse MutArray{..} = liftIO $ do

1103 let l = arrStart

1104 h = INDEX_PREV(arrEnd,a)

1105 in swap l h

1116--

1117-- /Unimplemented/

1118{-# INLINE permute #-}

1119−permute :: Array a -> m Bool

1119+permute :: MutArray a -> m Bool

1120permute = undefined

1121

1122-- | Partition an array into two halves using a partitioning predicate. The

1126-- /Pre-release/

1127{-# INLINE partitionBy #-}

1128partitionBy :: forall m a. (MonadIO m, Unbox a)

1129− => (a -> Bool) -> Array a -> m (Array a, Array a)

1129+ => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)

1130−partitionBy f arr@Array{..} = liftIO $ do

1130+partitionBy f arr@MutArray{..} = liftIO $ do

1131 if arrStart >= arrEnd

1132 then return (arr, arr)

1133 else do

1134 ptr <- go arrStart (INDEX_PREV(arrEnd,a))

1135− let pl = Array arrContents arrStart ptr ptr

1135+ let pl = MutArray arrContents arrStart ptr ptr

1136− pr = Array arrContents ptr arrEnd arrEnd

1136+ pr = MutArray arrContents ptr arrEnd arrEnd

1137 return (pl, pr)

1138

1139 where

1193--

1194-- /Unimplemented/

1195{-# INLINE shuffleBy #-}

1196−shuffleBy :: (a -> a -> m Bool) -> Array a -> Array a -> m ()

1196+shuffleBy :: (a -> a -> m Bool) -> MutArray a -> MutArray a -> m ()

1197shuffleBy = undefined

1198

1199-- XXX we can also make the folds partial by stopping at a certain level.

1209-- /Unimplemented/

1210{-# INLINABLE divideBy #-}

1211divideBy ::

1212− Int -> (Array a -> m (Array a, Array a)) -> Array a -> m ()

1212+ Int -> (MutArray a -> m (MutArray a, MutArray a)) -> MutArray a -> m ()

1213divideBy = undefined

1214

1215-- | @mergeBy level merge array@ performs a pairwise bottom up fold recursively

1221-- sort.

1222--

1223-- /Unimplemented/

1224−mergeBy :: Int -> (Array a -> Array a -> m ()) -> Array a -> m ()

1224+mergeBy :: Int -> (MutArray a -> MutArray a -> m ()) -> MutArray a -> m ()

1225mergeBy = undefined

1226

1227-------------------------------------------------------------------------------

1231-- | /O(1)/ Get the byte length of the array.

1232--

1233{-# INLINE byteLength #-}

1234−byteLength :: Array a -> Int

1234+byteLength :: MutArray a -> Int

1235−byteLength Array{..} =

1235+byteLength MutArray{..} =

1236 let len = arrEnd - arrStart

1237 in assert (len >= 0) len

1238

1247-- involves a costly division operation.

1248--

1249{-# INLINE length #-}

1250−length :: forall a. Unbox a => Array a -> Int

1250+length :: forall a. Unbox a => MutArray a -> Int

1251length arr =

1252 let elemSize = SIZE_OF(a)

1253 blen = byteLength arr

1258--

1259-- /Pre-release/

1260{-# INLINE byteCapacity #-}

1261−byteCapacity :: Array a -> Int

1261+byteCapacity :: MutArray a -> Int

1262−byteCapacity Array{..} =

1262+byteCapacity MutArray{..} =

1263 let len = arrBound - arrStart

1264 in assert (len >= 0) len

1265

1268--

1269-- /Pre-release/

1270{-# INLINE bytesFree #-}

1271−bytesFree :: Array a -> Int

1271+bytesFree :: MutArray a -> Int

1272−bytesFree Array{..} =

1272+bytesFree MutArray{..} =

1273 let n = arrBound - arrEnd

1274 in assert (n >= 0) n

1275

1287-- | @arraysOf n stream@ groups the input stream into a stream of

1288-- arrays of size n.

1289--

1290−-- @arraysOf n = StreamD.foldMany (Array.writeN n)@

1290+-- @arraysOf n = StreamD.foldMany (MutArray.writeN n)@

1291--

1292-- /Pre-release/

1293{-# INLINE_NORMAL arraysOf #-}

1294arraysOf :: forall m a. (MonadIO m, Unbox a)

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

1295+ => Int -> D.Stream m a -> D.Stream m (MutArray a)

1296-- XXX the idiomatic implementation leads to large regression in the D.reverse'

1297-- benchmark. It seems it has difficulty producing optimized code when

1298-- converting to StreamK. Investigate GHC optimizations.

1306 step' _ (GroupStart st) = do

1307 when (n <= 0) $

1308 -- XXX we can pass the module string from the higher level API

1309− error $ "Streamly.Internal.Data.Array.Mut.Type.arraysOf: "

1309+ error $ "Streamly.Internal.Data.MutArray.Mut.Type.arraysOf: "

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

1311 ++ "] must be a natural number"

1312− (Array contents start end bound :: Array a) <- liftIO $ newPinned n

1312+ (MutArray contents start end bound :: MutArray a) <- liftIO $ newPinned n

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

1314

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

1331 $ D.Skip (GroupYield contents start end bound GroupFinish)

1332

1333 step' _ (GroupYield contents start end bound next) =

1334− return $ D.Yield (Array contents start end bound) next

1334+ return $ D.Yield (MutArray contents start end bound) next

1335

1336 step' _ GroupFinish = return D.Stop

1337

1339-- | Buffer the stream into arrays in memory.

1340{-# INLINE arrayStreamKFromStreamD #-}

1341arrayStreamKFromStreamD :: forall m a. (MonadIO m, Unbox a) =>

1342− D.Stream m a -> m (K.Stream m (Array a))

1342+ D.Stream m a -> m (K.Stream m (MutArray a))

1343arrayStreamKFromStreamD =

1344 let n = allocBytesToElemCount (undefined :: a) defaultChunkSize

1345 in D.foldr K.cons K.nil . arraysOf n

1360--

1361{-# INLINE_NORMAL flattenArrays #-}

1362flattenArrays :: forall m a. (MonadIO m, Unbox a)

1363− => D.Stream m (Array a) -> D.Stream m a

1363+ => D.Stream m (MutArray a) -> D.Stream m a

1364flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)

1365

1366 where

1369 step' gst (OuterLoop st) = do

1370 r <- step (adaptState gst) st

1371 return $ case r of

1372− D.Yield Array{..} s ->

1372+ D.Yield MutArray{..} s ->

1373 D.Skip (InnerLoop s arrContents arrStart arrEnd)

1374 D.Skip s -> D.Skip (OuterLoop s)

1375 D.Stop -> D.Stop

1389--

1390{-# INLINE_NORMAL flattenArraysRev #-}

1391flattenArraysRev :: forall m a. (MonadIO m, Unbox a)

1392− => D.Stream m (Array a) -> D.Stream m a

1392+ => D.Stream m (MutArray a) -> D.Stream m a

1393flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)

1394

1395 where

1398 step' gst (OuterLoop st) = do

1399 r <- step (adaptState gst) st

1400 return $ case r of

1401− D.Yield Array{..} s ->

1401+ D.Yield MutArray{..} s ->

1402 let p = INDEX_PREV(arrEnd,a)

1403 in D.Skip (InnerLoop s arrContents p arrStart)

1404 D.Skip s -> D.Skip (OuterLoop s)

1421 {-# UNPACK #-} !Int -- index 1

1422 {-# UNPACK #-} !Int -- index 2

1423

1424−toArrayUnsafe :: Array a -> ArrayUnsafe a

1424+toArrayUnsafe :: MutArray a -> ArrayUnsafe a

1425−toArrayUnsafe (Array contents start end _) = ArrayUnsafe contents start end

1425+toArrayUnsafe (MutArray contents start end _) = ArrayUnsafe contents start end

1426

1427fromArrayUnsafe ::

1428#ifdef DEVBUILD

1429 Unbox a =>

1430#endif

1431− ArrayUnsafe a -> Array a

1431+ ArrayUnsafe a -> MutArray a

1432fromArrayUnsafe (ArrayUnsafe contents start end) =

1433− Array contents start end end

1433+ MutArray contents start end end

1434

1435{-# INLINE_NORMAL producerWith #-}

1436producerWith ::

1437 forall m a. (Monad m, Unbox a)

1438− => (forall b. IO b -> m b) -> Producer m (Array a) a

1438+ => (forall b. IO b -> m b) -> Producer m (MutArray a) a

1439producerWith liftio = Producer step (return . toArrayUnsafe) extract

1440 where

1441

1455-- | Resumable unfold of an array.

1456--

1457{-# INLINE_NORMAL producer #-}

1458−producer :: forall m a. (MonadIO m, Unbox a) => Producer m (Array a) a

1458+producer :: forall m a. (MonadIO m, Unbox a) => Producer m (MutArray a) a

1459producer = producerWith liftIO

1460

1461-- | Unfold an array into a stream.

1462--

1463{-# INLINE_NORMAL reader #-}

1464−reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (Array a) a

1464+reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a

1465reader = Producer.simplify producer

1466

1467{-# INLINE_NORMAL readerRevWith #-}

1468readerRevWith ::

1469 forall m a. (Monad m, Unbox a)

1470− => (forall b. IO b -> m b) -> Unfold m (Array a) a

1470+ => (forall b. IO b -> m b) -> Unfold m (MutArray a) a

1471readerRevWith liftio = Unfold step inject

1472 where

1473

1474− inject (Array contents start end _) =

1474+ inject (MutArray contents start end _) =

1475 let p = INDEX_PREV(end,a)

1476 in return $ ArrayUnsafe contents start p

1477

1484-- | Unfold an array into a stream in reverse order.

1485--

1486{-# INLINE_NORMAL readerRev #-}

1487−readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (Array a) a

1487+readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a

1488readerRev = readerRevWith liftIO

1489

1490-------------------------------------------------------------------------------

1495-- Use foldr/build fusion to fuse with list consumers

1496-- This can be useful when using the IsList instance

1497{-# INLINE_LATE toListFB #-}

1498−toListFB :: forall a b. Unbox a => (a -> b -> b) -> b -> Array a -> b

1498+toListFB :: forall a b. Unbox a => (a -> b -> b) -> b -> MutArray a -> b

1499−toListFB c n Array{..} = go arrStart

1499+toListFB c n MutArray{..} = go arrStart

1500 where

1501

1502 go p | assert (p <= arrEnd) (p == arrEnd) = n

1516

1517-- XXX Monadic foldr/build fusion?

1518-- Reference: https://www.researchgate.net/publication/220676509_Monadic_augment_and_generalised_short_cut_fusion

1519−-- | Convert an 'Array' into a list.

1519+-- | Convert an 'MutArray' into a list.

1520--

1521{-# INLINE toList #-}

1522−toList :: forall m a. (MonadIO m, Unbox a) => Array a -> m [a]

1522+toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]

1523−toList Array{..} = liftIO $ go arrStart

1523+toList MutArray{..} = liftIO $ go arrStart

1524 where

1525

1526 go p | assert (p <= arrEnd) (p == arrEnd) = return []

1531{-# INLINE_NORMAL toStreamDWith #-}

1532toStreamDWith ::

1533 forall m a. (Monad m, Unbox a)

1534− => (forall b. IO b -> m b) -> Array a -> D.Stream m a

1534+ => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a

1535−toStreamDWith liftio Array{..} = D.Stream step arrStart

1535+toStreamDWith liftio MutArray{..} = D.Stream step arrStart

1536

1537 where

1538

1548--

1549-- We can try this if the unfold has any performance issues.

1550{-# INLINE_NORMAL toStreamD #-}

1551−toStreamD :: forall m a. (MonadIO m, Unbox a) => Array a -> D.Stream m a

1551+toStreamD :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a

1552toStreamD = toStreamDWith liftIO

1553

1554{-# INLINE toStreamKWith #-}

1555toStreamKWith ::

1556 forall m a. (Monad m, Unbox a)

1557− => (forall b. IO b -> m b) -> Array a -> K.Stream m a

1557+ => (forall b. IO b -> m b) -> MutArray a -> K.Stream m a

1558−toStreamKWith liftio Array{..} = go arrStart

1558+toStreamKWith liftio MutArray{..} = go arrStart

1559

1560 where

1561

1565 in liftio elemM `K.consM` go (INDEX_NEXT(p,a))

1566

1567{-# INLINE toStreamK #-}

1568−toStreamK :: forall m a. (MonadIO m, Unbox a) => Array a -> K.Stream m a

1568+toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> K.Stream m a

1569toStreamK = toStreamKWith liftIO

1570

1571{-# INLINE_NORMAL toStreamDRevWith #-}

1572toStreamDRevWith ::

1573 forall m a. (Monad m, Unbox a)

1574− => (forall b. IO b -> m b) -> Array a -> D.Stream m a

1574+ => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a

1575−toStreamDRevWith liftio Array{..} =

1575+toStreamDRevWith liftio MutArray{..} =

1576 let p = INDEX_PREV(arrEnd,a)

1577 in D.Stream step p

1578

1590--

1591-- We can try this if the unfold has any perf issues.

1592{-# INLINE_NORMAL toStreamDRev #-}

1593−toStreamDRev :: forall m a. (MonadIO m, Unbox a) => Array a -> D.Stream m a

1593+toStreamDRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a

1594toStreamDRev = toStreamDRevWith liftIO

1595

1596{-# INLINE toStreamKRevWith #-}

1597toStreamKRevWith ::

1598 forall m a. (Monad m, Unbox a)

1599− => (forall b. IO b -> m b) -> Array a -> K.Stream m a

1599+ => (forall b. IO b -> m b) -> MutArray a -> K.Stream m a

1600−toStreamKRevWith liftio Array {..} =

1600+toStreamKRevWith liftio MutArray {..} =

1601 let p = INDEX_PREV(arrEnd,a)

1602 in go p

1603

1609 in liftio elemM `K.consM` go (INDEX_PREV(p,a))

1610

1611{-# INLINE toStreamKRev #-}

1612−toStreamKRev :: forall m a. (MonadIO m, Unbox a) => Array a -> K.Stream m a

1612+toStreamKRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> K.Stream m a

1613toStreamKRev = toStreamKRevWith liftIO

1614

1615-------------------------------------------------------------------------------

1616-- Folding

1617-------------------------------------------------------------------------------

1618

1619−-- XXX Need something like "Array m a" enforcing monadic action to avoid the

1619+-- XXX Need something like "MutArray m a" enforcing monadic action to avoid the

1620-- possibility of such APIs.

1621--

1622-- | Strict left fold of an array.

1623{-# INLINE_NORMAL foldl' #-}

1624−foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> Array a -> m b

1624+foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> MutArray a -> m b

1625foldl' f z arr = D.foldl' f z $ toStreamD arr

1626

1627-- | Right fold of an array.

1628{-# INLINE_NORMAL foldr #-}

1629−foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> Array a -> m b

1629+foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> MutArray a -> m b

1630foldr f z arr = D.foldr f z $ toStreamD arr

1631

1632-------------------------------------------------------------------------------

1652{-# INLINE_NORMAL writeAppendNUnsafe #-}

1653writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>

1654 Int

1655− -> m (Array a)

1655+ -> m (MutArray a)

1656− -> Fold m a (Array a)

1656+ -> Fold m a (MutArray a)

1657writeAppendNUnsafe n action =

1658 fmap fromArrayUnsafe $ FL.foldlM' step initial

1659

1661

1662 initial = do

1663 assert (n >= 0) (return ())

1664− arr@(Array _ _ end bound) <- action

1664+ arr@(MutArray _ _ end bound) <- action

1665 let free = bound - end

1666 needed = n * SIZE_OF(a)

1667 -- XXX We can also reallocate if the array has too much free space,

1679-- | Append @n@ elements to an existing array. Any free space left in the array

1680-- after appending @n@ elements is lost.

1681--

1682−-- >>> writeAppendN n initial = Fold.take n (Array.writeAppendNUnsafe n initial)

1682+-- >>> writeAppendN n initial = Fold.take n (MutArray.writeAppendNUnsafe n initial)

1683--

1684{-# INLINE_NORMAL writeAppendN #-}

1685writeAppendN :: forall m a. (MonadIO m, Unbox a) =>

1686− Int -> m (Array a) -> Fold m a (Array a)

1686+ Int -> m (MutArray a) -> Fold m a (MutArray a)

1687writeAppendN n initial = FL.take n (writeAppendNUnsafe n initial)

1688

1689-- | @writeAppendWith realloc action@ mutates the array generated by @action@ to

1693--

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

1695--

1696−-- >>> writeAppendWith sizer = Fold.foldlM' (Array.snocWith sizer)

1696+-- >>> writeAppendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)

1697--

1698-- /Pre-release/

1699{-# INLINE writeAppendWith #-}

1700writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>

1701− (Int -> Int) -> m (Array a) -> Fold m a (Array a)

1701+ (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)

1702writeAppendWith sizer = FL.foldlM' (snocWith sizer)

1703

1704-- | @append action@ mutates the array generated by @action@ to append the

1707--

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

1709--

1710−-- >>> writeAppend = Array.writeAppendWith (* 2)

1710+-- >>> writeAppend = MutArray.writeAppendWith (* 2)

1711--

1712{-# INLINE writeAppend #-}

1713writeAppend :: forall m a. (MonadIO m, Unbox a) =>

1714− m (Array a) -> Fold m a (Array a)

1714+ m (MutArray a) -> Fold m a (MutArray a)

1715writeAppend = writeAppendWith (* 2)

1716

1717-- XXX We can carry bound as well in the state to make sure we do not lose the

1720-- | Like 'writeNUnsafe' but takes a new array allocator @alloc size@ function

1721-- as argument.

1722--

1723−-- >>> writeNWithUnsafe alloc n = Array.writeAppendNUnsafe (alloc n) n

1723+-- >>> writeNWithUnsafe alloc n = MutArray.writeAppendNUnsafe (alloc n) n

1724--

1725-- /Pre-release/

1726{-# INLINE_NORMAL writeNWithUnsafe #-}

1727writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)

1728− => (Int -> m (Array a)) -> Int -> Fold m a (Array a)

1728+ => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)

1729writeNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial

1730

1731 where

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

1744-- slowdown.

1745--

1746−-- >>> writeNUnsafe = Array.writeNWithUnsafe Array.newPinned

1746+-- >>> writeNUnsafe = MutArray.writeNWithUnsafe MutArray.newPinned

1747--

1748{-# INLINE_NORMAL writeNUnsafe #-}

1749writeNUnsafe :: forall m a. (MonadIO m, Unbox a)

1750− => Int -> Fold m a (Array a)

1750+ => Int -> Fold m a (MutArray a)

1751writeNUnsafe = writeNWithUnsafe newPinned

1752

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

1754-- allocated using the @alloc@ function.

1755--

1756−-- >>> writeNWith alloc n = Fold.take n (Array.writeNWithUnsafe alloc n)

1756+-- >>> writeNWith alloc n = Fold.take n (MutArray.writeNWithUnsafe alloc n)

1757−-- >>> writeNWith alloc n = Array.writeAppendN (alloc n) n

1757+-- >>> writeNWith alloc n = MutArray.writeAppendN (alloc n) n

1758--

1759{-# INLINE_NORMAL writeNWith #-}

1760writeNWith :: forall m a. (MonadIO m, Unbox a)

1761− => (Int -> m (Array a)) -> Int -> Fold m a (Array a)

1761+ => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)

1762writeNWith alloc n = FL.take n (writeNWithUnsafe alloc n)

1763

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

1765−-- 'Array'.

1765+-- 'MutArray'.

1766--

1767−-- >>> writeN = Array.writeNWith Array.newPinned

1767+-- >>> writeN = MutArray.writeNWith MutArray.newPinned

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

1768+-- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)

1769−-- >>> writeN n = Array.writeAppendN n (Array.newPinned n)

1769+-- >>> writeN n = MutArray.writeAppendN n (MutArray.newPinned n)

1770--

1771{-# INLINE_NORMAL writeN #-}

1772−writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)

1772+writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)

1773writeN = writeNWith newPinned

1774

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

1777-- /Internal/

1778{-# INLINE_NORMAL writeRevNWithUnsafe #-}

1779writeRevNWithUnsafe :: forall m a. (MonadIO m, Unbox a)

1780− => (Int -> m (Array a)) -> Int -> Fold m a (Array a)

1780+ => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)

1781writeRevNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial

1782

1783 where

1784

1785− toArrayUnsafeRev (Array contents _ _ bound) =

1785+ toArrayUnsafeRev (MutArray contents _ _ bound) =

1786 ArrayUnsafe contents bound bound

1787

1788 initial = toArrayUnsafeRev <$> alloc (max n 0)

1798-- /Internal/

1799{-# INLINE_NORMAL writeRevNWith #-}

1800writeRevNWith :: forall m a. (MonadIO m, Unbox a)

1801− => (Int -> m (Array a)) -> Int -> Fold m a (Array a)

1801+ => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)

1802writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)

1803

1804-- | Like writeN but writes the array in reverse order.

1805--

1806-- /Pre-release/

1807{-# INLINE_NORMAL writeRevN #-}

1808−writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)

1808+writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)

1809writeRevN = writeRevNWith newPinned

1810

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

1812−-- stream to an 'Array' aligned to the given size.

1812+-- stream to an 'MutArray' aligned to the given size.

1813--

1814−-- >>> writeNAligned align = Array.writeNWith (Array.newAlignedPinned align)

1814+-- >>> writeNAligned align = MutArray.writeNWith (MutArray.newAlignedPinned align)

1815−-- >>> writeNAligned align n = Array.writeAppendN n (Array.newAlignedPinned align n)

1815+-- >>> writeNAligned align n = MutArray.writeAppendN n (MutArray.newAlignedPinned align n)

1816--

1817-- /Pre-release/

1818--

1819{-# INLINE_NORMAL writeNAligned #-}

1820writeNAligned :: forall m a. (MonadIO m, Unbox a)

1821− => Int -> Int -> Fold m a (Array a)

1821+ => Int -> Int -> Fold m a (MutArray a)

1822writeNAligned align = writeNWith (newAlignedPinned align)

1823

1824-- XXX Buffer to a list instead?

1825--

1826-- | Buffer a stream into a stream of arrays.

1827--

1828−-- >>> writeChunks n = Fold.many (Array.writeN n) Fold.toStreamK

1828+-- >>> writeChunks n = Fold.many (MutArray.writeN n) Fold.toStreamK

1829--

1830-- Breaking an array into an array stream can be useful to consume a large

1831-- array sequentially such that memory of the array is released incrementatlly.

1836--

1837{-# INLINE_NORMAL writeChunks #-}

1838writeChunks :: (MonadIO m, Unbox a) =>

1839− Int -> Fold m a (K.Stream n (Array a))

1839+ Int -> Fold m a (K.Stream n (MutArray a))

1840writeChunks n = FL.many (writeN n) FL.toStreamK

1841

1842-- XXX Compare writeWith with fromStreamD which uses an array of streams

1862--

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

1864--

1865−-- >>> f n = Array.writeAppendWith (* 2) (Array.newPinned n)

1865+-- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.newPinned n)

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

1866+-- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)

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

1867+-- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)

1868--

1869-- /Pre-release/

1870{-# INLINE_NORMAL writeWith #-}

1871writeWith :: forall m a. (MonadIO m, Unbox a)

1872− => Int -> Fold m a (Array a)

1872+ => Int -> Fold m a (MutArray a)

1873-- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (newPinned n)

1874writeWith elemCount =

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

1876

1877 where

1878

1879− insertElem (Array contents start end bound) x = do

1879+ insertElem (MutArray contents start end bound) x = do

1880 liftIO $ pokeWith contents end x

1881− return $ Array contents start (INDEX_NEXT(end,a)) bound

1881+ return $ MutArray contents start (INDEX_NEXT(end,a)) bound

1882

1883 initial = do

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

1885 liftIO $ newPinned elemCount

1886− step arr@(Array _ start end bound) x

1886+ step arr@(MutArray _ start end bound) x

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

1888 let oldSize = end - start

1889 newSize = max (oldSize * 2) 1

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

1901--

1902{-# INLINE write #-}

1903−write :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)

1903+write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)

1904write = writeWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)

1905

1906-------------------------------------------------------------------------------

1909

1910-- | Use the 'writeN' fold instead.

1911--

1912−-- >>> fromStreamDN n = StreamD.fold (Array.writeN n)

1912+-- >>> fromStreamDN n = StreamD.fold (MutArray.writeN n)

1913--

1914{-# INLINE_NORMAL fromStreamDN #-}

1915fromStreamDN :: forall m a. (MonadIO m, Unbox a)

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

1916+ => Int -> D.Stream m a -> m (MutArray a)

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

1918fromStreamDN limit str = do

1919− (arr :: Array a) <- liftIO $ newPinned limit

1919+ (arr :: MutArray a) <- liftIO $ newPinned limit

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

1921 return $ arr {arrEnd = end}

1922

1926 liftIO $ pokeWith arrContents ptr x

1927 return $ INDEX_NEXT(ptr,a)

1928

1929−-- | Create an 'Array' from the first N elements of a list. The array is

1929+-- | Create an 'MutArray' from the first N elements of a list. The array is

1930-- allocated to size N, if the list terminates before N elements then the

1931-- array may hold less than N elements.

1932--

1933{-# INLINABLE fromListN #-}

1934−fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (Array a)

1934+fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)

1935fromListN n xs = fromStreamDN n $ D.fromList xs

1936

1937-- | Like fromListN but writes the array in reverse order.

1938--

1939-- /Pre-release/

1940{-# INLINE fromListRevN #-}

1941−fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (Array a)

1941+fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)

1942fromListRevN n xs = D.fold (writeRevN n) $ D.fromList xs

1943

1944-------------------------------------------------------------------------------

1946-------------------------------------------------------------------------------

1947

1948{-# INLINE arrayStreamKLength #-}

1949−arrayStreamKLength :: (Monad m, Unbox a) => K.Stream m (Array a) -> m Int

1949+arrayStreamKLength :: (Monad m, Unbox a) => K.Stream m (MutArray a) -> m Int

1950arrayStreamKLength as = K.foldl' (+) 0 (K.map length as)

1951

1952-- | Convert an array stream to an array. Note that this requires peak memory

1954--

1955{-# INLINE fromArrayStreamK #-}

1956fromArrayStreamK :: (Unbox a, MonadIO m) =>

1957− K.Stream m (Array a) -> m (Array a)

1957+ K.Stream m (MutArray a) -> m (MutArray a)

1958fromArrayStreamK as = do

1959 len <- arrayStreamKLength as

1960 fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as

1970-- the chunking approach. However, if we have to shrink in the end then it may

1971-- result in an extra copy of the entire data.

1972--

1973−-- >>> fromStreamD = StreamD.fold Array.write

1973+-- >>> fromStreamD = StreamD.fold MutArray.write

1974--

1975{-# INLINE fromStreamD #-}

1976−fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (Array a)

1976+fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)

1977fromStreamD m = arrayStreamKFromStreamD m >>= fromArrayStreamK

1978

1979−-- | Create an 'Array' from a list. The list must be of finite size.

1979+-- | Create an 'MutArray' from a list. The list must be of finite size.

1980--

1981{-# INLINE fromList #-}

1982−fromList :: (MonadIO m, Unbox a) => [a] -> m (Array a)

1982+fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)

1983fromList xs = fromStreamD $ D.fromList xs

1984

1985-- XXX We are materializing the whole list first for getting the length. Check

1987

1988-- | Like 'fromList' but writes the contents of the list in reverse order.

1989{-# INLINE fromListRev #-}

1990−fromListRev :: (MonadIO m, Unbox a) => [a] -> m (Array a)

1990+fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)

1991fromListRev xs = fromListRevN (Prelude.length xs) xs

1992

1993-------------------------------------------------------------------------------

1997-- | Put a sub range of a source array into a subrange of a destination array.

1998-- This is not safe as it does not check the bounds.

1999{-# INLINE putSliceUnsafe #-}

2000−putSliceUnsafe :: MonadIO m => Array a -> Int -> Array a -> Int -> Int -> m ()

2000+putSliceUnsafe :: MonadIO m => MutArray a -> Int -> MutArray a -> Int -> Int -> m ()

2001putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do

2002 assertM(lenBytes <= arrBound dst - dstStartBytes)

2003 assertM(lenBytes <= arrEnd src - srcStartBytes)

2016#ifdef DEVBUILD

2017 Unbox a =>

2018#endif

2019− Array a -> Array a -> m (Array a)

2019+ MutArray a -> MutArray a -> m (MutArray a)

2020spliceCopy arr1 arr2 = liftIO $ do

2021 let start1 = arrStart arr1

2022 start2 = arrStart arr2

2024 len2 = arrEnd arr2 - start2

2025 newArrContents <- liftIO $ Unboxed.newPinnedBytes (len1 + len2)

2026 let len = len1 + len2

2027− newArr = Array newArrContents 0 len len

2027+ newArr = MutArray newArrContents 0 len len

2028 putSliceUnsafe arr1 start1 newArr 0 len1

2029 putSliceUnsafe arr2 start2 newArr len1 len2

2030 return newArr

2034-- corruption or if you are lucky a segfault.

2035{-# INLINE spliceUnsafe #-}

2036spliceUnsafe :: MonadIO m =>

2037− Array a -> Array a -> m (Array a)

2037+ MutArray a -> MutArray a -> m (MutArray a)

2038spliceUnsafe dst src =

2039 liftIO $ do

2040 let startSrc = arrStart src

2054-- /Pre-release/

2055{-# INLINE spliceWith #-}

2056spliceWith :: forall m a. (MonadIO m, Unbox a) =>

2057− (Int -> Int -> Int) -> Array a -> Array a -> m (Array a)

2057+ (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)

2058−spliceWith sizer dst@(Array _ start end bound) src = do

2058+spliceWith sizer dst@(MutArray _ start end bound) src = do

2059{-

2060 let f = writeAppendWith (`sizer` byteLength src) (return dst)

2061 in D.fold f (toStreamD src)

2083--

2084-- Note that the returned array may be a mutated version of first array.

2085--

2086−-- >>> splice = Array.spliceWith (+)

2086+-- >>> splice = MutArray.spliceWith (+)

2087--

2088-- /Pre-release/

2089{-# INLINE splice #-}

2090−splice :: (MonadIO m, Unbox a) => Array a -> Array a -> m (Array a)

2090+splice :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)

2091splice = spliceWith (+)

2092

2093-- | Like 'append' but the growth of the array is exponential. Whenever a new

2097--

2098-- Note that the returned array may be a mutated version of first array.

2099--

2100−-- >>> spliceExp = Array.spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))

2100+-- >>> spliceExp = MutArray.spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))

2101--

2102-- /Pre-release/

2103{-# INLINE spliceExp #-}

2104−spliceExp :: (MonadIO m, Unbox a) => Array a -> Array a -> m (Array a)

2104+spliceExp :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)

2105spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))

2106

2107-------------------------------------------------------------------------------

2111-- | Drops the separator byte

2112{-# INLINE breakOn #-}

2113breakOn :: MonadIO m

2114− => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))

2114+ => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))

2115−breakOn sep arr@Array{..} = asPtrUnsafe arr $ \p -> liftIO $ do

2115+breakOn sep arr@MutArray{..} = asPtrUnsafe arr $ \p -> liftIO $ do

2116 -- XXX Instead of using asPtrUnsafe (pinning memory) we can pass unlifted

2117 -- Addr# to memchr and it should be safe (from ghc 8.4).

2118 -- XXX We do not need memchr here, we can use a Haskell equivalent.

2122 if loc == nullPtr

2123 then (arr, Nothing)

2124 else

2125− ( Array

2125+ ( MutArray

2126 { arrContents = arrContents

2127 , arrStart = arrStart

2128 , arrEnd = arrStart + sepIndex -- exclude the separator

2129 , arrBound = arrStart + sepIndex

2130 }

2131− , Just $ Array

2131+ , Just $ MutArray

2132 { arrContents = arrContents

2133 , arrStart = arrStart + (sepIndex + 1)

2134 , arrEnd = arrEnd

2139-- | Create two slices of an array without copying the original array. The

2140-- specified index @i@ is the first index of the second slice.

2141--

2142−splitAt :: forall a. Unbox a => Int -> Array a -> (Array a, Array a)

2142+splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)

2143−splitAt i arr@Array{..} =

2143+splitAt i arr@MutArray{..} =

2144 let maxIndex = length arr - 1

2145 in if i < 0

2146 then error "sliceAt: negative array index"

2149 ++ " is beyond the maximum index " ++ show maxIndex

2150 else let off = i * SIZE_OF(a)

2151 p = arrStart + off

2152− in ( Array

2152+ in ( MutArray

2153 { arrContents = arrContents

2154 , arrStart = arrStart

2155 , arrEnd = p

2156 , arrBound = p

2157 }

2158− , Array

2158+ , MutArray

2159 { arrContents = arrContents

2160 , arrStart = p

2161 , arrEnd = arrEnd

2178#ifdef DEVBUILD

2179 Unbox b =>

2180#endif

2181− Array a -> Array b

2181+ MutArray a -> MutArray b

2182−castUnsafe (Array contents start end bound) =

2182+castUnsafe (MutArray contents start end bound) =

2183− Array contents start end bound

2183+ MutArray contents start end bound

2184

2185−-- | Cast an @Array a@ into an @Array Word8@.

2185+-- | Cast an @MutArray a@ into an @MutArray Word8@.

2186--

2187−asBytes :: Array a -> Array Word8

2187+asBytes :: MutArray a -> MutArray Word8

2188asBytes = castUnsafe

2189

2190-- | Cast an array having elements of type @a@ into an array having elements of

2191-- type @b@. The length of the array should be a multiple of the size of the

2192-- target element otherwise 'Nothing' is returned.

2193--

2194−cast :: forall a b. Unbox b => Array a -> Maybe (Array b)

2194+cast :: forall a b. Unbox b => MutArray a -> Maybe (MutArray b)

2195cast arr =

2196 let len = byteLength arr

2197 r = len `mod` SIZE_OF(b)

2216-- asPtr, the unsafety is implicit for any pointer operations. And we are safe

2217-- from Haskell perspective because we will be pinning the memory.

2218

2219−-- | Use an @Array a@ as @Ptr a@. This is useful when we want to pass an array

2219+-- | Use an @MutArray a@ as @Ptr a@. This is useful when we want to pass an array

2220-- as a pointer to some operating system call or to a "safe" FFI call.

2221--

2222-- If the array is not pinned it is copied to pinned memory before passing it

2231--

2232-- /Pre-release/

2233--

2234−asPtrUnsafe :: MonadIO m => Array a -> (Ptr a -> m b) -> m b

2234+asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b

2235asPtrUnsafe arr f = do

2236 let contents = arrContents arr

2237 !ptr = Ptr (byteArrayContents#

2252--

2253-- /Pre-release/

2254{-# INLINE cmp #-}

2255−cmp :: MonadIO m => Array a -> Array a -> m Ordering

2255+cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering

2256cmp arr1 arr2 =

2257 liftIO

2258 $ do

2285-- /Pre-release/

2286{-# INLINE strip #-}

2287strip :: forall a m. (Unbox a, MonadIO m) =>

2288− (a -> Bool) -> Array a -> m (Array a)

2288+ (a -> Bool) -> MutArray a -> m (MutArray a)

2289−strip eq arr@Array{..} = liftIO $ do

2289+strip eq arr@MutArray{..} = liftIO $ do

2290 st <- getStart arrStart

2291 end <- getLast arrEnd st

2292 return arr {arrStart = st, arrEnd = end, arrBound = end}

2328--

2329-- /Pre-release/

2330{-# INLINE bubble #-}

2331−bubble :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> Array a -> m ()

2331+bubble :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> MutArray a -> m ()

2332bubble cmp0 arr =

2333 when (l > 1) $ do

2334 x <- getIndexUnsafe (l - 1) arr