@@ -28,57 +28,80 @@
29module Streamly.Internal.Data.MutArray.Type
29module Streamly.Internal.Data.MutArray.Type
31− -- * Type
31+ -- ** Type
32 -- $arrayNotes
32 -- $arrayNotes
33 MutArray (..)
33 MutArray (..)
34− , MutableByteArray
34+
35− , touch
35+ -- ** Conversion
36+ -- *** Pinned and Unpinned
38 , isPinned
39 , isPinned
40− -- * Constructing and Writing
41+ -- ** Casting
41− -- ** Construction
42+ , cast
42− , nil
43+ , castUnsafe -- XXX unsafeCast
44− -- *** Uninitialized Arrays
48+ -- ** Construction
45− , pinnedNew
49+ , empty
52+ -- | New arrays are always empty arrays with some reserve capacity to
53+ -- extend the length without reallocating.
55+ , newArrayWith -- emptyAlignedWith
47− , pinnedNewAligned
57+ , pinnedNewAligned -- XXX not required
48− , new
58+ -- , new -- uninitialized array of specified length
65+ -- | Get a subarray without copying
66+ , getSliceUnsafe -- XXX unsafeGetSlice
68+ , splitAt -- XXX should be able to express using getSlice
51− -- *** From streams
71+ -- *** Stream Folds
52 , ArrayUnsafe (..)
72 , ArrayUnsafe (..)
53− , writeNWithUnsafe
73+ , unsafeCreateOfWith
54− , writeNWith
74+ , unsafeCreateOf
55− , writeNUnsafe
75+ , unsafePinnedCreateOf
56− , pinnedWriteNUnsafe
76+ , pinnedCreateOf
57− , writeN
77+ , createOfWith
58− , pinnedWriteN
78+ , createOf
59− , pinnedWriteNAligned
79+ , revCreateOf
61− , writeWith
81+ , pinnedCreate
62− , write
82+ , createWith
63− , pinnedWrite
83+ , create
68− -- ** From containers
86+ -- *** From containers
69 , fromListN
87 , fromListN
70 , pinnedFromListN
88 , pinnedFromListN
71 , fromList
89 , fromList
72 , pinnedFromList
90 , pinnedFromList
73 , fromListRevN
91 , fromListRevN
74 , fromListRev
92 , fromListRev
75− , fromStreamDN
93+ , fromStreamN
76− , fromStreamD
94+ , fromStream
77 , fromPureStream
96 , fromPureStream
100+ , fromChunksRealloced -- fromSmallChunks
79− -- * Random writes
102+ -- ** Random writes
80 , putIndex
103 , putIndex
81− , putIndexUnsafe
104+ , putIndexUnsafe -- XXX unsafePutIndex
82 , putIndices
105 , putIndices
83 -- , putFromThenTo
106 -- , putFromThenTo
84 -- , putFrom -- start writing at the given position
107 -- , putFrom -- start writing at the given position
@@ -86,78 +109,71 @@ module Streamly.Internal.Data.MutArray.Type
86 -- , putFromTo
109 -- , putFromTo
87 -- , putFromRev
110 -- , putFromRev
88 -- , putUptoRev
111 -- , putUptoRev
89− , modifyIndexUnsafe
112+ , modifyIndexUnsafe -- XXX unsafeModifyIndex
90 , modifyIndex
113 , modifyIndex
91 , modifyIndices
114 , modifyIndices
93 , swapIndices
116 , swapIndices
94 , unsafeSwapIndices
117 , unsafeSwapIndices
96− -- * Growing and Shrinking
119+ -- ** Reading
97− -- Arrays grow only at the end, though it is possible to grow on both sides
98− -- and therefore have a cons as well as snoc. But that will require two
99− -- bounds in the array representation.
101− -- ** Appending elements
121+ -- *** Indexing
102− , snocWith
122+ , getIndex
103− , snoc
123+ , getIndexUnsafe -- XXX unsafeGetIndex
104− , snocLinear
124+ -- , getFromThenTo
105− , snocMay
125+ , getIndexRev -- getRevIndex?
106− , snocUnsafe
126+ , indexReader
107−
127+ , indexReaderWith
108− -- ** Appending streams
109− , writeAppendNUnsafe
114− -- * Eliminating and Reading
121− -- ** To containers
129+ -- *** To Streams
127 , readRev
131 , readRev
128 , toStreamK
134 , toStreamK
129 , toStreamKRev
136 , toStreamKRev
139+ -- *** To Containers
132 -- experimental
143 -- experimental
133 , producerWith
144 , producerWith
134 , producer
145 , producer
136− -- ** Random reads
147+ , reader
137− , getIndex
148+ , readerRevWith
138− , getIndexUnsafe
149+ , readerRev
144− -- * Memory Management
147− , allocBytesToElemCount
151+ -- ** Size and Capacity
153− -- * Size
152+ -- *** Size
155 , byteLength
154 , byteLength
156 -- , capacity
157 -- , capacity
157 , byteCapacity
158 , byteCapacity
158 , bytesFree
159 , bytesFree
161+ -- *** Capacity Management
164+ , allocBytesToElemCount
165+ , realloc -- this is "resize"
160− -- * In-place Mutation Algorithms
176+ -- ** In-place Mutation Algorithms
162 , reverse
178 , reverse
163 , permute
179 , permute
@@ -167,59 +183,121 @@ module Streamly.Internal.Data.MutArray.Type
167 , mergeBy
183 , mergeBy
170− -- * Casting
186+ -- ** Growing and Shrinking
171− , cast
187+ -- | Arrays grow only at the end, though it is possible to grow on both
172− , castUnsafe
188+ -- sides and therefore have a cons as well as snoc. But that will require
173− , asBytes
189+ -- both lower and upper bound in the array representation.
181− -- * Arrays of arrays
182− -- We can add dimensionality parameter to the array type to get
183− -- multidimensional arrays. Multidimensional arrays would just be a
184− -- convenience wrapper on top of single dimensional arrays.
186− -- | Operations dealing with multiple arrays, streams of arrays or
187− -- multidimensional array representations.
189− -- ** Construct from streams
191+ -- *** Appending elements
190− , chunksOf
192+ , snocWith
191− , pinnedChunksOf
193+ , snoc
192− , writeChunks
194+ , snocLinear
194− -- ** Eliminate to streams
196+ , snocUnsafe -- XXX unsafeSnoc
199− -- ** Construct from arrays
198+ -- *** Appending streams
200− -- get chunks without copying
199+ , unsafeAppendN
201− , getSliceUnsafe
200+ , appendN
202− , getSlice
201+ , appendWith
203− -- , getSlicesFromLenN
202+ , append
204− , splitAt -- XXX should be able to express using getSlice
207− -- ** Appending arrays
204+ -- *** Appending arrays
208 , spliceCopy
205 , spliceCopy
209 , spliceWith
206 , spliceWith
211 , spliceExp
208 , spliceExp
212− , spliceUnsafe
209+ , spliceUnsafe -- XXX unsafeSplice
214 -- , putSlice
210 -- , putSlice
215 -- , appendSlice
211 -- , appendSlice
216 -- , appendSliceFrom
212 -- , appendSliceFrom
214+ -- ** Serialization using Unbox
217+ , pokeSkipUnsafe -- unsafePokeSkip
219+ -- ** Deserialization using Unbox
221+ , peekUnconsUnsafe -- unsafePeekUncons
222+ , peekSkipUnsafe -- unsafePeekSkip
225+ -- We can add dimensionality parameter to the array type to get
226+ -- multidimensional arrays. Multidimensional arrays would just be a
227+ -- convenience wrapper on top of single dimensional arrays.
229+ -- ** Streams of Arrays
231+ -- | Group a stream into arrays.
237+ -- | Split an array into slices.
239+ -- , getSlicesFromLenN
244+ -- | Append the arrays in a stream to form a stream of elements.
251+ -- | Append the arrays in a stream to form a stream of larger arrays.
218− -- * Utilities
263+ -- ** Utilities
219 , roundUpToPower2
264 , roundUpToPower2
222 , c_memchr
267 , c_memchr
286+ , writeAppendNUnsafe
293+ , pinnedWriteNUnsafe
296+ , pinnedWriteNAligned -- XXX not required
@@ -230,48 +308,52 @@ where
231import Control.Monad (when, void)
309import Control.Monad (when, void)
232import Control.Monad.IO.Class (MonadIO(..))
310import Control.Monad.IO.Class (MonadIO(..))
311+import Data.Bifunctor (first)
233import Data.Bits (shiftR, (.|.), (.&.))
312import Data.Bits (shiftR, (.|.), (.&.))
234import Data.Functor.Identity (Identity(..))
313import Data.Functor.Identity (Identity(..))
235import Data.Proxy (Proxy(..))
314import Data.Proxy (Proxy(..))
236import Data.Word (Word8)
315import Data.Word (Word8)
237import Foreign.C.Types (CSize(..), CInt(..))
316import Foreign.C.Types (CSize(..), CInt(..))
238import Foreign.Ptr (plusPtr, minusPtr, nullPtr)
317import Foreign.Ptr (plusPtr, minusPtr, nullPtr)
239−import Streamly.Internal.Data.Unbox
318+import Streamly.Internal.Data.MutByteArray.Type
240− ( MutableByteArray(..)
319+ ( MutByteArray(..)
242 , PinnedState(..)
320 , PinnedState(..)
243 , getMutableByteArray#
321 , getMutableByteArray#
244− , touch
322+ , putSliceUnsafe
324+import Streamly.Internal.Data.Unbox (Unbox(..))
246import GHC.Base
325import GHC.Base
248 , Int(..)
327 , Int(..)
249− , byteArrayContents#
250 , compareByteArrays#
328 , compareByteArrays#
251 , copyMutableByteArray#
329 , copyMutableByteArray#
253import GHC.Base (noinline)
331import GHC.Base (noinline)
254−import GHC.Exts (unsafeCoerce#)
332+import GHC.Exts (unsafeCoerce#, Addr#)
255import GHC.Ptr (Ptr(..))
333import GHC.Ptr (Ptr(..))
257import Streamly.Internal.Data.Fold.Type (Fold(..))
335import Streamly.Internal.Data.Fold.Type (Fold(..))
258import Streamly.Internal.Data.Producer.Type (Producer (..))
336import Streamly.Internal.Data.Producer.Type (Producer (..))
259−import Streamly.Internal.Data.Stream.StreamD.Type (Stream)
337+import Streamly.Internal.Data.Stream.Type (Stream)
260−import Streamly.Internal.Data.Stream.StreamK.Type (StreamK)
338+import Streamly.Internal.Data.Parser.Type (Parser (..))
339+import Streamly.Internal.Data.StreamK.Type (StreamK)
261import Streamly.Internal.Data.SVar.Type (adaptState, defState)
340import Streamly.Internal.Data.SVar.Type (adaptState, defState)
341+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
262import Streamly.Internal.Data.Unfold.Type (Unfold(..))
342import Streamly.Internal.Data.Unfold.Type (Unfold(..))
263import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)
343import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)
265import qualified Streamly.Internal.Data.Fold.Type as FL
345import qualified Streamly.Internal.Data.Fold.Type as FL
346+import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed
347+import qualified Streamly.Internal.Data.Parser.Type as Parser
348+-- import qualified Streamly.Internal.Data.Fold.Type as Fold
266import qualified Streamly.Internal.Data.Producer as Producer
349import qualified Streamly.Internal.Data.Producer as Producer
267−import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
350+import qualified Streamly.Internal.Data.Stream.Type as D
268−import qualified Streamly.Internal.Data.Stream.StreamD.Lift as D
351+import qualified Streamly.Internal.Data.Stream.Lift as D
269−import qualified Streamly.Internal.Data.Stream.StreamK.Type as K
352+import qualified Streamly.Internal.Data.StreamK.Type as K
270−import qualified Streamly.Internal.Data.Unbox as Unboxed
271import qualified Prelude
353import qualified Prelude
273import Prelude hiding
355import Prelude hiding
274− (Foldable(..), read, unlines, splitAt, reverse, truncate)
356+ (Foldable(..), concat, read, unlines, splitAt, reverse, truncate)
276#include "DocTestDataMutArray.hs"
358#include "DocTestDataMutArray.hs"
@@ -279,6 +361,7 @@ import Prelude hiding
279-- Foreign helpers
361-- Foreign helpers
280-------------------------------------------------------------------------------
362-------------------------------------------------------------------------------
364+-- NOTE: Have to be "ccall unsafe" so that we can pass unpinned memory to these
282foreign import ccall unsafe "string.h memcpy" c_memcpy
365foreign import ccall unsafe "string.h memcpy" c_memcpy
283 :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
366 :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
@@ -288,6 +371,9 @@ foreign import ccall unsafe "string.h memchr" c_memchr
288foreign import ccall unsafe "string.h memcmp" c_memcmp
371foreign import ccall unsafe "string.h memcmp" c_memcmp
289 :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
372 :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
374+foreign import ccall unsafe "string.h strlen" c_strlen
375+ :: Ptr Word8 -> IO CSize
291-- | Given an 'Unboxed' type (unused first arg) and a number of bytes, return
377-- | Given an 'Unboxed' type (unused first arg) and a number of bytes, return
292-- how many elements of that type will completely fit in those bytes.
378-- how many elements of that type will completely fit in those bytes.
@@ -342,7 +428,7 @@ data MutArray a =
342 -- The array is a range into arrContents. arrContents may be a superset of
428 -- The array is a range into arrContents. arrContents may be a superset of
343 -- the slice represented by the array. All offsets are in bytes.
429 -- the slice represented by the array. All offsets are in bytes.
345− { arrContents :: {-# UNPACK #-} !MutableByteArray
431+ { arrContents :: {-# UNPACK #-} !MutByteArray
346 , arrStart :: {-# UNPACK #-} !Int -- ^ index into arrContents
432 , arrStart :: {-# UNPACK #-} !Int -- ^ index into arrContents
347 , arrEnd :: {-# UNPACK #-} !Int -- ^ index into arrContents
433 , arrEnd :: {-# UNPACK #-} !Int -- ^ index into arrContents
348 -- Represents the first invalid index of
434 -- Represents the first invalid index of
@@ -354,22 +440,25 @@ data MutArray a =
354-- Pinning & Unpinning
440-- Pinning & Unpinning
355-------------------------------------------------------------------------------
441-------------------------------------------------------------------------------
357−-- | Copy the 'MutArray' to pinned memory if unpinned, else do nothing. The
443+-- | Return a copy of the array in pinned memory if unpinned, else return the
358−-- overhead is a copy if the input array is unpinned.
444+-- original array.
359{-# INLINE pin #-}
445{-# INLINE pin #-}
360pin :: MutArray a -> IO (MutArray a)
446pin :: MutArray a -> IO (MutArray a)
361−pin arr@MutArray{..} = do
447+pin arr@MutArray{..} =
362− contents <- Unboxed.pin arrContents
448+ if Unboxed.isPinned arrContents
363− return $ arr {arrContents = contents}
449+ then pure arr
450+ else pinnedClone arr
365−-- | Copy the 'MutArray' to unpinned memory if pinned, else do nothing. The
452+-- | Return a copy of the array in unpinned memory if pinned, else return the
366−-- overhead is a copy if the input array is pinned.
453+-- original array.
367{-# INLINE unpin #-}
454{-# INLINE unpin #-}
368unpin :: MutArray a -> IO (MutArray a)
455unpin :: MutArray a -> IO (MutArray a)
369−unpin arr@MutArray{..} = do
456+unpin arr@MutArray{..} =
370− contents <- Unboxed.unpin arrContents
457+ if Unboxed.isPinned arrContents
371− return $ arr {arrContents = contents}
458+ then clone arr
461+-- | Return 'True' if the array is allocated in pinned memory.
373{-# INLINE isPinned #-}
462{-# INLINE isPinned #-}
374isPinned :: MutArray a -> Bool
463isPinned :: MutArray a -> Bool
375isPinned MutArray{..} = Unboxed.isPinned arrContents
464isPinned MutArray{..} = Unboxed.isPinned arrContents
@@ -390,6 +479,8 @@ isPinned MutArray{..} = Unboxed.isPinned arrContents
390-- we need more than that. See stg_pinnedNewAlignedByteArrayzh and
479-- we need more than that. See stg_pinnedNewAlignedByteArrayzh and
391-- allocatePinned in GHC source.
480-- allocatePinned in GHC source.
482+-- XXX Rename to emptyAlignedWith, alignSize should be first arg.
393-- | @newArrayWith allocator alignment count@ allocates a new array of zero
484-- | @newArrayWith allocator alignment count@ allocates a new array of zero
394-- length and with a capacity to hold @count@ elements, using @allocator
485-- length and with a capacity to hold @count@ elements, using @allocator
395-- size alignment@ as the memory allocator function.
486-- size alignment@ as the memory allocator function.
@@ -402,7 +493,7 @@ isPinned MutArray{..} = Unboxed.isPinned arrContents
402-- /Pre-release/
493-- /Pre-release/
403{-# INLINE newArrayWith #-}
494{-# INLINE newArrayWith #-}
404newArrayWith :: forall m a. (MonadIO m, Unbox a)
495newArrayWith :: forall m a. (MonadIO m, Unbox a)
405− => (Int -> Int -> m MutableByteArray) -> Int -> Int -> m (MutArray a)
496+ => (Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)
406newArrayWith alloc alignSize count = do
497newArrayWith alloc alignSize count = do
407 let size = max (count * SIZE_OF(a)) 0
498 let size = max (count * SIZE_OF(a)) 0
408 contents <- alloc size alignSize
499 contents <- alloc size alignSize
@@ -413,12 +504,25 @@ newArrayWith alloc alignSize count = do
413 , arrBound = size
504 , arrBound = size
507+-- For arrays "nil" sounds a bit odd. empty is better. The only problem with
508+-- empty is that it is also used by the Alternative type class. But assuming we
509+-- will mostly import the Array module qualified this should be fine.
511+-- | Create an empty array.
517+empty = MutArray Unboxed.empty 0 0 0
519+{-# DEPRECATED nil "Please use empty instead." #-}
417#ifdef DEVBUILD
521#ifdef DEVBUILD
418 Unbox a =>
522 Unbox a =>
420 MutArray a
524 MutArray a
421−nil = MutArray Unboxed.nil 0 0 0
525+nil = empty
423{-# INLINE newBytesAs #-}
527{-# INLINE newBytesAs #-}
424newBytesAs :: MonadIO m =>
528newBytesAs :: MonadIO m =>
@@ -435,12 +539,13 @@ newBytesAs ps bytes = do
435 , arrBound = bytes
539 , arrBound = bytes
438−-- | Allocates a pinned empty array that can hold 'count' items. The memory of
542+-- | Allocates a pinned empty array that with a reserved capacity of bytes.
439−-- the array is uninitialized and the allocation is aligned as per the
543+-- The memory of the array is uninitialized and the allocation is aligned as
440−-- 'Unboxed' instance of the type.
544+-- per the 'Unboxed' instance of the type.
442-- /Pre-release/
546-- /Pre-release/
443{-# INLINE pinnedNewBytes #-}
547{-# INLINE pinnedNewBytes #-}
548+{-# DEPRECATED pinnedNewBytes "Please use pinnedEmptyOf with appropriate calculation" #-}
444pinnedNewBytes :: MonadIO m =>
549pinnedNewBytes :: MonadIO m =>
445#ifdef DEVBUILD
550#ifdef DEVBUILD
446 Unbox a =>
551 Unbox a =>
@@ -465,21 +570,31 @@ newAs ps =
465 (error "new: alignment is not used in unpinned arrays.")
570 (error "new: alignment is not used in unpinned arrays.")
467-- XXX can unaligned allocation be more efficient when alignment is not needed?
572-- XXX can unaligned allocation be more efficient when alignment is not needed?
469−-- | Allocates an empty pinned array that can hold 'count' items. The memory of
574+-- | Allocates a pinned array of zero length but growable to the specified
470−-- the array is uninitialized and the allocation is aligned as per the 'Unboxed'
575+-- capacity without reallocation.
471−-- instance of the type.
576+{-# INLINE pinnedEmptyOf #-}
472−--
577+pinnedEmptyOf :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
578+pinnedEmptyOf = newAs Pinned
580+-- XXX Deprecate in major
581+-- {-# DEPRECATED pinnedNew "Please use pinnedEmptyOf instead." #-}
473{-# INLINE pinnedNew #-}
582{-# INLINE pinnedNew #-}
474pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
583pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
475−pinnedNew = newAs Pinned
584+pinnedNew = pinnedEmptyOf
477−-- | Allocates an empty unpinned array that can hold 'count' items. The memory
586+-- | Allocates an unpinned array of zero length but growable to the specified
478−-- of the array is uninitialized.
587+-- capacity without reallocation.
589+{-# INLINE emptyOf #-}
590+emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
591+emptyOf = newAs Unpinned
593+-- XXX Deprecate in major
594+-- {-# DEPRECATED new "Please use emptyOf instead." #-}
480{-# INLINE new #-}
595{-# INLINE new #-}
481new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
596new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
482−new = newAs Unpinned
597+new = emptyOf
484-------------------------------------------------------------------------------
599-------------------------------------------------------------------------------
485-- Random writes
600-- Random writes
@@ -495,7 +610,7 @@ putIndexUnsafe :: forall m a. (MonadIO m, Unbox a)
495putIndexUnsafe i MutArray{..} x = do
610putIndexUnsafe i MutArray{..} x = do
496 let index = INDEX_OF(arrStart, i, a)
611 let index = INDEX_OF(arrStart, i, a)
497 assert (i >= 0 && INDEX_VALID(index, arrEnd, a)) (return ())
612 assert (i >= 0 && INDEX_VALID(index, arrEnd, a)) (return ())
498− liftIO $ pokeByteIndex index arrContents x
613+ liftIO $ pokeAt index arrContents x
500invalidIndex :: String -> Int -> a
615invalidIndex :: String -> Int -> a
501invalidIndex label i =
616invalidIndex label i =
@@ -513,7 +628,7 @@ putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()
513putIndex i MutArray{..} x = do
628putIndex i MutArray{..} x = do
514 let index = INDEX_OF(arrStart,i,a)
629 let index = INDEX_OF(arrStart,i,a)
515 if i >= 0 && INDEX_VALID(index,arrEnd,a)
630 if i >= 0 && INDEX_VALID(index,arrEnd,a)
516− then liftIO $ pokeByteIndex index arrContents x
631+ then liftIO $ pokeAt index arrContents x
517 else invalidIndex "putIndex" i
632 else invalidIndex "putIndex" i
519-- | Write an input stream of (index, value) pairs to an array. Throws an
634-- | Write an input stream of (index, value) pairs to an array. Throws an
@@ -527,7 +642,7 @@ putIndices arr = FL.foldlM' step (return ())
530− step () (i, x) = liftIO (putIndex i arr x)
645+ step () (i, x) = putIndex i arr x
532-- | Modify a given index of an array using a modifier function.
647-- | Modify a given index of an array using a modifier function.
@@ -539,9 +654,9 @@ modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) =>
539modifyIndexUnsafe i MutArray{..} f = liftIO $ do
654modifyIndexUnsafe i MutArray{..} f = liftIO $ do
540 let index = INDEX_OF(arrStart,i,a)
655 let index = INDEX_OF(arrStart,i,a)
541 assert (i >= 0 && INDEX_NEXT(index,a) <= arrEnd) (return ())
656 assert (i >= 0 && INDEX_NEXT(index,a) <= arrEnd) (return ())
542− r <- peekByteIndex index arrContents
657+ r <- peekAt index arrContents
543 let (x, res) = f r
658 let (x, res) = f r
544− pokeByteIndex index arrContents x
659+ pokeAt index arrContents x
545 return res
660 return res
547-- | Modify a given index of an array using a modifier function.
662-- | Modify a given index of an array using a modifier function.
@@ -553,9 +668,9 @@ modifyIndex i MutArray{..} f = do
553 let index = INDEX_OF(arrStart,i,a)
668 let index = INDEX_OF(arrStart,i,a)
554 if i >= 0 && INDEX_VALID(index,arrEnd,a)
669 if i >= 0 && INDEX_VALID(index,arrEnd,a)
555 then liftIO $ do
670 then liftIO $ do
556− r <- peekByteIndex index arrContents
671+ r <- peekAt index arrContents
557 let (x, res) = f r
672 let (x, res) = f r
558− pokeByteIndex index arrContents x
673+ pokeAt index arrContents x
559 return res
674 return res
560 else invalidIndex "modifyIndex" i
675 else invalidIndex "modifyIndex" i
@@ -589,8 +704,8 @@ modify MutArray{..} f = liftIO $
591 when (INDEX_VALID(i,arrEnd,a)) $ do
706 when (INDEX_VALID(i,arrEnd,a)) $ do
592− r <- peekByteIndex i arrContents
707+ r <- peekAt i arrContents
593− pokeByteIndex i arrContents (f r)
708+ pokeAt i arrContents (f r)
594 go (INDEX_NEXT(i,a))
709 go (INDEX_NEXT(i,a))
596-- XXX We could specify the number of bytes to swap instead of Proxy. Need
711-- XXX We could specify the number of bytes to swap instead of Proxy. Need
@@ -599,15 +714,15 @@ modify MutArray{..} f = liftIO $
599swapArrayByteIndices ::
714swapArrayByteIndices ::
600 forall a. Unbox a
715 forall a. Unbox a
601 => Proxy a
716 => Proxy a
602− -> MutableByteArray
717+ -> MutByteArray
606swapArrayByteIndices _ arrContents i1 i2 = do
721swapArrayByteIndices _ arrContents i1 i2 = do
607− r1 <- peekByteIndex i1 arrContents
722+ r1 <- peekAt i1 arrContents
608− r2 <- peekByteIndex i2 arrContents
723+ r2 <- peekAt i2 arrContents
609− pokeByteIndex i1 arrContents (r2 :: a)
724+ pokeAt i1 arrContents (r2 :: a)
610− pokeByteIndex i2 arrContents (r1 :: a)
725+ pokeAt i2 arrContents (r1 :: a)
612-- | Swap the elements at two indices without validating the indices.
727-- | Swap the elements at two indices without validating the indices.
@@ -723,26 +838,23 @@ arrayChunkBytes = 1024
723roundDownTo :: Int -> Int -> Int
838roundDownTo :: Int -> Int -> Int
724roundDownTo elemSize size = size - (size `mod` elemSize)
839roundDownTo elemSize size = size - (size `mod` elemSize)
726−-- XXX See if resizing can be implemented by reading the old array as a stream
727−-- and then using writeN to the new array.
729-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.
841-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.
730-- Since this is not inlined Unboxed consrraint leads to dictionary passing
842-- Since this is not inlined Unboxed consrraint leads to dictionary passing
731-- which complicates some inspection tests.
843-- which complicates some inspection tests.
733−{-# NOINLINE reallocExplicit #-}
845+{-# NOINLINE reallocExplicitAs #-}
734−reallocExplicit :: Int -> Int -> MutArray a -> IO (MutArray a)
846+reallocExplicitAs :: PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
735−reallocExplicit elemSize newCapacityInBytes MutArray{..} = do
847+reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do
736 assertM(arrEnd <= arrBound)
848 assertM(arrEnd <= arrBound)
738 -- Allocate new array
850 -- Allocate new array
739 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
851 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
740 contents <-
852 contents <-
741− if Unboxed.isPinned arrContents
853+ if ps == Pinned
742− then Unboxed.pinnedNewBytes newCapMaxInBytes
854+ then Unboxed.pinnedNew newCapMaxInBytes
743− else Unboxed.newBytes newCapMaxInBytes
855+ else Unboxed.new newCapMaxInBytes
744− let !(MutableByteArray mbarrFrom#) = arrContents
856+ let !(MutByteArray mbarrFrom#) = arrContents
745− !(MutableByteArray mbarrTo#) = contents
857+ !(MutByteArray mbarrTo#) = contents
747 -- Copy old data
859 -- Copy old data
748 let oldStart = arrStart
860 let oldStart = arrStart
@@ -763,6 +875,10 @@ reallocExplicit elemSize newCapacityInBytes MutArray{..} = do
763 , arrBound = newCapInBytes
875 , arrBound = newCapInBytes
878+-- XXX Should these be called reallocBytes etc?
879+-- XXX We may also need reallocAs to allocate as pinned/unpinned explicitly. In
880+-- fact clone/pinnedClone can be implemented using reallocAs.
766-- | @realloc newCapacity array@ reallocates the array to the specified
882-- | @realloc newCapacity array@ reallocates the array to the specified
767-- capacity in bytes.
883-- capacity in bytes.
@@ -774,7 +890,12 @@ reallocExplicit elemSize newCapacityInBytes MutArray{..} = do
774-- If the original array is pinned, the newly allocated array is also pinned.
890-- If the original array is pinned, the newly allocated array is also pinned.
775{-# INLINABLE realloc #-}
891{-# INLINABLE realloc #-}
776realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)
892realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)
777−realloc bytes arr = liftIO $ reallocExplicit (SIZE_OF(a)) bytes arr
898+ in liftIO $ reallocExplicitAs ps (SIZE_OF(a)) bytes arr
779-- | @reallocWith label capSizer minIncrBytes array@. The label is used
900-- | @reallocWith label capSizer minIncrBytes array@. The label is used
780-- in error messages and the capSizer is used to determine the capacity of the
901-- in error messages and the capSizer is used to determine the capacity of the
@@ -797,14 +918,14 @@ reallocWith label capSizer minIncrBytes arr = do
799 badSize newSize =
920 badSize newSize =
800− concat
921+ Prelude.concat
802 , ": new array size (in bytes) is less than required size "
923 , ": new array size (in bytes) is less than required size "
803 , show newSize
924 , show newSize
804 , ". Please check the sizing function passed."
925 , ". Please check the sizing function passed."
807−-- | @resize newCapacity array@ changes the total capacity of the array so that
928+-- | @grow newCapacity array@ changes the total capacity of the array so that
808-- it is enough to hold the specified number of elements. Nothing is done if
929-- it is enough to hold the specified number of elements. Nothing is done if
809-- the specified capacity is less than the length of the array.
930-- the specified capacity is less than the length of the array.
@@ -812,34 +933,46 @@ reallocWith label capSizer minIncrBytes arr = do
812-- the block size (4K).
933-- the block size (4K).
814-- /Pre-release/
935-- /Pre-release/
815−{-# INLINE resize #-}
936+{-# INLINE grow #-}
816−resize :: forall m a. (MonadIO m, Unbox a) =>
937+grow :: forall m a. (MonadIO m, Unbox a) =>
817 Int -> MutArray a -> m (MutArray a)
938 Int -> MutArray a -> m (MutArray a)
818−resize nElems arr@MutArray{..} = do
939+grow nElems arr@MutArray{..} = do
819 let req = SIZE_OF(a) * nElems
940 let req = SIZE_OF(a) * nElems
820− len = arrEnd - arrStart
941+ cap = arrBound - arrStart
821− if req < len
942+ if req < cap
822 then return arr
943 then return arr
823 else realloc req arr
944 else realloc req arr
946+{-# DEPRECATED resize "Please use grow instead." #-}
947+{-# INLINE resize #-}
948+resize :: forall m a. (MonadIO m, Unbox a) =>
949+ Int -> MutArray a -> m (MutArray a)
825−-- | Like 'resize' but if the byte capacity is more than 'largeObjectThreshold'
952+-- | Like 'grow' but if the requested byte capacity is more than
826−-- then it is rounded up to the closest power of 2.
953+-- 'largeObjectThreshold' then it is rounded up to the closest power of 2.
828-- /Pre-release/
955-- /Pre-release/
829−{-# INLINE resizeExp #-}
956+{-# INLINE growExp #-}
830−resizeExp :: forall m a. (MonadIO m, Unbox a) =>
957+growExp :: forall m a. (MonadIO m, Unbox a) =>
831 Int -> MutArray a -> m (MutArray a)
958 Int -> MutArray a -> m (MutArray a)
832−resizeExp nElems arr@MutArray{..} = do
959+growExp nElems arr@MutArray{..} = do
833 let req = roundUpLargeArray (SIZE_OF(a) * nElems)
960 let req = roundUpLargeArray (SIZE_OF(a) * nElems)
835 if req > largeObjectThreshold
962 if req > largeObjectThreshold
836 then roundUpToPower2 req
963 then roundUpToPower2 req
838− len = arrEnd - arrStart
965+ cap = arrBound - arrStart
839− if req1 < len
966+ if req1 < cap
840 then return arr
967 then return arr
841 else realloc req1 arr
968 else realloc req1 arr
970+{-# DEPRECATED resizeExp "Please use growExp instead." #-}
971+{-# INLINE resizeExp #-}
972+resizeExp :: forall m a. (MonadIO m, Unbox a) =>
973+ Int -> MutArray a -> m (MutArray a)
843-- | Resize the allocated memory to drop any reserved free space at the end of
976-- | Resize the allocated memory to drop any reserved free space at the end of
844-- the array and reallocate it to reduce wastage.
977-- the array and reallocate it to reduce wastage.
@@ -884,7 +1017,7 @@ rightSize arr@MutArray{..} = do
884snocNewEnd :: (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)
1017snocNewEnd :: (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)
885snocNewEnd newEnd arr@MutArray{..} x = liftIO $ do
1018snocNewEnd newEnd arr@MutArray{..} x = liftIO $ do
886 assert (newEnd <= arrBound) (return ())
1019 assert (newEnd <= arrBound) (return ())
887− pokeByteIndex arrEnd arrContents x
1020+ pokeAt arrEnd arrContents x
888 return $ arr {arrEnd = newEnd}
1021 return $ arr {arrEnd = newEnd}
890-- | Really really unsafe, appends the element into the first array, may
1023-- | Really really unsafe, appends the element into the first array, may
@@ -904,7 +1037,7 @@ snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr
904{-# INLINE snocMay #-}
1037{-# INLINE snocMay #-}
905snocMay :: forall m a. (MonadIO m, Unbox a) =>
1038snocMay :: forall m a. (MonadIO m, Unbox a) =>
906 MutArray a -> a -> m (Maybe (MutArray a))
1039 MutArray a -> a -> m (Maybe (MutArray a))
907−snocMay arr@MutArray{..} x = liftIO $ do
1040+snocMay arr@MutArray{..} x = do
908 let newEnd = INDEX_NEXT(arrEnd,a)
1041 let newEnd = INDEX_NEXT(arrEnd,a)
909 if newEnd <= arrBound
1042 if newEnd <= arrBound
910 then Just <$> snocNewEnd newEnd arr x
1043 then Just <$> snocNewEnd newEnd arr x
@@ -918,7 +1051,7 @@ snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>
919 -> m (MutArray a)
1052 -> m (MutArray a)
920snocWithRealloc sizer arr x = do
1053snocWithRealloc sizer arr x = do
921− arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr
1054+ arr1 <- reallocWith "snocWith" sizer (SIZE_OF(a)) arr
922 snocUnsafe arr1 x
1055 snocUnsafe arr1 x
924-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of
1057-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of
@@ -940,7 +1073,7 @@ snocWith :: forall m a. (MonadIO m, Unbox a) =>
940 -> MutArray a
1073 -> MutArray a
942 -> m (MutArray a)
1075 -> m (MutArray a)
943−snocWith allocSize arr x = liftIO $ do
1076+snocWith allocSize arr x = do
944 let newEnd = INDEX_NEXT(arrEnd arr,a)
1077 let newEnd = INDEX_NEXT(arrEnd arr,a)
945 if newEnd <= arrBound arr
1078 if newEnd <= arrBound arr
946 then snocNewEnd newEnd arr x
1079 then snocNewEnd newEnd arr x
@@ -984,6 +1117,126 @@ snoc = snocWith f
984 then oldSize * 2
1117 then oldSize * 2
985 else roundUpToPower2 oldSize * 2
1118 else roundUpToPower2 oldSize * 2
1120+-------------------------------------------------------------------------------
1121+-- Serialization/Deserialization
1122+-------------------------------------------------------------------------------
1124+{-# INLINE pokeNewEnd #-}
1125+pokeNewEnd :: (MonadIO m, Unbox a) =>
1126+ Int -> MutArray Word8 -> a -> m (MutArray Word8)
1127+pokeNewEnd newEnd arr@MutArray{..} x = liftIO $ do
1128+ assert (newEnd <= arrBound) (return ())
1129+ liftIO $ pokeAt arrEnd arrContents x
1130+ return $ arr {arrEnd = newEnd}
1132+-- | Really really unsafe, unboxes a Haskell type and appends the resulting
1133+-- bytes to the byte array, may cause silent data corruption or if you are
1134+-- lucky a segfault if the array does not have enough space to append the
1138+{-# INLINE pokeAppendUnsafe #-}
1139+pokeAppendUnsafe :: forall m a. (MonadIO m, Unbox a) =>
1140+ MutArray Word8 -> a -> m (MutArray Word8)
1141+pokeAppendUnsafe arr@MutArray{..} = pokeNewEnd (arrEnd + SIZE_OF(a)) arr
1143+-- | Skip the specified number of bytes in the array. The data in the skipped
1144+-- region remains uninitialzed.
1145+{-# INLINE pokeSkipUnsafe #-}
1146+pokeSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8
1147+pokeSkipUnsafe n arr@MutArray{..} = do
1148+ let newEnd = arrEnd + n
1149+ in assert (newEnd <= arrBound) (arr {arrEnd = newEnd})
1151+-- | Like 'pokeAppend' but does not grow the array when pre-allocated array
1152+-- capacity becomes full.
1155+{-# INLINE pokeAppendMay #-}
1156+pokeAppendMay :: forall m a. (MonadIO m, Unbox a) =>
1157+ MutArray Word8 -> a -> m (Maybe (MutArray Word8))
1158+pokeAppendMay arr@MutArray{..} x = liftIO $ do
1159+ let newEnd = arrEnd + SIZE_OF(a)
1160+ if newEnd <= arrBound
1161+ then Just <$> pokeNewEnd newEnd arr x
1162+ else return Nothing
1164+{-# NOINLINE pokeWithRealloc #-}
1165+pokeWithRealloc :: forall m a. (MonadIO m, Unbox a) =>
1169+ -> m (MutArray Word8)
1170+pokeWithRealloc sizer arr x = do
1171+ arr1 <- liftIO $ reallocWith "pokeWithRealloc" sizer (SIZE_OF(a)) arr
1172+ pokeAppendUnsafe arr1 x
1174+{-# INLINE pokeAppendWith #-}
1175+pokeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
1179+ -> m (MutArray Word8)
1180+pokeAppendWith allocSize arr x = liftIO $ do
1181+ let newEnd = arrEnd arr + SIZE_OF(a)
1182+ if newEnd <= arrBound arr
1183+ then pokeNewEnd newEnd arr x
1184+ else pokeWithRealloc allocSize arr x
1186+-- | Unbox a Haskell type and append the resulting bytes to a mutable byte
1187+-- array. The array is grown exponentially when more space is needed.
1191+-- >>> pokeAppend arr x = MutArray.castUnsafe <$> MutArray.snoc (MutArray.castUnsafe arr) x
1193+{-# INLINE pokeAppend #-}
1194+pokeAppend :: forall m a. (MonadIO m, Unbox a) =>
1195+ MutArray Word8 -> a -> m (MutArray Word8)
1196+pokeAppend = pokeAppendWith f
1201+ if isPower2 oldSize
1203+ else roundUpToPower2 oldSize * 2
1205+-- | Really really unsafe, create a Haskell value from an unboxed byte array,
1206+-- does not check if the array is big enough, may return garbage or if you are
1207+-- lucky may cause a segfault.
1210+{-# INLINE peekUnconsUnsafe #-}
1211+peekUnconsUnsafe :: forall m a. (MonadIO m, Unbox a) =>
1212+ MutArray Word8 -> m (a, MutArray Word8)
1213+peekUnconsUnsafe MutArray{..} = do
1214+ let start1 = arrStart + SIZE_OF(a)
1215+ assert (start1 <= arrEnd) (return ())
1217+ r <- peekAt arrStart arrContents
1218+ return (r, MutArray arrContents start1 arrEnd arrBound)
1220+-- | Discard the specified number of bytes in the array.
1221+{-# INLINE peekSkipUnsafe #-}
1222+peekSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8
1223+peekSkipUnsafe n MutArray{..} =
1224+ let start1 = arrStart + n
1225+ in assert (start1 <= arrEnd) (MutArray arrContents start1 arrEnd arrBound)
1227+-- | Create a Haskell value from its unboxed representation from the head of a
1228+-- byte array, return the value and the remaining array.
1229+{-# INLINE peekUncons #-}
1230+peekUncons :: forall m a. (MonadIO m, Unbox a) =>
1231+ MutArray Word8 -> m (Maybe a, MutArray Word8)
1232+peekUncons arr@MutArray{..} = do
1233+ let start1 = arrStart + SIZE_OF(a)
1235+ then return (Nothing, arr)
1237+ r <- peekAt arrStart arrContents
1238+ return (Just r, MutArray arrContents start1 arrEnd arrBound)
987-------------------------------------------------------------------------------
1240-------------------------------------------------------------------------------
988-- Random reads
1241-- Random reads
989-------------------------------------------------------------------------------
1242-------------------------------------------------------------------------------
@@ -998,7 +1251,7 @@ getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a
998getIndexUnsafe i MutArray{..} = do
1251getIndexUnsafe i MutArray{..} = do
999 let index = INDEX_OF(arrStart,i,a)
1252 let index = INDEX_OF(arrStart,i,a)
1000 assert (i >= 0 && INDEX_VALID(index,arrEnd,a)) (return ())
1253 assert (i >= 0 && INDEX_VALID(index,arrEnd,a)) (return ())
1001− liftIO $ peekByteIndex index arrContents
1254+ liftIO $ peekAt index arrContents
1003-- | /O(1)/ Lookup the element at the given index. Index starts from 0.
1256-- | /O(1)/ Lookup the element at the given index. Index starts from 0.
@@ -1007,7 +1260,7 @@ getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (Maybe a)
1007getIndex i MutArray{..} = do
1260getIndex i MutArray{..} = do
1008 let index = INDEX_OF(arrStart,i,a)
1261 let index = INDEX_OF(arrStart,i,a)
1009 if i >= 0 && INDEX_VALID(index,arrEnd,a)
1262 if i >= 0 && INDEX_VALID(index,arrEnd,a)
1010− then liftIO $ Just <$> peekByteIndex index arrContents
1263+ then liftIO $ Just <$> peekAt index arrContents
1011 else return Nothing
1264 else return Nothing
1013-- | /O(1)/ Lookup the element at the given index from the end of the array.
1266-- | /O(1)/ Lookup the element at the given index from the end of the array.
@@ -1020,21 +1273,16 @@ getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a
1020getIndexRev i MutArray{..} = do
1273getIndexRev i MutArray{..} = do
1021 let index = RINDEX_OF(arrEnd,i,a)
1274 let index = RINDEX_OF(arrEnd,i,a)
1022 if i >= 0 && index >= arrStart
1275 if i >= 0 && index >= arrStart
1023− then liftIO $ peekByteIndex index arrContents
1276+ then liftIO $ peekAt index arrContents
1024 else invalidIndex "getIndexRev" i
1277 else invalidIndex "getIndexRev" i
1026data GetIndicesState contents start end st =
1279data GetIndicesState contents start end st =
1027 GetIndicesState contents start end st
1280 GetIndicesState contents start end st
1029−-- | Given an unfold that generates array indices, read the elements on those
1282+{-# INLINE indexReaderWith #-}
1030−-- indices from the supplied MutArray. An error is thrown if an index is out of
1034−{-# INLINE getIndicesD #-}
1035−getIndicesD :: (Monad m, Unbox a) =>
1283+indexReaderWith :: (Monad m, Unbox a) =>
1036 (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a
1284 (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a
1037−getIndicesD liftio (D.Stream stepi sti) = Unfold step inject
1285+indexReaderWith liftio (D.Stream stepi sti) = Unfold step inject
@@ -1053,9 +1301,26 @@ getIndicesD liftio (D.Stream stepi sti) = Unfold step inject
1053 D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)
1301 D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)
1054 D.Stop -> return D.Stop
1302 D.Stop -> return D.Stop
1304+{-# DEPRECATED getIndicesWith "Please use indexReaderWith instead." #-}
1305+{-# INLINE getIndicesWith #-}
1306+getIndicesWith :: (Monad m, Unbox a) =>
1307+ (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a
1308+getIndicesWith = indexReaderWith
1310+-- | Given an unfold that generates array indices, read the elements on those
1311+-- indices from the supplied MutArray. An error is thrown if an index is out of
1315+{-# INLINE indexReader #-}
1316+indexReader :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
1317+indexReader = indexReaderWith liftIO
1319+-- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold
1320+{-# DEPRECATED getIndices "Please use indexReader instead." #-}
1056{-# INLINE getIndices #-}
1321{-# INLINE getIndices #-}
1057getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
1322getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
1058−getIndices = getIndicesD liftIO
1323+getIndices = indexReader
1060-------------------------------------------------------------------------------
1325-------------------------------------------------------------------------------
1061-- Subarrays
1326-- Subarrays
@@ -1160,7 +1425,7 @@ partitionBy f arr@MutArray{..} = liftIO $ do
1161 -- Invariant low < high on entry, and on return as well
1426 -- Invariant low < high on entry, and on return as well
1162 moveHigh low high = do
1427 moveHigh low high = do
1163− h <- peekByteIndex high arrContents
1428+ h <- peekAt high arrContents
1166 -- Correctly classified, continue the loop
1431 -- Correctly classified, continue the loop
@@ -1180,7 +1445,7 @@ partitionBy f arr@MutArray{..} = liftIO $ do
1180 -- low <= high
1445 -- low <= high
1181 -- Both low and high are valid locations within the array
1446 -- Both low and high are valid locations within the array
1182 go low high = do
1447 go low high = do
1183− l <- peekByteIndex low arrContents
1448+ l <- peekAt low arrContents
1186 -- low is wrongly classified
1451 -- low is wrongly classified
@@ -1191,8 +1456,8 @@ partitionBy f arr@MutArray{..} = liftIO $ do
1191 case r of
1456 case r of
1192 Nothing -> return low
1457 Nothing -> return low
1193 Just (high1, h) -> do -- low < high1
1458 Just (high1, h) -> do -- low < high1
1194− pokeByteIndex low arrContents h
1459+ pokeAt low arrContents h
1195− pokeByteIndex high1 arrContents l
1460+ pokeAt high1 arrContents l
1196 let low1 = INDEX_NEXT(low,a)
1461 let low1 = INDEX_NEXT(low,a)
1197 high2 = INDEX_PREV(high1,a)
1462 high2 = INDEX_PREV(high1,a)
1198 if low1 <= high2
1463 if low1 <= high2
@@ -1326,7 +1591,7 @@ chunksOfAs ps n (D.Stream step state) =
1326 r <- step (adaptState gst) st
1591 r <- step (adaptState gst) st
1327 case r of
1592 case r of
1328 D.Yield x s -> do
1593 D.Yield x s -> do
1329− liftIO $ pokeByteIndex end contents x
1594+ liftIO $ pokeAt end contents x
1330 let end1 = INDEX_NEXT(end,a)
1595 let end1 = INDEX_NEXT(end,a)
1331 return $
1596 return $
1332 if end1 >= bound
1597 if end1 >= bound
@@ -1345,10 +1610,12 @@ chunksOfAs ps n (D.Stream step state) =
1346 step' _ GroupFinish = return D.Stop
1611 step' _ GroupFinish = return D.Stop
1348−-- | @chunksOf n stream@ groups the input stream into a stream of
1613+-- | @chunksOf n stream@ groups the elements in the input stream into arrays of
1349−-- arrays of size n.
1614+-- @n@ elements each.
1616+-- Same as the following but may be more efficient:
1351−-- @chunksOf n = StreamD.foldMany (MutArray.writeN n)@
1618+-- >>> chunksOf n = Stream.foldMany (MutArray.createOf n)
1353-- /Pre-release/
1620-- /Pre-release/
1354{-# INLINE_NORMAL chunksOf #-}
1621{-# INLINE_NORMAL chunksOf #-}
@@ -1357,17 +1624,29 @@ chunksOf :: forall m a. (MonadIO m, Unbox a)
1357-- XXX the idiomatic implementation leads to large regression in the D.reverse'
1624-- XXX the idiomatic implementation leads to large regression in the D.reverse'
1358-- benchmark. It seems it has difficulty producing optimized code when
1625-- benchmark. It seems it has difficulty producing optimized code when
1359-- converting to StreamK. Investigate GHC optimizations.
1626-- converting to StreamK. Investigate GHC optimizations.
1360−-- chunksOf n = D.foldMany (writeN n)
1627+-- chunksOf n = D.foldMany (createOf n)
1361chunksOf = chunksOfAs Unpinned
1628chunksOf = chunksOfAs Unpinned
1363-- | Like 'chunksOf' but creates pinned arrays.
1630-- | Like 'chunksOf' but creates pinned arrays.
1364{-# INLINE_NORMAL pinnedChunksOf #-}
1631{-# INLINE_NORMAL pinnedChunksOf #-}
1365pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)
1632pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)
1366 => Int -> D.Stream m a -> D.Stream m (MutArray a)
1633 => Int -> D.Stream m a -> D.Stream m (MutArray a)
1367−-- pinnedChunksOf n = D.foldMany (pinnedWriteN n)
1634+-- pinnedChunksOf n = D.foldMany (pinnedCreateOf n)
1368pinnedChunksOf = chunksOfAs Pinned
1635pinnedChunksOf = chunksOfAs Pinned
1370−-- XXX This should take a PinnedState
1637+-- | When we are buffering a stream of unknown size into an array we do not
1638+-- know how much space to pre-allocate. So we start with the min size and emit
1639+-- the array then keep on doubling the size every time. Thus we do not need to
1640+-- guess the optimum chunk size.
1642+-- We can incorporate this in chunksOfAs if the additional size parameter does
1645+{-# INLINE _chunksOfRange #-}
1646+_chunksOfRange :: -- (MonadIO m, Unbox a) =>
1647+ PinnedState -> Int -> Int -> D.Stream m a -> D.Stream m (MutArray a)
1648+_chunksOfRange _ps _low _hi = undefined
1371-- XXX buffer to a list instead?
1650-- XXX buffer to a list instead?
1372-- | Buffer the stream into arrays in memory.
1651-- | Buffer the stream into arrays in memory.
1373{-# INLINE arrayStreamKFromStreamDAs #-}
1652{-# INLINE arrayStreamKFromStreamDAs #-}
@@ -1385,16 +1664,10 @@ data FlattenState s contents a =
1385 OuterLoop s
1664 OuterLoop s
1386 | InnerLoop s contents !Int !Int
1665 | InnerLoop s contents !Int !Int
1388−-- | Use the "reader" unfold instead.
1390−-- @flattenArrays = unfoldMany reader@
1392−-- We can try this if there are any fusion issues in the unfold.
1394−{-# INLINE_NORMAL flattenArrays #-}
1667+{-# INLINE_NORMAL concatWith #-}
1395−flattenArrays :: forall m a. (MonadIO m, Unbox a)
1668+concatWith :: forall m a. (Monad m, Unbox a)
1396− => D.Stream m (MutArray a) -> D.Stream m a
1669+ => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a
1397−flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)
1670+concatWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
@@ -1411,19 +1684,30 @@ flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)
1411 return $ D.Skip $ OuterLoop st
1684 return $ D.Skip $ OuterLoop st
1413 step' _ (InnerLoop st contents p end) = do
1686 step' _ (InnerLoop st contents p end) = do
1414− x <- liftIO $ peekByteIndex p contents
1687+ x <- liftio $ peekAt p contents
1415 return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)
1688 return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)
1417−-- | Use the "readerRev" unfold instead.
1690+-- | Use the "reader" unfold instead.
1419−-- @flattenArrays = unfoldMany readerRev@
1692+-- @concat = unfoldMany reader@
1421-- We can try this if there are any fusion issues in the unfold.
1694-- We can try this if there are any fusion issues in the unfold.
1423−{-# INLINE_NORMAL flattenArraysRev #-}
1696+{-# INLINE_NORMAL concat #-}
1697+concat :: forall m a. (MonadIO m, Unbox a)
1698+ => D.Stream m (MutArray a) -> D.Stream m a
1699+concat = concatWith liftIO
1701+{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}
1702+{-# INLINE flattenArrays #-}
1424−flattenArraysRev :: forall m a. (MonadIO m, Unbox a)
1703+flattenArrays :: forall m a. (MonadIO m, Unbox a)
1425 => D.Stream m (MutArray a) -> D.Stream m a
1704 => D.Stream m (MutArray a) -> D.Stream m a
1705+flattenArrays = concat
1707+{-# INLINE_NORMAL concatRevWith #-}
1708+concatRevWith :: forall m a. (Monad m, Unbox a)
1709+ => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a
1426−flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)
1710+concatRevWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
@@ -1441,16 +1725,33 @@ flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)
1441 return $ D.Skip $ OuterLoop st
1725 return $ D.Skip $ OuterLoop st
1443 step' _ (InnerLoop st contents p start) = do
1727 step' _ (InnerLoop st contents p start) = do
1444− x <- liftIO $ peekByteIndex p contents
1728+ x <- liftio $ peekAt p contents
1445 let cur = INDEX_PREV(p,a)
1729 let cur = INDEX_PREV(p,a)
1446 return $ D.Yield x (InnerLoop st contents cur start)
1730 return $ D.Yield x (InnerLoop st contents cur start)
1732+-- | Use the "readerRev" unfold instead.
1734+-- @concat = unfoldMany readerRev@
1736+-- We can try this if there are any fusion issues in the unfold.
1738+{-# INLINE_NORMAL concatRev #-}
1739+concatRev :: forall m a. (MonadIO m, Unbox a)
1740+ => D.Stream m (MutArray a) -> D.Stream m a
1741+concatRev = concatRevWith liftIO
1743+{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}
1744+{-# INLINE flattenArraysRev #-}
1745+flattenArraysRev :: forall m a. (MonadIO m, Unbox a)
1746+ => D.Stream m (MutArray a) -> D.Stream m a
1747+flattenArraysRev = concatRev
1448-------------------------------------------------------------------------------
1749-------------------------------------------------------------------------------
1449-- Unfolds
1750-- Unfolds
1450-------------------------------------------------------------------------------
1751-------------------------------------------------------------------------------
1452data ArrayUnsafe a = ArrayUnsafe
1753data ArrayUnsafe a = ArrayUnsafe
1453− {-# UNPACK #-} !MutableByteArray -- contents
1754+ {-# UNPACK #-} !MutByteArray -- contents
1454 {-# UNPACK #-} !Int -- index 1
1755 {-# UNPACK #-} !Int -- index 1
1455 {-# UNPACK #-} !Int -- index 2
1756 {-# UNPACK #-} !Int -- index 2
@@ -1480,7 +1781,7 @@ producerWith liftio = Producer step (return . toArrayUnsafe) extract
1480 -- few actions for correctness and execution order sanity. We want
1781 -- few actions for correctness and execution order sanity. We want
1481 -- the peek to occur right here and not lazily at some later point
1782 -- the peek to occur right here and not lazily at some later point
1482 -- because we want the peek to be ordered with respect to the touch.
1783 -- because we want the peek to be ordered with respect to the touch.
1483− !x <- liftio $ peekByteIndex cur contents
1784+ !x <- liftio $ peekAt cur contents
1484 return $ D.Yield x (ArrayUnsafe contents (INDEX_NEXT(cur,a)) end)
1785 return $ D.Yield x (ArrayUnsafe contents (INDEX_NEXT(cur,a)) end)
1486 extract = return . fromArrayUnsafe
1787 extract = return . fromArrayUnsafe
@@ -1511,7 +1812,7 @@ readerRevWith liftio = Unfold step inject
1511 {-# INLINE_LATE step #-}
1812 {-# INLINE_LATE step #-}
1512 step (ArrayUnsafe _ start p) | p < start = return D.Stop
1813 step (ArrayUnsafe _ start p) | p < start = return D.Stop
1513 step (ArrayUnsafe contents start p) = do
1814 step (ArrayUnsafe contents start p) = do
1514− !x <- liftio $ peekByteIndex p contents
1815+ !x <- liftio $ peekAt p contents
1515 return $ D.Yield x (ArrayUnsafe contents start (INDEX_PREV(p,a)))
1816 return $ D.Yield x (ArrayUnsafe contents start (INDEX_PREV(p,a)))
1517-- | Unfold an array into a stream in reverse order.
1818-- | Unfold an array into a stream in reverse order.
@@ -1542,7 +1843,7 @@ toListFB c n MutArray{..} = go arrStart
1542 -- evaluated/written to before we peek at them.
1843 -- evaluated/written to before we peek at them.
1544 let !x = unsafeInlineIO $ do
1845 let !x = unsafeInlineIO $ do
1545− r <- peekByteIndex arrContents p
1846+ r <- peekAt arrContents p
1546 return r
1847 return r
1547 in c x (go (PTR_NEXT(p,a)))
1848 in c x (go (PTR_NEXT(p,a)))
@@ -1559,21 +1860,21 @@ toList MutArray{..} = liftIO $ go arrStart
1560 go p | assert (p <= arrEnd) (p == arrEnd) = return []
1861 go p | assert (p <= arrEnd) (p == arrEnd) = return []
1561 go p = do
1862 go p = do
1562− x <- peekByteIndex p arrContents
1863+ x <- peekAt p arrContents
1563 (:) x <$> go (INDEX_NEXT(p,a))
1864 (:) x <$> go (INDEX_NEXT(p,a))
1565−{-# INLINE_NORMAL toStreamDWith #-}
1866+{-# INLINE_NORMAL toStreamWith #-}
1566−toStreamDWith ::
1867+toStreamWith ::
1567 forall m a. (Monad m, Unbox a)
1868 forall m a. (Monad m, Unbox a)
1568 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1869 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1569−toStreamDWith liftio MutArray{..} = D.Stream step arrStart
1870+toStreamWith liftio MutArray{..} = D.Stream step arrStart
1573 {-# INLINE_LATE step #-}
1874 {-# INLINE_LATE step #-}
1574 step _ p | assert (p <= arrEnd) (p == arrEnd) = return D.Stop
1875 step _ p | assert (p <= arrEnd) (p == arrEnd) = return D.Stop
1575 step _ p = liftio $ do
1876 step _ p = liftio $ do
1576− r <- peekByteIndex p arrContents
1877+ r <- peekAt p arrContents
1577 return $ D.Yield r (INDEX_NEXT(p,a))
1878 return $ D.Yield r (INDEX_NEXT(p,a))
1579-- | Convert a 'MutArray' into a stream.
1880-- | Convert a 'MutArray' into a stream.
@@ -1582,7 +1883,7 @@ toStreamDWith liftio MutArray{..} = D.Stream step arrStart
1583{-# INLINE_NORMAL read #-}
1884{-# INLINE_NORMAL read #-}
1584read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1885read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1585−read = toStreamDWith liftIO
1886+read = toStreamWith liftIO
1587{-# INLINE toStreamKWith #-}
1888{-# INLINE toStreamKWith #-}
1588toStreamKWith ::
1889toStreamKWith ::
@@ -1594,18 +1895,18 @@ toStreamKWith liftio MutArray{..} = go arrStart
1595 go p | assert (p <= arrEnd) (p == arrEnd) = K.nil
1896 go p | assert (p <= arrEnd) (p == arrEnd) = K.nil
1596 | otherwise =
1897 | otherwise =
1597− let elemM = peekByteIndex p arrContents
1898+ let elemM = peekAt p arrContents
1598 in liftio elemM `K.consM` go (INDEX_NEXT(p,a))
1899 in liftio elemM `K.consM` go (INDEX_NEXT(p,a))
1600{-# INLINE toStreamK #-}
1901{-# INLINE toStreamK #-}
1601toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a
1902toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a
1602toStreamK = toStreamKWith liftIO
1903toStreamK = toStreamKWith liftIO
1604−{-# INLINE_NORMAL toStreamDRevWith #-}
1905+{-# INLINE_NORMAL toStreamRevWith #-}
1605−toStreamDRevWith ::
1906+toStreamRevWith ::
1606 forall m a. (Monad m, Unbox a)
1907 forall m a. (Monad m, Unbox a)
1607 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1908 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1608−toStreamDRevWith liftio MutArray{..} =
1909+toStreamRevWith liftio MutArray{..} =
1609 let p = INDEX_PREV(arrEnd,a)
1910 let p = INDEX_PREV(arrEnd,a)
1610 in D.Stream step p
1911 in D.Stream step p
@@ -1614,7 +1915,7 @@ toStreamDRevWith liftio MutArray{..} =
1614 {-# INLINE_LATE step #-}
1915 {-# INLINE_LATE step #-}
1615 step _ p | p < arrStart = return D.Stop
1916 step _ p | p < arrStart = return D.Stop
1616 step _ p = liftio $ do
1917 step _ p = liftio $ do
1617− r <- peekByteIndex p arrContents
1918+ r <- peekAt p arrContents
1618 return $ D.Yield r (INDEX_PREV(p,a))
1919 return $ D.Yield r (INDEX_PREV(p,a))
1620-- | Convert a 'MutArray' into a stream in reverse order.
1921-- | Convert a 'MutArray' into a stream in reverse order.
@@ -1623,7 +1924,7 @@ toStreamDRevWith liftio MutArray{..} =
1624{-# INLINE_NORMAL readRev #-}
1925{-# INLINE_NORMAL readRev #-}
1625readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1926readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1626−readRev = toStreamDRevWith liftIO
1927+readRev = toStreamRevWith liftIO
1628{-# INLINE toStreamKRevWith #-}
1929{-# INLINE toStreamKRevWith #-}
1629toStreamKRevWith ::
1930toStreamKRevWith ::
@@ -1637,7 +1938,7 @@ toStreamKRevWith liftio MutArray {..} =
1638 go p | p < arrStart = K.nil
1939 go p | p < arrStart = K.nil
1639 | otherwise =
1940 | otherwise =
1640− let elemM = peekByteIndex p arrContents
1941+ let elemM = peekAt p arrContents
1641 in liftio elemM `K.consM` go (INDEX_PREV(p,a))
1942 in liftio elemM `K.consM` go (INDEX_PREV(p,a))
1643{-# INLINE toStreamKRev #-}
1944{-# INLINE toStreamKRev #-}
@@ -1672,7 +1973,7 @@ foldr f z arr = D.foldr f z $ read arr
1673-- XXX Keep the bound intact to not lose any free space? Perf impact?
1974-- XXX Keep the bound intact to not lose any free space? Perf impact?
1675−-- | @writeAppendNUnsafe n arr@ appends up to @n@ input items to the supplied
1976+-- | @unsafeAppendN n arr@ appends up to @n@ input items to the supplied
1676-- array.
1977-- array.
1678-- Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory
1979-- Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory
@@ -1681,13 +1982,12 @@ foldr f z arr = D.foldr f z $ read arr
1681-- Any free space left in the array after appending @n@ elements is lost.
1982-- Any free space left in the array after appending @n@ elements is lost.
1683-- /Internal/
1984-- /Internal/
1684−{-# INLINE_NORMAL writeAppendNUnsafe #-}
1985+{-# INLINE_NORMAL unsafeAppendN #-}
1685−writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>
1986+unsafeAppendN :: forall m a. (MonadIO m, Unbox a) =>
1687 -> m (MutArray a)
1988 -> m (MutArray a)
1688 -> Fold m a (MutArray a)
1989 -> Fold m a (MutArray a)
1689−writeAppendNUnsafe n action =
1690− fmap fromArrayUnsafe $ FL.foldlM' step initial
1990+unsafeAppendN n action = fmap fromArrayUnsafe $ FL.foldlM' step initial
@@ -1700,38 +2000,59 @@ writeAppendNUnsafe n action =
1700 -- otherwise we lose that space.
2000 -- otherwise we lose that space.
1702 if free < needed
2002 if free < needed
1703− then noinline reallocWith "writeAppendNUnsafeWith" (+ needed) needed arr
2003+ then noinline reallocWith "unsafeAppendN" (+ needed) needed arr
1704 else return arr
2004 else return arr
1705 return $ toArrayUnsafe arr1
2005 return $ toArrayUnsafe arr1
1707 step (ArrayUnsafe contents start end) x = do
2007 step (ArrayUnsafe contents start end) x = do
1708− liftIO $ pokeByteIndex end contents x
2008+ liftIO $ pokeAt end contents x
1709 return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
2009 return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
2011+{-# DEPRECATED writeAppendNUnsafe "Please use unsafeAppendN instead." #-}
2012+{-# INLINE writeAppendNUnsafe #-}
2013+writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>
2016+ -> Fold m a (MutArray a)
2017+writeAppendNUnsafe = unsafeAppendN
1711-- | Append @n@ elements to an existing array. Any free space left in the array
2019-- | Append @n@ elements to an existing array. Any free space left in the array
1712-- after appending @n@ elements is lost.
2020-- after appending @n@ elements is lost.
1714−-- >>> writeAppendN n initial = Fold.take n (MutArray.writeAppendNUnsafe n initial)
2022+-- >>> appendN n initial = Fold.take n (MutArray.unsafeAppendN n initial)
1716−{-# INLINE_NORMAL writeAppendN #-}
2024+{-# INLINE_NORMAL appendN #-}
2025+appendN :: forall m a. (MonadIO m, Unbox a) =>
2026+ Int -> m (MutArray a) -> Fold m a (MutArray a)
2027+appendN n initial = FL.take n (unsafeAppendN n initial)
2029+-- XXX Deprecate in major
2030+-- {-# DEPRECATED writeAppendN "Please use appendN instead." #-}
2031+{-# INLINE writeAppendN #-}
1717writeAppendN :: forall m a. (MonadIO m, Unbox a) =>
2032writeAppendN :: forall m a. (MonadIO m, Unbox a) =>
1718 Int -> m (MutArray a) -> Fold m a (MutArray a)
2033 Int -> m (MutArray a) -> Fold m a (MutArray a)
1719−writeAppendN n initial = FL.take n (writeAppendNUnsafe n initial)
2034+writeAppendN = appendN
1721−-- | @writeAppendWith realloc action@ mutates the array generated by @action@ to
2036+-- | @appendWith realloc action@ mutates the array generated by @action@ to
1722-- append the input stream. If there is no reserved space available in the
2037-- append the input stream. If there is no reserved space available in the
1723-- array it is reallocated to a size in bytes determined by @realloc oldSize@,
2038-- array it is reallocated to a size in bytes determined by @realloc oldSize@,
1724-- where @oldSize@ is the current size of the array in bytes.
2039-- where @oldSize@ is the current size of the array in bytes.
1726-- Note that the returned array may be a mutated version of original array.
2041-- Note that the returned array may be a mutated version of original array.
1728−-- >>> writeAppendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)
2043+-- >>> appendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)
1730-- /Pre-release/
2045-- /Pre-release/
2046+{-# INLINE appendWith #-}
2047+appendWith :: forall m a. (MonadIO m, Unbox a) =>
2048+ (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
2049+appendWith sizer = FL.foldlM' (snocWith sizer)
2051+{-# DEPRECATED writeAppendWith "Please use appendWith instead." #-}
1731{-# INLINE writeAppendWith #-}
2052{-# INLINE writeAppendWith #-}
1732writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
2053writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
1733 (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
2054 (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
1734−writeAppendWith sizer = FL.foldlM' (snocWith sizer)
2055+writeAppendWith = appendWith
1736-- | @append action@ mutates the array generated by @action@ to append the
2057-- | @append action@ mutates the array generated by @action@ to append the
1737-- input stream. If there is no reserved space available in the array it is
2058-- input stream. If there is no reserved space available in the array it is
@@ -1739,70 +2060,101 @@ writeAppendWith sizer = FL.foldlM' (snocWith sizer)
1740-- Note that the returned array may be a mutated version of original array.
2061-- Note that the returned array may be a mutated version of original array.
1742−-- >>> writeAppend = MutArray.writeAppendWith (* 2)
2063+-- >>> append = MutArray.appendWith (* 2)
2065+{-# INLINE append #-}
2066+append :: forall m a. (MonadIO m, Unbox a) =>
2067+ m (MutArray a) -> Fold m a (MutArray a)
2068+append = appendWith (* 2)
2070+-- XXX Deprecate in major
2071+-- {-# DEPRECATED writeAppend "Please use append instead." #-}
1744{-# INLINE writeAppend #-}
2072{-# INLINE writeAppend #-}
1745writeAppend :: forall m a. (MonadIO m, Unbox a) =>
2073writeAppend :: forall m a. (MonadIO m, Unbox a) =>
1746 m (MutArray a) -> Fold m a (MutArray a)
2074 m (MutArray a) -> Fold m a (MutArray a)
1747−writeAppend = writeAppendWith (* 2)
2075+writeAppend = append
1749-- XXX We can carry bound as well in the state to make sure we do not lose the
2077-- XXX We can carry bound as well in the state to make sure we do not lose the
1750-- remaining capacity. Need to check perf impact.
2078-- remaining capacity. Need to check perf impact.
1752−-- | Like 'writeNUnsafe' but takes a new array allocator @alloc size@ function
2080+-- | Like 'unsafeCreateOf' but takes a new array allocator @alloc size@
1753−-- as argument.
2081+-- function as argument.
1755−-- >>> writeNWithUnsafe alloc n = MutArray.writeAppendNUnsafe (alloc n) n
2083+-- >>> unsafeCreateOfWith alloc n = MutArray.unsafeAppendN (alloc n) n
1757-- /Pre-release/
2085-- /Pre-release/
1758−{-# INLINE_NORMAL writeNWithUnsafe #-}
2086+{-# INLINE_NORMAL unsafeCreateOfWith #-}
1759−writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)
2087+unsafeCreateOfWith :: forall m a. (MonadIO m, Unbox a)
1760 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2088 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1761−writeNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
2089+unsafeCreateOfWith alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
1765 initial = toArrayUnsafe <$> alloc (max n 0)
2093 initial = toArrayUnsafe <$> alloc (max n 0)
1767 step (ArrayUnsafe contents start end) x = do
2095 step (ArrayUnsafe contents start end) x = do
1768− liftIO $ pokeByteIndex end contents x
2096+ liftIO $ pokeAt end contents x
1770 $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
2098 $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
2100+{-# DEPRECATED writeNWithUnsafe "Please use unsafeCreateOfWith instead." #-}
2101+{-# INLINE writeNWithUnsafe #-}
2102+writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)
2103+ => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2104+writeNWithUnsafe = unsafeCreateOfWith
1772{-# INLINE_NORMAL writeNUnsafeAs #-}
2106{-# INLINE_NORMAL writeNUnsafeAs #-}
1773writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)
2107writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)
1774 => PinnedState -> Int -> Fold m a (MutArray a)
2108 => PinnedState -> Int -> Fold m a (MutArray a)
1775−writeNUnsafeAs ps = writeNWithUnsafe (newAs ps)
2109+writeNUnsafeAs ps = unsafeCreateOfWith (newAs ps)
1777−-- | Like 'writeN' but does not check the array bounds when writing. The fold
2111+-- | Like 'createOf' but does not check the array bounds when writing. The fold
1778-- driver must not call the step function more than 'n' times otherwise it will
2112-- driver must not call the step function more than 'n' times otherwise it will
1779-- corrupt the memory and crash. This function exists mainly because any
2113-- corrupt the memory and crash. This function exists mainly because any
1780-- conditional in the step function blocks fusion causing 10x performance
2114-- conditional in the step function blocks fusion causing 10x performance
1781-- slowdown.
2115-- slowdown.
1783−-- >>> writeNUnsafe = MutArray.writeNWithUnsafe MutArray.new
2117+-- >>> unsafeCreateOf = MutArray.unsafeCreateOfWith MutArray.emptyOf
2119+{-# INLINE_NORMAL unsafeCreateOf #-}
2120+unsafeCreateOf :: forall m a. (MonadIO m, Unbox a)
2121+ => Int -> Fold m a (MutArray a)
2122+unsafeCreateOf = writeNUnsafeAs Unpinned
2124+{-# DEPRECATED writeNUnsafe "Please use unsafeCreateOf instead." #-}
1785−{-# INLINE_NORMAL writeNUnsafe #-}
2125+{-# INLINE writeNUnsafe #-}
1786writeNUnsafe :: forall m a. (MonadIO m, Unbox a)
2126writeNUnsafe :: forall m a. (MonadIO m, Unbox a)
1787 => Int -> Fold m a (MutArray a)
2127 => Int -> Fold m a (MutArray a)
1788−writeNUnsafe = writeNUnsafeAs Unpinned
2128+writeNUnsafe = unsafeCreateOf
2130+-- | Like 'unsafeCreateOf' but creates a pinned array.
2131+{-# INLINE_NORMAL unsafePinnedCreateOf #-}
2132+unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a)
2133+ => Int -> Fold m a (MutArray a)
2134+unsafePinnedCreateOf = writeNUnsafeAs Pinned
1790−-- | Like 'writeNUnsafe' but creates a pinned array.
2136+{-# DEPRECATED pinnedWriteNUnsafe "Please use unsafePinnedCreateOf instead." #-}
1791−{-# INLINE_NORMAL pinnedWriteNUnsafe #-}
2137+{-# INLINE pinnedWriteNUnsafe #-}
1792pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)
2138pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)
1793 => Int -> Fold m a (MutArray a)
2139 => Int -> Fold m a (MutArray a)
1794−pinnedWriteNUnsafe = writeNUnsafeAs Pinned
2140+pinnedWriteNUnsafe = unsafePinnedCreateOf
1796−-- | @writeNWith alloc n@ folds a maximum of @n@ elements into an array
2142+-- | @createOfWith alloc n@ folds a maximum of @n@ elements into an array
1797-- allocated using the @alloc@ function.
2143-- allocated using the @alloc@ function.
1799−-- >>> writeNWith alloc n = Fold.take n (MutArray.writeNWithUnsafe alloc n)
2145+-- >>> createOfWith alloc n = Fold.take n (MutArray.unsafeCreateOfWith alloc n)
1800−-- >>> writeNWith alloc n = MutArray.writeAppendN (alloc n) n
2146+-- >>> createOfWith alloc n = MutArray.appendN (alloc n) n
1802−{-# INLINE_NORMAL writeNWith #-}
2148+{-# INLINE_NORMAL createOfWith #-}
2149+createOfWith :: forall m a. (MonadIO m, Unbox a)
2150+ => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2151+createOfWith alloc n = FL.take n (unsafeCreateOfWith alloc n)
2153+-- {-# DEPRECATED writeNWith "Please use createOfWith instead." #-}
2154+{-# INLINE writeNWith #-}
1803writeNWith :: forall m a. (MonadIO m, Unbox a)
2155writeNWith :: forall m a. (MonadIO m, Unbox a)
1804 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2156 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1805−writeNWith alloc n = FL.take n (writeNWithUnsafe alloc n)
2157+writeNWith = createOfWith
1807{-# INLINE_NORMAL writeNAs #-}
2159{-# INLINE_NORMAL writeNAs #-}
1808writeNAs ::
2160writeNAs ::
@@ -1810,28 +2162,42 @@ writeNAs ::
1810 => PinnedState
2162 => PinnedState
1812 -> Fold m a (MutArray a)
2164 -> Fold m a (MutArray a)
1813−writeNAs ps = writeNWith (newAs ps)
2165+writeNAs ps = createOfWith (newAs ps)
1815−-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an
2167+-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an
1816-- 'MutArray'.
2168-- 'MutArray'.
1818−-- >>> writeN = MutArray.writeNWith MutArray.new
2170+-- >>> createOf = MutArray.createOfWith MutArray.new
1819−-- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)
2171+-- >>> createOf n = Fold.take n (MutArray.unsafeCreateOf n)
1820−-- >>> writeN n = MutArray.writeAppendN n (MutArray.new n)
2172+-- >>> createOf n = MutArray.appendN n (MutArray.emptyOf n)
1822−{-# INLINE_NORMAL writeN #-}
2174+{-# INLINE_NORMAL createOf #-}
2175+createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2176+createOf = writeNAs Unpinned
2178+-- XXX Deprecate in major
2179+-- {-# DEPRECATED writeN "Please use createOf instead." #-}
2180+{-# INLINE writeN #-}
1823writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2181writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
1824−writeN = writeNAs Unpinned
2182+writeN = createOf
1826−-- | Like 'writeN' but creates a pinned array.
2184+-- | Like 'createOf' but creates a pinned array.
2185+{-# INLINE_NORMAL pinnedCreateOf #-}
2187+ forall m a. (MonadIO m, Unbox a)
2189+ -> Fold m a (MutArray a)
2190+pinnedCreateOf = writeNAs Pinned
2192+{-# DEPRECATED pinnedWriteN "Please use pinnedCreateOf instead." #-}
1827−{-# INLINE_NORMAL pinnedWriteN #-}
2193+{-# INLINE pinnedWriteN #-}
1828pinnedWriteN ::
2194pinnedWriteN ::
1829 forall m a. (MonadIO m, Unbox a)
2195 forall m a. (MonadIO m, Unbox a)
1831 -> Fold m a (MutArray a)
2197 -> Fold m a (MutArray a)
1832−pinnedWriteN = writeNAs Pinned
2198+pinnedWriteN = pinnedCreateOf
1834−-- | Like writeNWithUnsafe but writes the array in reverse order.
2200+-- | Like unsafeCreateOfWith but writes the array in reverse order.
1836-- /Internal/
2202-- /Internal/
1837{-# INLINE_NORMAL writeRevNWithUnsafe #-}
2203{-# INLINE_NORMAL writeRevNWithUnsafe #-}
@@ -1848,11 +2214,11 @@ writeRevNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
1849 step (ArrayUnsafe contents start end) x = do
2215 step (ArrayUnsafe contents start end) x = do
1850 let ptr = INDEX_PREV(start,a)
2216 let ptr = INDEX_PREV(start,a)
1851− liftIO $ pokeByteIndex ptr contents x
2217+ liftIO $ pokeAt ptr contents x
1853 $ ArrayUnsafe contents ptr end
2219 $ ArrayUnsafe contents ptr end
1855−-- | Like writeNWith but writes the array in reverse order.
2221+-- | Like createOfWith but writes the array in reverse order.
1857-- /Internal/
2223-- /Internal/
1858{-# INLINE_NORMAL writeRevNWith #-}
2224{-# INLINE_NORMAL writeRevNWith #-}
@@ -1860,31 +2226,36 @@ writeRevNWith :: forall m a. (MonadIO m, Unbox a)
1860 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2226 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1861writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)
2227writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)
1863−-- | Like writeN but writes the array in reverse order.
2229+-- | Like 'createOf' but writes the array in reverse order.
1865-- /Pre-release/
2231-- /Pre-release/
1866−{-# INLINE_NORMAL writeRevN #-}
2232+{-# INLINE_NORMAL revCreateOf #-}
2233+revCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2234+revCreateOf = writeRevNWith new
2236+{-# DEPRECATED writeRevN "Please use revCreateOf instead." #-}
2237+{-# INLINE writeRevN #-}
1867writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2238writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
1868−writeRevN = writeRevNWith new
2239+writeRevN = revCreateOf
1870-- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the
2241-- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the
1871-- input stream to a 'MutArray' aligned to the given size.
2242-- input stream to a 'MutArray' aligned to the given size.
1873−-- >>> pinnedWriteNAligned align = MutArray.writeNWith (MutArray.pinnedNewAligned align)
2244+-- >>> pinnedWriteNAligned align = MutArray.createOfWith (MutArray.pinnedNewAligned align)
1874−-- >>> pinnedWriteNAligned align n = MutArray.writeAppendN n (MutArray.pinnedNewAligned align n)
2245+-- >>> pinnedWriteNAligned align n = MutArray.appendN n (MutArray.pinnedNewAligned align n)
1876-- /Pre-release/
2247-- /Pre-release/
1878{-# INLINE_NORMAL pinnedWriteNAligned #-}
2249{-# INLINE_NORMAL pinnedWriteNAligned #-}
1879pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)
2250pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)
1880 => Int -> Int -> Fold m a (MutArray a)
2251 => Int -> Int -> Fold m a (MutArray a)
1881−pinnedWriteNAligned align = writeNWith (pinnedNewAligned align)
2252+pinnedWriteNAligned align = createOfWith (pinnedNewAligned align)
1883-- XXX Buffer to a list instead?
2254-- XXX Buffer to a list instead?
1885-- | Buffer a stream into a stream of arrays.
2256-- | Buffer a stream into a stream of arrays.
1887−-- >>> writeChunks n = Fold.many (MutArray.writeN n) Fold.toStreamK
2258+-- >>> buildChunks n = Fold.many (MutArray.createOf n) Fold.toStreamK
1889-- Breaking an array into an array stream can be useful to consume a large
2260-- Breaking an array into an array stream can be useful to consume a large
1890-- array sequentially such that memory of the array is released incrementatlly.
2261-- array sequentially such that memory of the array is released incrementatlly.
@@ -1893,37 +2264,43 @@ pinnedWriteNAligned align = writeNWith (pinnedNewAligned align)
1894-- /Unimplemented/
2265-- /Unimplemented/
1896−{-# INLINE_NORMAL writeChunks #-}
2267+{-# INLINE_NORMAL buildChunks #-}
2268+buildChunks :: (MonadIO m, Unbox a) =>
2269+ Int -> Fold m a (StreamK n (MutArray a))
2270+buildChunks n = FL.many (createOf n) FL.toStreamK
2272+{-# DEPRECATED writeChunks "Please use buildChunks instead." #-}
2273+{-# INLINE writeChunks #-}
1897writeChunks :: (MonadIO m, Unbox a) =>
2274writeChunks :: (MonadIO m, Unbox a) =>
1898 Int -> Fold m a (StreamK n (MutArray a))
2275 Int -> Fold m a (StreamK n (MutArray a))
1899−writeChunks n = FL.many (writeN n) FL.toStreamK
2276+writeChunks = buildChunks
1901{-# INLINE_NORMAL writeWithAs #-}
2278{-# INLINE_NORMAL writeWithAs #-}
1902writeWithAs :: forall m a. (MonadIO m, Unbox a)
2279writeWithAs :: forall m a. (MonadIO m, Unbox a)
1903 => PinnedState -> Int -> Fold m a (MutArray a)
2280 => PinnedState -> Int -> Fold m a (MutArray a)
1904−-- writeWithAs ps n = FL.rmapM rightSize $ writeAppendWith (* 2) (newAs ps n)
2281+-- writeWithAs ps n = FL.rmapM rightSize $ appendWith (* 2) (newAs ps n)
1905writeWithAs ps elemCount =
2282writeWithAs ps elemCount =
1906 FL.rmapM extract $ FL.foldlM' step initial
2283 FL.rmapM extract $ FL.foldlM' step initial
1910 initial = do
2287 initial = do
1911− when (elemCount < 0) $ error "writeWith: elemCount is negative"
2288+ when (elemCount < 0) $ error "createWith: elemCount is negative"
1912− liftIO $ newAs ps elemCount
2289+ newAs ps elemCount
1914 step arr@(MutArray _ start end bound) x
2291 step arr@(MutArray _ start end bound) x
1915 | INDEX_NEXT(end,a) > bound = do
2292 | INDEX_NEXT(end,a) > bound = do
1916 let oldSize = end - start
2293 let oldSize = end - start
1917 newSize = max (oldSize * 2) 1
2294 newSize = max (oldSize * 2) 1
1918− arr1 <- liftIO $ reallocExplicit (SIZE_OF(a)) newSize arr
2295+ arr1 <- liftIO $ reallocExplicitAs ps (SIZE_OF(a)) newSize arr
1919 snocUnsafe arr1 x
2296 snocUnsafe arr1 x
1920 step arr x = snocUnsafe arr x
2297 step arr x = snocUnsafe arr x
1922 extract = liftIO . rightSize
2299 extract = liftIO . rightSize
1924−-- XXX Compare writeWith with fromStreamD which uses an array of streams
2301+-- XXX Compare createWith with fromStreamD which uses an array of streams
1925−-- implementation. We can write this using writeChunks above if that is faster.
2302+-- implementation. We can write this using buildChunks above if that is faster.
1926−-- If writeWith is faster then we should use that to implement
2303+-- If createWith is faster then we should use that to implement
1927-- fromStreamD.
2304-- fromStreamD.
1929-- XXX The realloc based implementation needs to make one extra copy if we use
2306-- XXX The realloc based implementation needs to make one extra copy if we use
@@ -1938,39 +2315,56 @@ writeWithAs ps elemCount =
1938-- XXX check if GHC's memory allocator is efficient enough. We can try the C
2315-- XXX check if GHC's memory allocator is efficient enough. We can try the C
1939-- malloc to compare against.
2316-- malloc to compare against.
1941−-- | @writeWith minCount@ folds the whole input to a single array. The array
2318+-- | @createWith minCount@ folds the whole input to a single array. The array
1942-- starts at a size big enough to hold minCount elements, the size is doubled
2319-- starts at a size big enough to hold minCount elements, the size is doubled
1943-- every time the array needs to be grown.
2320-- every time the array needs to be grown.
1945-- /Caution! Do not use this on infinite streams./
2322-- /Caution! Do not use this on infinite streams./
1947−-- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.new n)
2324+-- >>> f n = MutArray.appendWith (* 2) (MutArray.emptyOf n)
1948−-- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)
2325+-- >>> createWith n = Fold.rmapM MutArray.rightSize (f n)
1949−-- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)
2326+-- >>> createWith n = Fold.rmapM MutArray.fromChunksK (MutArray.buildChunks n)
1951-- /Pre-release/
2328-- /Pre-release/
1952−{-# INLINE_NORMAL writeWith #-}
2329+{-# INLINE_NORMAL createWith #-}
2330+createWith :: forall m a. (MonadIO m, Unbox a)
2331+ => Int -> Fold m a (MutArray a)
2332+-- createWith n = FL.rmapM rightSize $ appendWith (* 2) (emptyOf n)
2333+createWith = writeWithAs Unpinned
2335+{-# DEPRECATED writeWith "Please use createWith instead." #-}
2336+{-# INLINE writeWith #-}
1953writeWith :: forall m a. (MonadIO m, Unbox a)
2337writeWith :: forall m a. (MonadIO m, Unbox a)
1954 => Int -> Fold m a (MutArray a)
2338 => Int -> Fold m a (MutArray a)
1955−-- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (new n)
2339+writeWith = createWith
1956−writeWith = writeWithAs Unpinned
1958-- | Fold the whole input to a single array.
2341-- | Fold the whole input to a single array.
1960−-- Same as 'writeWith' using an initial array size of 'arrayChunkBytes' bytes
2343+-- Same as 'createWith' using an initial array size of 'arrayChunkBytes' bytes
1961-- rounded up to the element size.
2344-- rounded up to the element size.
1963-- /Caution! Do not use this on infinite streams./
2346-- /Caution! Do not use this on infinite streams./
2348+{-# INLINE create #-}
2349+create :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2350+create = createWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
2352+-- XXX Deprecate in major
2353+-- {-# DEPRECATED write "Please use create instead." #-}
1965{-# INLINE write #-}
2354{-# INLINE write #-}
1966write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2355write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
1967−write = writeWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
2356+write = create
1969−-- | Like 'write' but creates a pinned array.
2358+-- | Like 'create' but creates a pinned array.
2359+{-# INLINE pinnedCreate #-}
2360+pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2362+ writeWithAs Pinned (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
2364+{-# DEPRECATED pinnedWrite "Please use pinnedCreate instead." #-}
1970{-# INLINE pinnedWrite #-}
2365{-# INLINE pinnedWrite #-}
1971pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2366pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
1972−pinnedWrite =
2367+pinnedWrite = pinnedCreate
1973− writeWithAs Pinned (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
1975-------------------------------------------------------------------------------
2369-------------------------------------------------------------------------------
1976-- construct from streams, known size
2370-- construct from streams, known size
@@ -1980,25 +2374,31 @@ pinnedWrite =
1980fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)
2374fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)
1981 => PinnedState -> Int -> D.Stream m a -> m (MutArray a)
2375 => PinnedState -> Int -> D.Stream m a -> m (MutArray a)
1982fromStreamDNAs ps limit str = do
2376fromStreamDNAs ps limit str = do
1983− (arr :: MutArray a) <- liftIO $ newAs ps limit
2377+ (arr :: MutArray a) <- newAs ps limit
1984 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str
2378 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str
1985 return $ arr {arrEnd = end}
2379 return $ arr {arrEnd = end}
1989 fwrite arrContents ptr x = do
2383 fwrite arrContents ptr x = do
1990− liftIO $ pokeByteIndex ptr arrContents x
2384+ liftIO $ pokeAt ptr arrContents x
1991 return $ INDEX_NEXT(ptr,a)
2385 return $ INDEX_NEXT(ptr,a)
1993−-- | Use the 'writeN' fold instead.
2387+-- | Use the 'createOf' fold instead.
1995−-- >>> fromStreamDN n = Stream.fold (MutArray.writeN n)
2389+-- >>> fromStreamN n = Stream.fold (MutArray.createOf n)
2391+{-# INLINE_NORMAL fromStreamN #-}
2392+fromStreamN :: forall m a. (MonadIO m, Unbox a)
2393+ => Int -> D.Stream m a -> m (MutArray a)
2394+-- fromStreamDN n = D.fold (createOf n)
2395+fromStreamN = fromStreamDNAs Unpinned
2397+{-# DEPRECATED fromStreamDN "Please use fromStreamN instead." #-}
1997−{-# INLINE_NORMAL fromStreamDN #-}
2398+{-# INLINE fromStreamDN #-}
1998fromStreamDN :: forall m a. (MonadIO m, Unbox a)
2399fromStreamDN :: forall m a. (MonadIO m, Unbox a)
1999 => Int -> D.Stream m a -> m (MutArray a)
2400 => Int -> D.Stream m a -> m (MutArray a)
2000−-- fromStreamDN n = D.fold (writeN n)
2401+fromStreamDN = fromStreamN
2001−fromStreamDN = fromStreamDNAs Unpinned
2003-- | Create a 'MutArray' from the first N elements of a list. The array is
2403-- | Create a 'MutArray' from the first N elements of a list. The array is
2004-- allocated to size N, if the list terminates before N elements then the
2404-- allocated to size N, if the list terminates before N elements then the
@@ -2018,16 +2418,70 @@ pinnedFromListN n xs = fromStreamDNAs Pinned n $ D.fromList xs
2018-- /Pre-release/
2418-- /Pre-release/
2019{-# INLINE fromListRevN #-}
2419{-# INLINE fromListRevN #-}
2020fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
2420fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
2021−fromListRevN n xs = D.fold (writeRevN n) $ D.fromList xs
2421+fromListRevN n xs = D.fold (revCreateOf n) $ D.fromList xs
2423+-- | Convert a pure stream in Identity monad to a mutable array.
2424+{-# INLINABLE fromPureStreamN #-}
2425+fromPureStreamN :: (MonadIO m, Unbox a) =>
2426+ Int -> Stream Identity a -> m (MutArray a)
2427+fromPureStreamN n xs =
2428+ D.fold (createOf n) $ D.morphInner (return . runIdentity) xs
2023-- | Convert a pure stream in Identity monad to a mutable array.
2430-- | Convert a pure stream in Identity monad to a mutable array.
2024{-# INLINABLE fromPureStream #-}
2431{-# INLINABLE fromPureStream #-}
2025fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)
2432fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)
2026fromPureStream xs =
2433fromPureStream xs =
2027− liftIO $ D.fold write $ D.morphInner (return . runIdentity) xs
2434+ D.fold create $ D.morphInner (return . runIdentity) xs
2436+{-# INLINABLE fromPtrN #-}
2437+fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)
2438+fromPtrN len addr = do
2439+ -- memcpy is better than stream copy when the size is known.
2440+ -- XXX We can implement a stream copy in a similar way by streaming Word64
2441+ -- first and then remaining Word8.
2443+ _ <- unsafeAsPtr arr
2444+ (\ptr -> liftIO $ c_memcpy ptr addr (fromIntegral len))
2445+ return (arr {arrEnd = len})
2447+{-# INLINABLE fromByteStr# #-}
2448+fromByteStr# :: MonadIO m => Addr# -> m (MutArray Word8)
2449+fromByteStr# addr = do
2450+ -- It is better to count the size first and allocate exact space.
2451+ -- Also, memcpy is better than stream copy when the size is known.
2452+ -- C strlen compares 4 bytes at a time, so is better than the stream
2453+ -- version. https://github.com/bminor/glibc/blob/master/string/strlen.c
2454+ -- XXX We can possibly use a stream of Word64 to do the same.
2455+ -- fromByteStr# addr = fromPureStream (D.fromByteStr# addr)
2456+ len <- liftIO $ c_strlen (Ptr addr)
2457+ let lenInt = fromIntegral len
2459+ _ <- unsafeAsPtr arr (\ptr -> liftIO $ c_memcpy ptr (Ptr addr) len)
2460+ return (arr {arrEnd = lenInt})
2029-------------------------------------------------------------------------------
2462-------------------------------------------------------------------------------
2463+-- convert a stream of arrays to a single array by reallocating and copying
2464+-------------------------------------------------------------------------------
2466+-- XXX Both of these implementations of splicing seem to perform equally well.
2467+-- We need to perform benchmarks over a range of sizes though.
2469+-- | Also see 'fromChunksK'.
2470+{-# INLINE fromChunksRealloced #-}
2471+fromChunksRealloced :: forall m a. (MonadIO m, Unbox a)
2472+ => Stream m (MutArray a) -> m (MutArray a)
2473+fromChunksRealloced s = do
2476+ Just (a, strm) -> do
2477+ arr <- D.foldlM' spliceExp (pure a) strm
2478+ -- Reallocation is exponential so there may be 50% empty space in
2479+ -- worst case. One more reallocation to reclaim the space.
2481+ Nothing -> pure nil
2483+-------------------------------------------------------------------------------
2030−-- convert stream to a single array
2484+-- convert a stream of arrays to a single array by buffering arrays first
2031-------------------------------------------------------------------------------
2485-------------------------------------------------------------------------------
2033{-# INLINE arrayStreamKLength #-}
2487{-# INLINE arrayStreamKLength #-}
@@ -2037,34 +2491,72 @@ arrayStreamKLength as = K.foldl' (+) 0 (K.map length as)
2037-- | Convert an array stream to an array. Note that this requires peak memory
2491-- | Convert an array stream to an array. Note that this requires peak memory
2038-- that is double the size of the array stream.
2492-- that is double the size of the array stream.
2494+{-# INLINE fromChunkskAs #-}
2495+fromChunkskAs :: (Unbox a, MonadIO m) =>
2496+ PinnedState -> StreamK m (MutArray a) -> m (MutArray a)
2497+fromChunkskAs ps as = do
2498+ len <- arrayStreamKLength as
2499+ arr <- newAs ps len
2500+ -- XXX is StreamK fold faster or StreamD fold?
2501+ K.foldlM' spliceUnsafe (pure arr) as
2502+ -- fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as
2504+-- XXX Need to compare this with fromChunks and fromChunkList and keep the
2505+-- fastest or simplest one if all are equally fast.
2507+-- | Convert an array stream to an array. Note that this requires peak memory
2508+-- that is double the size of the array stream.
2510+-- Also see 'fromChunksRealloced'.
2512+{-# INLINE fromChunksK #-}
2513+fromChunksK :: (Unbox a, MonadIO m) =>
2514+ StreamK m (MutArray a) -> m (MutArray a)
2515+fromChunksK = fromChunkskAs Unpinned
2517+{-# DEPRECATED fromArrayStreamK "Please use fromChunksK instead." #-}
2040{-# INLINE fromArrayStreamK #-}
2518{-# INLINE fromArrayStreamK #-}
2041fromArrayStreamK :: (Unbox a, MonadIO m) =>
2519fromArrayStreamK :: (Unbox a, MonadIO m) =>
2042 StreamK m (MutArray a) -> m (MutArray a)
2520 StreamK m (MutArray a) -> m (MutArray a)
2043−fromArrayStreamK as = do
2521+fromArrayStreamK = fromChunksK
2044− len <- arrayStreamKLength as
2045− fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as
2047{-# INLINE fromStreamDAs #-}
2523{-# INLINE fromStreamDAs #-}
2048fromStreamDAs ::
2524fromStreamDAs ::
2049 (MonadIO m, Unbox a) => PinnedState -> D.Stream m a -> m (MutArray a)
2525 (MonadIO m, Unbox a) => PinnedState -> D.Stream m a -> m (MutArray a)
2526+fromStreamDAs ps m =
2050−fromStreamDAs ps m = arrayStreamKFromStreamDAs ps m >>= fromArrayStreamK
2527+ arrayStreamKFromStreamDAs Unpinned m >>= fromChunkskAs ps
2529+-- | Create an 'Array' from a stream. This is useful when we want to create a
2530+-- single array from a stream of unknown size. 'createOf' is at least twice
2531+-- as efficient when the size is already known.
2533+-- Note that if the input stream is too large memory allocation for the array
2534+-- may fail. When the stream size is not known, `chunksOf` followed by
2535+-- processing of indvidual arrays in the resulting stream should be preferred.
2538+{-# INLINE fromStream #-}
2539+fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)
2540+fromStream = fromStreamDAs Unpinned
2542+-- fromStream (Stream m) = P.fold create m
2052-- CAUTION: a very large number (millions) of arrays can degrade performance
2543-- CAUTION: a very large number (millions) of arrays can degrade performance
2053-- due to GC overhead because we need to buffer the arrays before we flatten
2544-- due to GC overhead because we need to buffer the arrays before we flatten
2054-- all the arrays.
2545-- all the arrays.
2056−-- XXX Compare if this is faster or "fold write".
2547+-- XXX Compare if this is faster or "fold create".
2058-- | We could take the approach of doubling the memory allocation on each
2549-- | We could take the approach of doubling the memory allocation on each
2059-- overflow. This would result in more or less the same amount of copying as in
2550-- overflow. This would result in more or less the same amount of copying as in
2060-- the chunking approach. However, if we have to shrink in the end then it may
2551-- the chunking approach. However, if we have to shrink in the end then it may
2061-- result in an extra copy of the entire data.
2552-- result in an extra copy of the entire data.
2063−-- >>> fromStreamD = StreamD.fold MutArray.write
2554+-- >>> fromStreamD = StreamD.fold MutArray.create
2065{-# INLINE fromStreamD #-}
2556{-# INLINE fromStreamD #-}
2557+{-# DEPRECATED fromStreamD "Please use fromStream instead." #-}
2066fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)
2558fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)
2067−fromStreamD = fromStreamDAs Unpinned
2559+fromStreamD = fromStream
2069-- | Create a 'MutArray' from a list. The list must be of finite size.
2561-- | Create a 'MutArray' from a list. The list must be of finite size.
@@ -2086,24 +2578,52 @@ fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)
2086fromListRev xs = fromListRevN (Prelude.length xs) xs
2578fromListRev xs = fromListRevN (Prelude.length xs) xs
2088-------------------------------------------------------------------------------
2580-------------------------------------------------------------------------------
2089−-- Combining
2581+-- Cloning
2090-------------------------------------------------------------------------------
2582-------------------------------------------------------------------------------
2092−-- | Put a sub range of a source array into a subrange of a destination array.
2584+-- Arrays are aligned on 64-bit boundaries. The fastest way to copy an array is
2093−-- This is not safe as it does not check the bounds.
2585+-- to unsafeCast it to Word64, read it, write it to Word64 array and unsafeCast
2094−{-# INLINE putSliceUnsafe #-}
2586+-- it again. We can use SIMD read/write as well.
2095−putSliceUnsafe :: MonadIO m => MutArray a -> Int -> MutArray a -> Int -> Int -> m ()
2587+
2096−putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do
2588+{-# INLINE cloneAs #-}
2097− assertM(lenBytes <= arrBound dst - dstStartBytes)
2589+cloneAs ::
2098− assertM(lenBytes <= arrEnd src - srcStartBytes)
2590+ ( MonadIO m
2099− let !(I# srcStartBytes#) = srcStartBytes
2591+#ifdef DEVBUILD
2100− !(I# dstStartBytes#) = dstStartBytes
2592+ , Unbox a
2101− !(I# lenBytes#) = lenBytes
2593+#endif
2102− let arrS# = getMutableByteArray# (arrContents src)
2594+ )
2103− arrD# = getMutableByteArray# (arrContents dst)
2595+ => PinnedState -> MutArray a -> m (MutArray a)
2104− IO $ \s# -> (# copyMutableByteArray#
2596+cloneAs ps src =
2105− arrS# srcStartBytes# arrD# dstStartBytes# lenBytes# s#
2597+ do
2106− , () #)
2598+ let startSrc = arrStart src
2599+ srcLen = arrEnd src - startSrc
2601+ Unboxed.cloneSliceUnsafeAs ps startSrc srcLen (arrContents src)
2602+ return $ MutArray newArrContents 0 srcLen srcLen
2604+{-# INLINE clone #-}
2611+ => MutArray a -> m (MutArray a)
2612+clone = cloneAs Unpinned
2614+{-# INLINE pinnedClone #-}
2621+ => MutArray a -> m (MutArray a)
2622+pinnedClone = cloneAs Pinned
2624+-------------------------------------------------------------------------------
2626+-------------------------------------------------------------------------------
2108-- | Copy two arrays into a newly allocated array. If the first array is pinned
2628-- | Copy two arrays into a newly allocated array. If the first array is pinned
2109-- the spliced array is also pinned.
2629-- the spliced array is also pinned.
@@ -2113,21 +2633,19 @@ spliceCopy :: forall m a. MonadIO m =>
2113 Unbox a =>
2633 Unbox a =>
2115 MutArray a -> MutArray a -> m (MutArray a)
2635 MutArray a -> MutArray a -> m (MutArray a)
2116−spliceCopy arr1 arr2 = liftIO $ do
2636+spliceCopy arr1 arr2 = do
2117 let start1 = arrStart arr1
2637 let start1 = arrStart arr1
2118 start2 = arrStart arr2
2638 start2 = arrStart arr2
2119 len1 = arrEnd arr1 - start1
2639 len1 = arrEnd arr1 - start1
2120 len2 = arrEnd arr2 - start2
2640 len2 = arrEnd arr2 - start2
2121− let newLen = len1 + len2
2641+ let len = len1 + len2
2122 newArrContents <-
2642 newArrContents <-
2123 if Unboxed.isPinned (arrContents arr1)
2643 if Unboxed.isPinned (arrContents arr1)
2124− then Unboxed.pinnedNewBytes newLen
2644+ then liftIO $ Unboxed.pinnedNew len
2125− else Unboxed.newBytes newLen
2645+ else liftIO $ Unboxed.new len
2126− let len = len1 + len2
2127− newArr = MutArray newArrContents 0 len len
2128− putSliceUnsafe arr1 start1 newArr 0 len1
2646+ putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1
2129− putSliceUnsafe arr2 start2 newArr len1 len2
2647+ putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2
2130− return newArr
2648+ return $ MutArray newArrContents 0 len len
2132-- | Really really unsafe, appends the second array into the first array. If
2650-- | Really really unsafe, appends the second array into the first array. If
2133-- the first array does not have enough space it may cause silent data
2651-- the first array does not have enough space it may cause silent data
@@ -2136,12 +2654,13 @@ spliceCopy arr1 arr2 = liftIO $ do
2136spliceUnsafe :: MonadIO m =>
2654spliceUnsafe :: MonadIO m =>
2137 MutArray a -> MutArray a -> m (MutArray a)
2655 MutArray a -> MutArray a -> m (MutArray a)
2138spliceUnsafe dst src =
2656spliceUnsafe dst src =
2139− liftIO $ do
2657+ do
2140 let startSrc = arrStart src
2658 let startSrc = arrStart src
2141 srcLen = arrEnd src - startSrc
2659 srcLen = arrEnd src - startSrc
2142 endDst = arrEnd dst
2660 endDst = arrEnd dst
2143 assertM(endDst + srcLen <= arrBound dst)
2661 assertM(endDst + srcLen <= arrBound dst)
2144− putSliceUnsafe src startSrc dst endDst srcLen
2663+ (arrContents src) startSrc (arrContents dst) endDst srcLen
2145 return $ dst {arrEnd = endDst + srcLen}
2664 return $ dst {arrEnd = endDst + srcLen}
2147-- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no
2666-- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no
@@ -2157,7 +2676,7 @@ spliceWith :: forall m a. (MonadIO m, Unbox a) =>
2157 (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
2676 (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
2158spliceWith sizer dst@(MutArray _ start end bound) src = do
2677spliceWith sizer dst@(MutArray _ start end bound) src = do
2160− let f = writeAppendWith (`sizer` byteLength src) (return dst)
2679+ let f = appendWith (`sizer` byteLength src) (return dst)
2161 in D.fold f (toStreamD src)
2680 in D.fold f (toStreamD src)
2163 assert (end <= bound) (return ())
2682 assert (end <= bound) (return ())
@@ -2173,7 +2692,7 @@ spliceWith sizer dst@(MutArray _ start end bound) src = do
2173 $ "splice: newSize is less than the total size "
2692 $ "splice: newSize is less than the total size "
2174 ++ "of arrays being appended. Please check the "
2693 ++ "of arrays being appended. Please check the "
2175 ++ "sizer function passed."
2694 ++ "sizer function passed."
2176− liftIO $ realloc newSizeInBytes dst
2695+ realloc newSizeInBytes dst
2177 else return dst
2696 else return dst
2178 spliceUnsafe dst1 src
2697 spliceUnsafe dst1 src
@@ -2210,14 +2729,24 @@ spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))
2210-- Splitting
2729-- Splitting
2211-------------------------------------------------------------------------------
2730-------------------------------------------------------------------------------
2732+-- | Generate a stream of array slices using a predicate. The array element
2733+-- matching the predicate is dropped.
2736+{-# INLINE splitOn #-}
2737+splitOn :: (MonadIO m, Unbox a) =>
2738+ (a -> Bool) -> MutArray a -> Stream m (MutArray a)
2739+splitOn predicate arr =
2740+ fmap (\(i, len) -> getSliceUnsafe i len arr)
2741+ $ D.indexOnSuffix predicate (read arr)
2213-- | Drops the separator byte
2743-- | Drops the separator byte
2214{-# INLINE breakOn #-}
2744{-# INLINE breakOn #-}
2215breakOn :: MonadIO m
2745breakOn :: MonadIO m
2216 => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
2746 => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
2217−breakOn sep arr@MutArray{..} = asPtrUnsafe arr $ \p -> liftIO $ do
2747+breakOn sep arr@MutArray{..} = unsafeAsPtr arr $ \p -> liftIO $ do
2218− -- XXX Instead of using asPtrUnsafe (pinning memory) we can pass unlifted
2219− -- Addr# to memchr and it should be safe (from ghc 8.4).
2220 -- XXX We do not need memchr here, we can use a Haskell equivalent.
2748 -- XXX We do not need memchr here, we can use a Haskell equivalent.
2749+ -- Need efficient stream based primitives that work on Word64.
2221 loc <- c_memchr p sep (fromIntegral $ byteLength arr)
2750 loc <- c_memchr p sep (fromIntegral $ byteLength arr)
2222 let sepIndex = loc `minusPtr` p
2751 let sepIndex = loc `minusPtr` p
2223 return $
2752 return $
@@ -2238,32 +2767,41 @@ breakOn sep arr@MutArray{..} = asPtrUnsafe arr $ \p -> liftIO $ do
2770+-- | Like 'splitAt' but does not check whether the index is valid.
2772+{-# INLINE unsafeSplitAt #-}
2773+unsafeSplitAt :: forall a. Unbox a =>
2774+ Int -> MutArray a -> (MutArray a, MutArray a)
2775+unsafeSplitAt i MutArray{..} =
2776+ let off = i * SIZE_OF(a)
2779+ { arrContents = arrContents
2780+ , arrStart = arrStart
2785+ { arrContents = arrContents
2788+ , arrBound = arrBound
2241-- | Create two slices of an array without copying the original array. The
2792-- | Create two slices of an array without copying the original array. The
2242-- specified index @i@ is the first index of the second slice.
2793-- specified index @i@ is the first index of the second slice.
2795+{-# INLINE splitAt #-}
2244splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)
2796splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)
2245−splitAt i arr@MutArray{..} =
2797+splitAt i arr =
2246 let maxIndex = length arr - 1
2798 let maxIndex = length arr - 1
2247 in if i < 0
2799 in if i < 0
2248 then error "sliceAt: negative array index"
2800 then error "sliceAt: negative array index"
2249 else if i > maxIndex
2801 else if i > maxIndex
2250 then error $ "sliceAt: specified array index " ++ show i
2802 then error $ "sliceAt: specified array index " ++ show i
2251 ++ " is beyond the maximum index " ++ show maxIndex
2803 ++ " is beyond the maximum index " ++ show maxIndex
2252− else let off = i * SIZE_OF(a)
2804+ else unsafeSplitAt i arr
2255− { arrContents = arrContents
2256− , arrStart = arrStart
2261− { arrContents = arrContents
2264− , arrBound = arrBound
2268-------------------------------------------------------------------------------
2806-------------------------------------------------------------------------------
2269-- Casting
2807-- Casting
@@ -2313,13 +2851,16 @@ cast arr =
2313-- guarantees that unsafe calls will be performed in the calling thread. Making
2851-- guarantees that unsafe calls will be performed in the calling thread. Making
2314-- it safe to pass heap-allocated objects to unsafe functions.
2852-- it safe to pass heap-allocated objects to unsafe functions.
2316−-- Unsafe because of direct pointer operations. The user must ensure that they
2317−-- are writing within the legal bounds of the array. Should we just name it
2318−-- asPtr, the unsafety is implicit for any pointer operations. And we are safe
2854+-- XXX Should we just name it asPtr, the unsafety is implicit for any pointer
2319−-- from Haskell perspective because we will be pinning the memory.
2855+-- operations. And we are safe from Haskell perspective because we will be
2856+-- pinning the memory.
2858+-- XXX we cannot pass the length of the ptr here as in some cases it may not be
2859+-- available e.g. a null terminated C string. However, we can create another
2860+-- flavor of the API e.g. asPtrN.
2321−-- | Use an @MutArray a@ as @Ptr a@. This is useful when we want to pass an array
2862+-- | Use a @MutArray a@ as @Ptr a@. This is useful when we want to pass an
2322−-- as a pointer to some operating system call or to a "safe" FFI call.
2863+-- array as a pointer to some operating system call or to a "safe" FFI call.
2324-- If the array is not pinned it is copied to pinned memory before passing it
2865-- If the array is not pinned it is copied to pinned memory before passing it
2325-- to the monadic action.
2866-- to the monadic action.
@@ -2329,56 +2870,382 @@ cast arr =
2329-- opportunistically before this operation occurs, to avoid the cost of a copy
2870-- opportunistically before this operation occurs, to avoid the cost of a copy
2330-- if possible.
2871-- if possible.
2332−-- /Unsafe/
2873+-- /Unsafe/ because of direct pointer operations. The user must ensure that
2874+-- they are writing within the legal bounds of the array.
2334-- /Pre-release/
2876-- /Pre-release/
2878+{-# INLINE unsafePinnedAsPtr #-}
2879+unsafePinnedAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2880+unsafePinnedAsPtr arr f =
2881+ Unboxed.unsafePinnedAsPtr
2882+ (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2884+{-# DEPRECATED asPtrUnsafe "Please use unsafePinnedAsPtr instead." #-}
2885+{-# INLINE asPtrUnsafe #-}
2336asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2886asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2337−asPtrUnsafe arr f = do
2887+asPtrUnsafe = unsafePinnedAsPtr
2338− contents <- liftIO $ Unboxed.pin $ arrContents arr
2339− let !ptr = Ptr (byteArrayContents#
2340− (unsafeCoerce# (getMutableByteArray# contents)))
2889+{-# INLINE unsafeAsPtr #-}
2890+unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2892+ Unboxed.unsafeAsPtr
2342− r <- f (ptr `plusPtr` arrStart arr)
2893+ (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2343− liftIO $ touch contents
2346-------------------------------------------------------------------------------
2895-------------------------------------------------------------------------------
2347-- Equality
2896-- Equality
2348-------------------------------------------------------------------------------
2897-------------------------------------------------------------------------------
2350−-- | Compare the length of the arrays. If the length is equal, compare the
2899+-- | Byte compare two arrays. Compare the length of the arrays. If the length
2351−-- lexicographical ordering of two underlying byte arrays otherwise return the
2900+-- is equal, compare the lexicographical ordering of two underlying byte arrays
2352−-- result of length comparison.
2901+-- otherwise return the result of length comparison.
2903+-- /Unsafe/: Note that the 'Unbox' instance of sum types with constructors of
2904+-- different sizes may leave some memory uninitialized which can make byte
2905+-- comparison unreliable.
2354-- /Pre-release/
2907-- /Pre-release/
2908+{-# INLINE byteCmp #-}
2909+byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
2910+byteCmp arr1 arr2 = do
2911+ let marr1 = getMutableByteArray# (arrContents arr1)
2912+ marr2 = getMutableByteArray# (arrContents arr2)
2913+ !(I# st1#) = arrStart arr1
2914+ !(I# st2#) = arrStart arr2
2915+ !(I# len#) = byteLength arr1
2916+ case compare (byteLength arr1) (byteLength arr2) of
2918+ r <- liftIO $ IO $ \s# ->
2921+ (compareByteArrays#
2922+ (unsafeCoerce# marr1)
2924+ (unsafeCoerce# marr2)
2928+ return $ compare r 0
2355{-# INLINE cmp #-}
2931{-# INLINE cmp #-}
2932+{-# DEPRECATED cmp "Please use byteCmp instead." #-}
2356cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
2933cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
2357−cmp arr1 arr2 =
2934+cmp = byteCmp
2359− $ do
2936+-- | Byte equality of two arrays.
2360− let marr1 = getMutableByteArray# (arrContents arr1)
2937+--
2361− marr2 = getMutableByteArray# (arrContents arr2)
2938+-- >>> byteEq arr1 arr2 = (==) EQ $ MArray.byteCmp arr1 arr2
2362− !(I# st1#) = arrStart arr1
2939+--
2363− !(I# st2#) = arrStart arr2
2940+-- /Unsafe/: See 'byteCmp'.
2364− !(I# len#) = byteLength arr1
2941+{-# INLINE byteEq #-}
2365− case compare (byteLength arr1) (byteLength arr2) of
2942+byteEq :: MonadIO m => MutArray a -> MutArray a -> m Bool
2366− EQ -> do
2943+byteEq arr1 arr2 = fmap (EQ ==) $ byteCmp arr1 arr2
2367− r <- liftIO $ IO $ \s# ->
2944+
2368− let res =
2945+-------------------------------------------------------------------------------
2370− (compareByteArrays#
2947+-------------------------------------------------------------------------------
2371− (unsafeCoerce# marr1)
2948+
2372− st1#
2949+-- Note: LE versions avoid an extra copy compared to GE. LE parser trades
2373− (unsafeCoerce# marr2)
2950+-- backtracking one array in lieu of avoiding a copy. However, LE and GE both
2374− st2#
2951+-- can leave some memory unused. They can split the last array to fit it
2375− len#)
2952+-- exactly in the space.
2376− in (# s#, res #)
2953+
2377− return $ compare r 0
2954+{-# INLINE_NORMAL pCompactLeAs #-}
2378− x -> return x
2955+pCompactLeAs ::
2956+ forall m a. (MonadIO m, Unbox a)
2957+ => PinnedState -> Int -> Parser (MutArray a) m (MutArray a)
2958+pCompactLeAs ps maxElems = Parser step initial extract
2962+ maxBytes = maxElems * SIZE_OF(a)
2964+ functionName = "Streamly.Internal.Data.MutArray.pCompactLE"
2971+ ++ ": the size of arrays ["
2972+ ++ show maxElems ++ "] must be a natural number"
2973+ else Parser.IPartial Nothing
2977+ $ let len = byteLength arr
2978+ in if len >= maxBytes
2979+ then Parser.Done 0 arr
2980+ else Parser.Partial 0 (Just arr)
2981+ -- XXX Split the last array to use the space more compactly.
2982+ step (Just buf) arr =
2983+ let len = byteLength buf + byteLength arr
2984+ in if len > maxBytes
2985+ then return $ Parser.Done 1 buf
2988+ if byteCapacity buf < maxBytes
2989+ then liftIO $ reallocExplicitAs
2990+ ps (SIZE_OF(a)) maxBytes buf
2992+ buf2 <- spliceUnsafe buf1 arr
2993+ return $ Parser.Partial 0 (Just buf2)
2995+ extract Nothing = return $ Parser.Done 0 nil
2996+ extract (Just buf) = return $ Parser.Done 0 buf
2998+-- | Parser @pCompactLE maxElems@ coalesces adjacent arrays in the input stream
2999+-- only if the combined size would be less than or equal to @maxElems@
3000+-- elements. Note that it won't split an array if the original array is already
3001+-- larger than maxElems.
3003+-- @maxElems@ must be greater than 0.
3005+-- Generates unpinned arrays irrespective of the pinning status of input
3009+{-# INLINE pCompactLE #-}
3011+ forall m a. (MonadIO m, Unbox a)
3012+ => Int -> Parser (MutArray a) m (MutArray a)
3013+pCompactLE = pCompactLeAs Unpinned
3015+-- | Pinned version of 'pCompactLE'.
3016+{-# INLINE pPinnedCompactLE #-}
3018+ forall m a. (MonadIO m, Unbox a)
3019+ => Int -> Parser (MutArray a) m (MutArray a)
3020+pPinnedCompactLE = pCompactLeAs Pinned
3022+data SpliceState s arr
3024+ | SpliceBuffering s arr
3025+ | SpliceYielding arr (SpliceState s arr)
3028+-- This mutates the first array (if it has space) to append values from the
3029+-- second one. This would work for immutable arrays as well because an
3030+-- immutable array never has additional space so a new array is allocated
3031+-- instead of mutating it.
3033+{-# INLINE_NORMAL compactLeAs #-}
3034+compactLeAs :: forall m a. (MonadIO m, Unbox a)
3035+ => PinnedState -> Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)
3036+compactLeAs ps maxElems (D.Stream step state) =
3037+ D.Stream step' (SpliceInitial state)
3041+ maxBytes = maxElems * SIZE_OF(a)
3043+ functionName = "Streamly.Internal.Data.MutArray.rCompactLE"
3045+ {-# INLINE_LATE step' #-}
3046+ step' gst (SpliceInitial st) = do
3047+ when (maxElems <= 0) $
3048+ -- XXX we can pass the module string from the higher level API
3049+ error $ functionName ++ ": the size of arrays [" ++ show maxElems
3050+ ++ "] must be a natural number"
3053+ D.Yield arr s -> return $
3054+ let len = byteLength arr
3055+ in if len >= maxBytes
3056+ then D.Skip (SpliceYielding arr (SpliceInitial s))
3057+ else D.Skip (SpliceBuffering s arr)
3058+ D.Skip s -> return $ D.Skip (SpliceInitial s)
3059+ D.Stop -> return D.Stop
3061+ -- XXX Split the last array to use the space more compactly.
3062+ step' gst (SpliceBuffering st buf) = do
3065+ D.Yield arr s -> do
3066+ let len = byteLength buf + byteLength arr
3069+ D.Skip (SpliceYielding buf (SpliceBuffering s arr))
3071+ buf1 <- if byteCapacity buf < maxBytes
3072+ then liftIO $ reallocExplicitAs
3073+ ps (SIZE_OF(a)) maxBytes buf
3075+ buf2 <- spliceUnsafe buf1 arr
3076+ return $ D.Skip (SpliceBuffering s buf2)
3077+ D.Skip s -> return $ D.Skip (SpliceBuffering s buf)
3078+ D.Stop -> return $ D.Skip (SpliceYielding buf SpliceFinish)
3080+ step' _ SpliceFinish = return D.Stop
3082+ step' _ (SpliceYielding arr next) = return $ D.Yield arr next
3085+{-# INLINE_NORMAL fCompactGeAs #-}
3087+ forall m a. (MonadIO m, Unbox a)
3088+ => PinnedState -> Int -> FL.Fold m (MutArray a) (MutArray a)
3089+fCompactGeAs ps minElems = Fold step initial extract extract
3093+ minBytes = minElems * SIZE_OF(a)
3095+ functionName = "Streamly.Internal.Data.MutArray.fCompactGE"
3102+ ++ ": the size of arrays ["
3103+ ++ show minElems ++ "] must be a natural number"
3104+ else FL.Partial Nothing
3108+ $ let len = byteLength arr
3109+ in if len >= minBytes
3111+ else FL.Partial (Just arr)
3112+ -- XXX Buffer arrays as a list to avoid copy and reallocations
3113+ step (Just buf) arr = do
3114+ let len = byteLength buf + byteLength arr
3116+ if byteCapacity buf < len
3117+ then liftIO $ reallocExplicitAs
3118+ ps (SIZE_OF(a)) (max minBytes len) buf
3120+ buf2 <- spliceUnsafe buf1 arr
3122+ then return $ FL.Done buf2
3123+ else return $ FL.Partial (Just buf2)
3125+ extract Nothing = return nil
3126+ extract (Just buf) = return buf
3128+-- | Fold @fCompactGE minElems@ coalesces adjacent arrays in the input stream
3129+-- until the size becomes greater than or equal to @minElems@.
3131+-- Generates unpinned arrays irrespective of the pinning status of input
3133+{-# INLINE fCompactGE #-}
3135+ forall m a. (MonadIO m, Unbox a)
3136+ => Int -> FL.Fold m (MutArray a) (MutArray a)
3137+fCompactGE = fCompactGeAs Unpinned
3139+-- | Pinned version of 'fCompactGE'.
3140+{-# INLINE fPinnedCompactGE #-}
3142+ forall m a. (MonadIO m, Unbox a)
3143+ => Int -> FL.Fold m (MutArray a) (MutArray a)
3144+fPinnedCompactGE = fCompactGeAs Pinned
3146+{-# INLINE_NORMAL lCompactGeAs #-}
3147+lCompactGeAs :: forall m a. (MonadIO m, Unbox a)
3148+ => PinnedState -> Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
3149+-- The fold version turns out to be a little bit slower.
3150+-- lCompactGeAs ps n = FL.many (fCompactGeAs ps n)
3151+lCompactGeAs ps minElems (Fold step1 initial1 _ final1) =
3152+ Fold step initial extract final
3156+ minBytes = minElems * SIZE_OF(a)
3158+ functionName = "Streamly.Internal.Data.MutArray.lCompactGE"
3161+ when (minElems <= 0) $
3162+ -- XXX we can pass the module string from the higher level API
3163+ error $ functionName ++ ": the size of arrays ["
3164+ ++ show minElems ++ "] must be a natural number"
3167+ return $ first (Tuple' Nothing) r
3169+ {-# INLINE runInner #-}
3170+ runInner len acc buf =
3175+ FL.Done _ -> return $ FL.Done ()
3179+ return $ first (Tuple' Nothing) res
3180+ else return $ FL.Partial $ Tuple' (Just buf) acc
3182+ step (Tuple' Nothing r1) arr =
3183+ runInner (byteLength arr) r1 arr
3185+ -- XXX Buffer arrays as a list to avoid copy and reallocations
3186+ step (Tuple' (Just buf) r1) arr = do
3187+ let len = byteLength buf + byteLength arr
3188+ buf1 <- if byteCapacity buf < len
3189+ then liftIO $ reallocExplicitAs
3190+ ps (SIZE_OF(a)) (max minBytes len) buf
3192+ buf2 <- spliceUnsafe buf1 arr
3193+ runInner len r1 buf2
3195+ -- XXX Several folds do extract >=> final, therefore, we need to make final
3196+ -- return "m b" rather than using extract post it if we want extract to be
3199+ -- extract forces the pending buffer to be sent to the fold which is not
3201+ extract _ = error "lCompactGE: not designed for scanning"
3203+ final (Tuple' Nothing r1) = final1 r1
3204+ final (Tuple' (Just buf) r1) = do
3207+ FL.Partial rr -> final1 rr
3208+ FL.Done _ -> return ()
3210+-- | Like 'compactGE' but for transforming folds instead of stream.
3212+-- >>> lCompactGE n = Fold.many (MutArray.fCompactGE n)
3214+-- Generates unpinned arrays irrespective of the pinning status of input
3216+{-# INLINE lCompactGE #-}
3217+lCompactGE :: forall m a. (MonadIO m, Unbox a)
3218+ => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
3219+lCompactGE = lCompactGeAs Unpinned
3221+-- | Pinned version of 'lCompactGE'.
3222+{-# INLINE lPinnedCompactGE #-}
3223+lPinnedCompactGE :: forall m a. (MonadIO m, Unbox a)
3224+ => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
3225+lPinnedCompactGE = lCompactGeAs Pinned
3227+-- | @compactGE n stream@ coalesces adjacent arrays in the @stream@ until
3228+-- the size becomes greater than or equal to @n@.
3230+-- >>> compactGE n = Stream.foldMany (MutArray.fCompactGE n)
3232+{-# INLINE compactGE #-}
3234+ (MonadIO m, Unbox a)
3235+ => Int -> Stream m (MutArray a) -> Stream m (MutArray a)
3236+compactGE n = D.foldMany (fCompactGE n)
3238+-- | 'compactEQ n' coalesces adajacent arrays in the input stream to
3239+-- arrays of exact size @n@.
3242+{-# INLINE compactEQ #-}
3243+compactEQ :: -- (MonadIO m, Unbox a) =>
3244+ Int -> Stream m (MutArray a) -> Stream m (MutArray a)
3245+compactEQ _n = undefined -- D.parseManyD (pCompactEQ n)
2380-------------------------------------------------------------------------------
3247-------------------------------------------------------------------------------
2381−-- NFData
3248+-- In-place mutation algorithms
2382-------------------------------------------------------------------------------
3249-------------------------------------------------------------------------------
2384-- | Strip elements which match with predicate from both ends.
3251-- | Strip elements which match with predicate from both ends.
@@ -2407,7 +3274,7 @@ strip eq arr@MutArray{..} = liftIO $ do
2407 getStart cur = do
3274 getStart cur = do
2408 if cur < arrEnd
3275 if cur < arrEnd
2410− r <- peekByteIndex cur arrContents
3277+ r <- peekAt cur arrContents
2412 then getStart (INDEX_NEXT(cur,a))
3279 then getStart (INDEX_NEXT(cur,a))
2413 else return cur
3280 else return cur
@@ -2417,7 +3284,7 @@ strip eq arr@MutArray{..} = liftIO $ do
2417 if cur > low
3284 if cur > low
2419 let prev = INDEX_PREV(cur,a)
3286 let prev = INDEX_PREV(cur,a)
2420− r <- peekByteIndex prev arrContents
3287+ r <- peekAt prev arrContents
2422 then getLast prev low
3289 then getLast prev low
2423 else return cur
3290 else return cur