@@ -1,107 +1,66 @@
2{-# LANGUAGE UnboxedTuples #-}
1{-# LANGUAGE UnboxedTuples #-}
4−-- Module : Streamly.Internal.Data.MutArray.Type
3+-- Module : Streamly.Internal.Data.MutArray.Mut.Type
5-- Copyright : (c) 2020 Composewell Technologies
4-- Copyright : (c) 2020 Composewell Technologies
6-- License : BSD3-3-Clause
5-- License : BSD3-3-Clause
7-- Maintainer : streamly@composewell.com
6-- Maintainer : streamly@composewell.com
8-- Stability : experimental
7-- Stability : experimental
9-- Portability : GHC
8-- Portability : GHC
11−-- Pinned and unpinned mutable array for 'Unboxed' types. Fulfils the following
14−-- * Random access (array)
15−-- * Efficient storage (unboxed)
16−-- * Performance (unboxed access)
17−-- * Performance - in-place operations (mutable)
18−-- * Performance - GC (pinned, mutable)
19−-- * interfacing with OS (pinned)
21−-- Stream and Fold APIs allow easy, efficient and convenient operations on
24-- Mutable arrays and file system files are quite similar, they can grow and
10-- Mutable arrays and file system files are quite similar, they can grow and
25-- their content is mutable. Therefore, both have similar APIs as well. We
11-- their content is mutable. Therefore, both have similar APIs as well. We
26-- strive to keep the API consistent for both. Ideally, you should be able to
12-- strive to keep the API consistent for both. Ideally, you should be able to
27-- replace one with another with little changes to the code.
13-- replace one with another with little changes to the code.
29−module Streamly.Internal.Data.MutArray.Type
15+module Streamly.Internal.Data.Array.Mut.Type
31− -- ** Type
17+ -- * Type
32 -- $arrayNotes
18 -- $arrayNotes
33 MutArray (..)
19 MutArray (..)
34−
20+ , MutableByteArray
35− -- ** Conversion
21+ , touch
36− -- *** Pinned and Unpinned
43− , castUnsafe -- XXX unsafeCast
25+ -- * Constructing and Writing
48 -- ** Construction
26 -- ** Construction
52− -- | New arrays are always empty arrays with some reserve capacity to
53− -- extend the length without reallocating.
55− , newArrayWith -- emptyAlignedWith
57− , pinnedNewAligned -- XXX not required
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
71− -- *** Stream Folds
29+ -- *** Uninitialized Arrays
36+ -- *** Initialized Arrays
72 , ArrayUnsafe (..)
40 , ArrayUnsafe (..)
73− , unsafeCreateOfWith
41+ , writeNWithUnsafe
74− , unsafeCreateOf
42+ , writeNWith
75− , unsafePinnedCreateOf
43+ , writeNUnsafe
76− , pinnedCreateOf
44+ , writeN
77− , createOfWith
45+ , writeNAligned
79− , revCreateOf
47+ , writeWith
82− , createWith
50+ , writeRevN
83− , create
51+ -- , writeRev
86− -- *** From containers
53+ -- ** From containers
87 , fromListN
54 , fromListN
89 , fromList
55 , fromList
91 , fromListRevN
56 , fromListRevN
92 , fromListRev
57 , fromListRev
93− , fromStreamN
58+ , fromStreamDN
94− , fromStream
59+ , fromStreamD
100− , fromChunksRealloced -- fromSmallChunks
102− -- ** Random writes
61+ -- * Random writes
103 , putIndex
62 , putIndex
104− , putIndexUnsafe -- XXX unsafePutIndex
63+ , putIndexUnsafe
105 , putIndices
64 , putIndices
106 -- , putFromThenTo
65 -- , putFromThenTo
107 -- , putFrom -- start writing at the given position
66 -- , putFrom -- start writing at the given position
@@ -109,71 +68,78 @@ module Streamly.Internal.Data.MutArray.Type
109 -- , putFromTo
68 -- , putFromTo
110 -- , putFromRev
69 -- , putFromRev
111 -- , putUptoRev
70 -- , putUptoRev
112− , modifyIndexUnsafe -- XXX unsafeModifyIndex
71+ , modifyIndexUnsafe
113 , modifyIndex
72 , modifyIndex
114 , modifyIndices
73 , modifyIndices
116 , swapIndices
75 , swapIndices
117 , unsafeSwapIndices
76 , unsafeSwapIndices
119− -- ** Reading
78+ -- * Growing and Shrinking
79+ -- Arrays grow only at the end, though it is possible to grow on both sides
80+ -- and therefore have a cons as well as snoc. But that will require two
81+ -- bounds in the array representation.
121− -- *** Indexing
83+ -- ** Appending elements
122− , getIndex
84+ , snocWith
123− , getIndexUnsafe -- XXX unsafeGetIndex
85+ , snoc
124− -- , getFromThenTo
86+ , snocLinear
125− , getIndexRev -- getRevIndex?
87+ , snocMay
126− , indexReader
88+ , snocUnsafe
139− -- *** To Containers
90+ -- ** Appending streams
140− , toList
91+ , writeAppendNUnsafe
142− -- *** Unfolds
96+ -- * Eliminating and Reading
148 , readerRevWith
100 , readerRevWith
149 , readerRev
101 , readerRev
151− -- ** Size and Capacity
103+ -- ** To containers
152− -- *** Size
104+ , toStreamDWith
153− , length
105+ , toStreamDRevWith
154− , byteLength
106+ , toStreamKWith
156− -- *** Capacity
114+ -- experimental
157− -- , capacity
115+ , producerWith
158− , byteCapacity
116+ , producer
161− -- *** Capacity Management
126+ -- * Memory Management
162 , blockSize
127 , blockSize
163 , arrayChunkBytes
128 , arrayChunkBytes
164 , allocBytesToElemCount
129 , allocBytesToElemCount
165− , realloc -- this is "resize"
130+ , realloc
167− , growExp
132+ , resizeExp
168 , rightSize
133 , rightSize
170− -- ** Folding
135+ -- * Size
171− , foldl'
136+ , length
172− , foldr
137+ , byteLength
173− , byteCmp
138+ -- , capacity
174− , byteEq
139+ , byteCapacity
176− -- ** In-place Mutation Algorithms
142+ -- * In-place Mutation Algorithms
178 , reverse
144 , reverse
179 , permute
145 , permute
@@ -183,124 +149,66 @@ module Streamly.Internal.Data.MutArray.Type
183 , mergeBy
149 , mergeBy
186− -- ** Growing and Shrinking
152+ -- * Casting
187− -- | Arrays grow only at the end, though it is possible to grow on both
153+ , cast
188− -- sides and therefore have a cons as well as snoc. But that will require
154+ , castUnsafe
189− -- both lower and upper bound in the array representation.
155+ , asBytes
191− -- *** Appending elements
158+ -- * Folding
192− , snocWith
159+ , foldl'
194− , snocLinear
161+ , cmp
196− , snocUnsafe -- XXX unsafeSnoc
163+ -- * Arrays of arrays
164+ -- We can add dimensionality parameter to the array type to get
165+ -- multidimensional arrays. Multidimensional arrays would just be a
166+ -- convenience wrapper on top of single dimensional arrays.
168+ -- | Operations dealing with multiple arrays, streams of arrays or
169+ -- multidimensional array representations.
171+ -- ** Construct from streams
173+ , arrayStreamKFromStreamD
198− -- *** Appending streams
176+ -- ** Eliminate to streams
199− , unsafeAppendN
177+ , flattenArrays
200− , appendN
178+ , flattenArraysRev
201− , appendWith
179+ , fromArrayStreamK
181+ -- ** Construct from arrays
182+ -- get chunks without copying
185+ -- , getSlicesFromLenN
186+ , splitAt -- XXX should be able to express using getSlice
204− -- *** Appending arrays
189+ -- ** Appending arrays
205 , spliceCopy
190 , spliceCopy
206 , spliceWith
191 , spliceWith
208 , spliceExp
193 , spliceExp
209− , spliceUnsafe -- XXX unsafeSplice
194+ , spliceUnsafe
210 -- , putSlice
196 -- , putSlice
211 -- , appendSlice
197 -- , appendSlice
212 -- , appendSliceFrom
198 -- , 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.
263− -- ** Utilities
200+ -- * Utilities
264 , roundUpToPower2
201 , roundUpToPower2
267 , c_memchr
204 , c_memchr
286− , writeAppendNUnsafe
293− , pinnedWriteNUnsafe
296− , pinnedWriteNAligned -- XXX not required
209+-- When we use a purely lazy Monad like Identity, we need to force ordering of
210+-- some actions for correctness.
304#include "assert.hs"
212#include "assert.hs"
305#include "inline.hs"
213#include "inline.hs"
306#include "ArrayMacros.h"
214#include "ArrayMacros.h"
@@ -308,60 +216,60 @@ where
309import Control.Monad (when, void)
217import Control.Monad (when, void)
310import Control.Monad.IO.Class (MonadIO(..))
218import Control.Monad.IO.Class (MonadIO(..))
311−import Data.Bifunctor (first)
312import Data.Bits (shiftR, (.|.), (.&.))
219import Data.Bits (shiftR, (.|.), (.&.))
313−import Data.Functor.Identity (Identity(..))
314import Data.Proxy (Proxy(..))
220import Data.Proxy (Proxy(..))
315import Data.Word (Word8)
221import Data.Word (Word8)
316import Foreign.C.Types (CSize(..), CInt(..))
222import Foreign.C.Types (CSize(..), CInt(..))
317import Foreign.Ptr (plusPtr, minusPtr, nullPtr)
223import Foreign.Ptr (plusPtr, minusPtr, nullPtr)
318−import Streamly.Internal.Data.MutByteArray.Type
224+import Streamly.Internal.Data.Unboxed
319− ( MutByteArray(..)
225+ ( MutableByteArray(..)
320− , PinnedState(..)
226+ , Unbox
321 , getMutableByteArray#
227 , getMutableByteArray#
322− , putSliceUnsafe
228+ , peekWith
324−import Streamly.Internal.Data.Unbox (Unbox(..))
325import GHC.Base
233import GHC.Base
327 , Int(..)
235 , Int(..)
236+ , byteArrayContents#
328 , compareByteArrays#
237 , compareByteArrays#
329 , copyMutableByteArray#
238 , copyMutableByteArray#
331import GHC.Base (noinline)
240import GHC.Base (noinline)
332−import GHC.Exts (unsafeCoerce#, Addr#)
241+import GHC.Exts (unsafeCoerce#)
333import GHC.Ptr (Ptr(..))
242import GHC.Ptr (Ptr(..))
335import Streamly.Internal.Data.Fold.Type (Fold(..))
244import Streamly.Internal.Data.Fold.Type (Fold(..))
336import Streamly.Internal.Data.Producer.Type (Producer (..))
245import Streamly.Internal.Data.Producer.Type (Producer (..))
337−import Streamly.Internal.Data.Stream.Type (Stream)
246+import Streamly.Internal.Data.Stream.StreamD.Type (Stream)
338−import Streamly.Internal.Data.Parser.Type (Parser (..))
339−import Streamly.Internal.Data.StreamK.Type (StreamK)
340import Streamly.Internal.Data.SVar.Type (adaptState, defState)
247import Streamly.Internal.Data.SVar.Type (adaptState, defState)
341−import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
342import Streamly.Internal.Data.Unfold.Type (Unfold(..))
248import Streamly.Internal.Data.Unfold.Type (Unfold(..))
343import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)
249import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)
345import qualified Streamly.Internal.Data.Fold.Type as FL
251import 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
349import qualified Streamly.Internal.Data.Producer as Producer
252import qualified Streamly.Internal.Data.Producer as Producer
350−import qualified Streamly.Internal.Data.Stream.Type as D
253+import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
351−import qualified Streamly.Internal.Data.Stream.Lift as D
254+import qualified Streamly.Internal.Data.Stream.StreamK.Type as K
352−import qualified Streamly.Internal.Data.StreamK.Type as K
255+import qualified Streamly.Internal.Data.Unboxed as Unboxed
353import qualified Prelude
256import qualified Prelude
355import Prelude hiding
258import Prelude hiding
356− (Foldable(..), concat, read, unlines, splitAt, reverse, truncate)
259+ (length, foldr, read, unlines, splitAt, reverse, truncate)
358−#include "DocTestDataMutArray.hs"
261+-- $setup
263+-- >>> import qualified Streamly.Internal.Data.Array.Mut.Type as MutArray
264+-- >>> import qualified Streamly.Internal.Data.Stream as Stream
265+-- >>> import qualified Streamly.Internal.Data.Stream.StreamD as StreamD
266+-- >>> import qualified Streamly.Internal.Data.Fold as Fold
267+-- >>> import qualified Streamly.Internal.Data.Fold.Type as Fold
360-------------------------------------------------------------------------------
269-------------------------------------------------------------------------------
361-- Foreign helpers
270-- Foreign helpers
362-------------------------------------------------------------------------------
271-------------------------------------------------------------------------------
364−-- NOTE: Have to be "ccall unsafe" so that we can pass unpinned memory to these
365foreign import ccall unsafe "string.h memcpy" c_memcpy
273foreign import ccall unsafe "string.h memcpy" c_memcpy
366 :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
274 :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
@@ -371,9 +279,6 @@ foreign import ccall unsafe "string.h memchr" c_memchr
371foreign import ccall unsafe "string.h memcmp" c_memcmp
279foreign import ccall unsafe "string.h memcmp" c_memcmp
372 :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
280 :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
374−foreign import ccall unsafe "string.h strlen" c_strlen
375− :: Ptr Word8 -> IO CSize
377-- | Given an 'Unboxed' type (unused first arg) and a number of bytes, return
282-- | Given an 'Unboxed' type (unused first arg) and a number of bytes, return
378-- how many elements of that type will completely fit in those bytes.
283-- how many elements of that type will completely fit in those bytes.
@@ -399,12 +304,14 @@ memcmp p1 p2 len = do
400-- $arrayNotes
305-- $arrayNotes
402−-- We can use an 'Unboxed' constraint in the MutArray type and the constraint
307+-- We can use an 'Unboxed' constraint in the MutArray type and the constraint can
403−-- can be automatically provided to a function that pattern matches on the
308+-- be automatically provided to a function that pattern matches on the MutArray
404−-- MutArray type. However, it has huge performance cost, so we do not use it.
309+-- type. However, it has huge performance cost, so we do not use it.
405-- Investigate a GHC improvement possiblity.
310-- Investigate a GHC improvement possiblity.
312+-- XXX Rename the fields to better names.
407−-- | An unboxed mutable array. An array is created with a given length
314+-- | An unboxed, pinned mutable array. An array is created with a given length
408-- and capacity. Length is the number of valid elements in the array. Capacity
315-- and capacity. Length is the number of valid elements in the array. Capacity
409-- is the maximum number of elements that the array can be expanded to without
316-- is the maximum number of elements that the array can be expanded to without
410-- having to reallocate the memory.
317-- having to reallocate the memory.
@@ -428,7 +335,7 @@ data MutArray a =
428 -- The array is a range into arrContents. arrContents may be a superset of
335 -- The array is a range into arrContents. arrContents may be a superset of
429 -- the slice represented by the array. All offsets are in bytes.
336 -- the slice represented by the array. All offsets are in bytes.
431− { arrContents :: {-# UNPACK #-} !MutByteArray
338+ { arrContents :: {-# UNPACK #-} !MutableByteArray
432 , arrStart :: {-# UNPACK #-} !Int -- ^ index into arrContents
339 , arrStart :: {-# UNPACK #-} !Int -- ^ index into arrContents
433 , arrEnd :: {-# UNPACK #-} !Int -- ^ index into arrContents
340 , arrEnd :: {-# UNPACK #-} !Int -- ^ index into arrContents
434 -- Represents the first invalid index of
341 -- Represents the first invalid index of
@@ -440,28 +347,17 @@ data MutArray a =
440-- Pinning & Unpinning
347-- Pinning & Unpinning
441-------------------------------------------------------------------------------
348-------------------------------------------------------------------------------
443−-- | Return a copy of the array in pinned memory if unpinned, else return the
445{-# INLINE pin #-}
350{-# INLINE pin #-}
446pin :: MutArray a -> IO (MutArray a)
351pin :: MutArray a -> IO (MutArray a)
447−pin arr@MutArray{..} =
352+pin arr@MutArray{..} = do
448− if Unboxed.isPinned arrContents
353+ contents <- Unboxed.pin arrContents
449− then pure arr
354+ return $ arr {arrContents = contents}
450− else pinnedClone arr
452−-- | Return a copy of the array in unpinned memory if pinned, else return the
454{-# INLINE unpin #-}
356{-# INLINE unpin #-}
455unpin :: MutArray a -> IO (MutArray a)
357unpin :: MutArray a -> IO (MutArray a)
456−unpin arr@MutArray{..} =
358+unpin arr@MutArray{..} = do
457− if Unboxed.isPinned arrContents
359+ contents <- Unboxed.unpin arrContents
458− then clone arr
360+ return $ arr {arrContents = contents}
461−-- | Return 'True' if the array is allocated in pinned memory.
462−{-# INLINE isPinned #-}
463−isPinned :: MutArray a -> Bool
464−isPinned MutArray{..} = Unboxed.isPinned arrContents
466-------------------------------------------------------------------------------
362-------------------------------------------------------------------------------
467-- Construction
363-- Construction
@@ -476,11 +372,9 @@ isPinned MutArray{..} = Unboxed.isPinned arrContents
476-- files and arrays.
372-- files and arrays.
478-- GHC always guarantees word-aligned memory, alignment is important only when
374-- GHC always guarantees word-aligned memory, alignment is important only when
479−-- we need more than that. See stg_pinnedNewAlignedByteArrayzh and
375+-- we need more than that. See stg_newAlignedPinnedByteArrayzh and
480-- allocatePinned in GHC source.
376-- allocatePinned in GHC source.
482−-- XXX Rename to emptyAlignedWith, alignSize should be first arg.
484-- | @newArrayWith allocator alignment count@ allocates a new array of zero
378-- | @newArrayWith allocator alignment count@ allocates a new array of zero
485-- length and with a capacity to hold @count@ elements, using @allocator
379-- length and with a capacity to hold @count@ elements, using @allocator
486-- size alignment@ as the memory allocator function.
380-- size alignment@ as the memory allocator function.
@@ -493,7 +387,7 @@ isPinned MutArray{..} = Unboxed.isPinned arrContents
493-- /Pre-release/
387-- /Pre-release/
494{-# INLINE newArrayWith #-}
388{-# INLINE newArrayWith #-}
495newArrayWith :: forall m a. (MonadIO m, Unbox a)
389newArrayWith :: forall m a. (MonadIO m, Unbox a)
496− => (Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)
390+ => (Int -> Int -> m MutableByteArray) -> Int -> Int -> m (MutArray a)
497newArrayWith alloc alignSize count = do
391newArrayWith alloc alignSize count = do
498 let size = max (count * SIZE_OF(a)) 0
392 let size = max (count * SIZE_OF(a)) 0
499 contents <- alloc size alignSize
393 contents <- alloc size alignSize
@@ -504,34 +398,27 @@ newArrayWith alloc alignSize count = do
504 , arrBound = size
398 , 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." #-}
521#ifdef DEVBUILD
402#ifdef DEVBUILD
522 Unbox a =>
403 Unbox a =>
524 MutArray a
405 MutArray a
525−nil = empty
406+nil = MutArray Unboxed.nil 0 0 0
527−{-# INLINE newBytesAs #-}
409+-- | Allocates a pinned empty array that can hold 'count' items. The memory of
410+-- the array is uninitialized and the allocation is aligned as per the
411+-- 'Unboxed' instance of the type.
414+{-# INLINE newPinnedBytes #-}
528−newBytesAs :: MonadIO m =>
415+newPinnedBytes :: MonadIO m =>
529#ifdef DEVBUILD
416#ifdef DEVBUILD
530 Unbox a =>
417 Unbox a =>
532− PinnedState -> Int -> m (MutArray a)
419+ Int -> m (MutArray a)
533−newBytesAs ps bytes = do
420+newPinnedBytes bytes = do
534− contents <- liftIO $ Unboxed.newBytesAs ps bytes
421+ contents <- liftIO $ Unboxed.newPinnedBytes bytes
535 return $ MutArray
422 return $ MutArray
536 { arrContents = contents
423 { arrContents = contents
537 , arrStart = 0
424 , arrStart = 0
@@ -539,62 +426,49 @@ newBytesAs ps bytes = do
539 , arrBound = bytes
426 , arrBound = bytes
542−-- | Allocates a pinned empty array that with a reserved capacity of bytes.
543−-- The memory of the array is uninitialized and the allocation is aligned as
544−-- per the 'Unboxed' instance of the type.
547−{-# INLINE pinnedNewBytes #-}
548−{-# DEPRECATED pinnedNewBytes "Please use pinnedEmptyOf with appropriate calculation" #-}
549−pinnedNewBytes :: MonadIO m =>
553− Int -> m (MutArray a)
554−pinnedNewBytes = newBytesAs Pinned
556-- | Like 'newArrayWith' but using an allocator is a pinned memory allocator and
429-- | Like 'newArrayWith' but using an allocator is a pinned memory allocator and
557-- the alignment is dictated by the 'Unboxed' instance of the type.
430-- the alignment is dictated by the 'Unboxed' instance of the type.
559-- /Internal/
432-- /Internal/
560−{-# INLINE pinnedNewAligned #-}
433+{-# INLINE newAlignedPinned #-}
561−pinnedNewAligned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)
434+newAlignedPinned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)
562−pinnedNewAligned =
435+newAlignedPinned =
563− newArrayWith (\s a -> liftIO $ Unboxed.pinnedNewAlignedBytes s a)
436+ newArrayWith (\s a -> liftIO $ Unboxed.newAlignedPinnedBytes s a)
566−newAs :: (MonadIO m, Unbox a) => PinnedState -> Int -> m (MutArray a)
569− (\s _ -> liftIO $ Unboxed.newBytesAs ps s)
570− (error "new: alignment is not used in unpinned arrays.")
572-- XXX can unaligned allocation be more efficient when alignment is not needed?
438-- XXX can unaligned allocation be more efficient when alignment is not needed?
574−-- | Allocates a pinned array of zero length but growable to the specified
575−-- capacity without reallocation.
576−{-# INLINE pinnedEmptyOf #-}
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." #-}
582−{-# INLINE pinnedNew #-}
583−pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
584−pinnedNew = pinnedEmptyOf
586−-- | Allocates an unpinned array of zero length but growable to the specified
587−-- capacity without reallocation.
440+-- | Allocates an empty pinned array that can hold 'count' items. The memory of
441+-- the array is uninitialized and the allocation is aligned as per the 'Unboxed'
442+-- instance of the type.
589−{-# INLINE emptyOf #-}
444+{-# INLINE newPinned #-}
590−emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
445+newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
591−emptyOf = newAs Unpinned
446+newPinned =
448+ (\s _ -> liftIO $ Unboxed.newPinnedBytes s)
449+ (error "newPinned: alignSize is not used")
593−-- XXX Deprecate in major
451+-- | Allocates an empty unpinned array that can hold 'count' items. The memory
594−-- {-# DEPRECATED new "Please use emptyOf instead." #-}
452+-- of the array is uninitialized.
595{-# INLINE new #-}
454{-# INLINE new #-}
596new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
455new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
597−new = emptyOf
456+new =
458+ (\s _ -> liftIO $ Unboxed.newUnpinnedBytes s)
459+ (error "new: alignment is not used in unpinned arrays.")
461+-- | Allocate an MutArray of the given size and run an IO action passing the array
465+{-# INLINE withNewArrayUnsafe #-}
466+withNewArrayUnsafe ::
467+ (MonadIO m, Unbox a) => Int -> (Ptr a -> m ()) -> m (MutArray a)
468+withNewArrayUnsafe count f = do
469+ arr <- newPinned count
471+ $ \p -> f p >> return arr
599-------------------------------------------------------------------------------
473-------------------------------------------------------------------------------
600-- Random writes
474-- Random writes
@@ -610,7 +484,7 @@ putIndexUnsafe :: forall m a. (MonadIO m, Unbox a)
610putIndexUnsafe i MutArray{..} x = do
484putIndexUnsafe i MutArray{..} x = do
611 let index = INDEX_OF(arrStart, i, a)
485 let index = INDEX_OF(arrStart, i, a)
612 assert (i >= 0 && INDEX_VALID(index, arrEnd, a)) (return ())
486 assert (i >= 0 && INDEX_VALID(index, arrEnd, a)) (return ())
613− liftIO $ pokeAt index arrContents x
487+ liftIO $ pokeWith arrContents index x
615invalidIndex :: String -> Int -> a
489invalidIndex :: String -> Int -> a
616invalidIndex label i =
490invalidIndex label i =
@@ -628,7 +502,7 @@ putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()
628putIndex i MutArray{..} x = do
502putIndex i MutArray{..} x = do
629 let index = INDEX_OF(arrStart,i,a)
503 let index = INDEX_OF(arrStart,i,a)
630 if i >= 0 && INDEX_VALID(index,arrEnd,a)
504 if i >= 0 && INDEX_VALID(index,arrEnd,a)
631− then liftIO $ pokeAt index arrContents x
505+ then liftIO $ pokeWith arrContents index x
632 else invalidIndex "putIndex" i
506 else invalidIndex "putIndex" i
634-- | Write an input stream of (index, value) pairs to an array. Throws an
508-- | Write an input stream of (index, value) pairs to an array. Throws an
@@ -642,21 +516,19 @@ putIndices arr = FL.foldlM' step (return ())
645− step () (i, x) = putIndex i arr x
519+ step () (i, x) = liftIO (putIndex i arr x)
647-- | Modify a given index of an array using a modifier function.
521-- | Modify a given index of an array using a modifier function.
649−-- Unsafe because it does not check the bounds of the array.
651-- /Pre-release/
523-- /Pre-release/
652modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) =>
524modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) =>
653 Int -> MutArray a -> (a -> (a, b)) -> m b
525 Int -> MutArray a -> (a -> (a, b)) -> m b
654modifyIndexUnsafe i MutArray{..} f = liftIO $ do
526modifyIndexUnsafe i MutArray{..} f = liftIO $ do
655 let index = INDEX_OF(arrStart,i,a)
527 let index = INDEX_OF(arrStart,i,a)
656 assert (i >= 0 && INDEX_NEXT(index,a) <= arrEnd) (return ())
528 assert (i >= 0 && INDEX_NEXT(index,a) <= arrEnd) (return ())
657− r <- peekAt index arrContents
529+ r <- peekWith arrContents index
658 let (x, res) = f r
530 let (x, res) = f r
659− pokeAt index arrContents x
531+ pokeWith arrContents index x
660 return res
532 return res
662-- | Modify a given index of an array using a modifier function.
534-- | Modify a given index of an array using a modifier function.
@@ -668,12 +540,13 @@ modifyIndex i MutArray{..} f = do
668 let index = INDEX_OF(arrStart,i,a)
540 let index = INDEX_OF(arrStart,i,a)
669 if i >= 0 && INDEX_VALID(index,arrEnd,a)
541 if i >= 0 && INDEX_VALID(index,arrEnd,a)
670 then liftIO $ do
542 then liftIO $ do
671− r <- peekAt index arrContents
543+ r <- peekWith arrContents index
672 let (x, res) = f r
544 let (x, res) = f r
673− pokeAt index arrContents x
545+ pokeWith arrContents index x
674 return res
546 return res
675 else invalidIndex "modifyIndex" i
547 else invalidIndex "modifyIndex" i
677-- | Modify the array indices generated by the supplied stream.
550-- | Modify the array indices generated by the supplied stream.
679-- /Pre-release/
552-- /Pre-release/
@@ -692,8 +565,6 @@ modifyIndices arr f = FL.foldlM' step initial
693-- | Modify each element of an array using the supplied modifier function.
566-- | Modify each element of an array using the supplied modifier function.
695−-- This is an in-place equivalent of an immutable map operation.
697-- /Pre-release/
568-- /Pre-release/
698modify :: forall m a. (MonadIO m, Unbox a)
569modify :: forall m a. (MonadIO m, Unbox a)
699 => MutArray a -> (a -> a) -> m ()
570 => MutArray a -> (a -> a) -> m ()
@@ -704,8 +575,8 @@ modify MutArray{..} f = liftIO $
706 when (INDEX_VALID(i,arrEnd,a)) $ do
577 when (INDEX_VALID(i,arrEnd,a)) $ do
707− r <- peekAt i arrContents
578+ r <- peekWith arrContents i
708− pokeAt i arrContents (f r)
579+ pokeWith arrContents i (f r)
709 go (INDEX_NEXT(i,a))
580 go (INDEX_NEXT(i,a))
711-- XXX We could specify the number of bytes to swap instead of Proxy. Need
582-- XXX We could specify the number of bytes to swap instead of Proxy. Need
@@ -714,15 +585,15 @@ modify MutArray{..} f = liftIO $
714swapArrayByteIndices ::
585swapArrayByteIndices ::
715 forall a. Unbox a
586 forall a. Unbox a
716 => Proxy a
587 => Proxy a
717− -> MutByteArray
588+ -> MutableByteArray
721swapArrayByteIndices _ arrContents i1 i2 = do
592swapArrayByteIndices _ arrContents i1 i2 = do
722− r1 <- peekAt i1 arrContents
593+ r1 <- peekWith arrContents i1
594+ r2 <- peekWith arrContents i2
723− r2 <- peekAt i2 arrContents
595+ pokeWith arrContents i1 (r2 :: a)
724− pokeAt i1 arrContents (r2 :: a)
596+ pokeWith arrContents i2 (r1 :: a)
725− pokeAt i2 arrContents (r1 :: a)
727-- | Swap the elements at two indices without validating the indices.
598-- | Swap the elements at two indices without validating the indices.
@@ -838,23 +709,23 @@ arrayChunkBytes = 1024
838roundDownTo :: Int -> Int -> Int
709roundDownTo :: Int -> Int -> Int
839roundDownTo elemSize size = size - (size `mod` elemSize)
710roundDownTo elemSize size = size - (size `mod` elemSize)
712+-- XXX See if resizing can be implemented by reading the old array as a stream
713+-- and then using writeN to the new array.
841-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.
715-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.
842-- Since this is not inlined Unboxed consrraint leads to dictionary passing
716-- Since this is not inlined Unboxed consrraint leads to dictionary passing
843-- which complicates some inspection tests.
717-- which complicates some inspection tests.
845−{-# NOINLINE reallocExplicitAs #-}
719+{-# NOINLINE reallocExplicit #-}
846−reallocExplicitAs :: PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
720+reallocExplicit :: Int -> Int -> MutArray a -> IO (MutArray a)
847−reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do
721+reallocExplicit elemSize newCapacityInBytes MutArray{..} = do
848 assertM(arrEnd <= arrBound)
722 assertM(arrEnd <= arrBound)
850 -- Allocate new array
724 -- Allocate new array
851 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
725 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
854− then Unboxed.pinnedNew newCapMaxInBytes
855− else Unboxed.new newCapMaxInBytes
726+ contents <- Unboxed.newPinnedBytes newCapMaxInBytes
856− let !(MutByteArray mbarrFrom#) = arrContents
727+ let !(MutableByteArray mbarrFrom#) = arrContents
857− !(MutByteArray mbarrTo#) = contents
728+ !(MutableByteArray mbarrTo#) = contents
859 -- Copy old data
730 -- Copy old data
860 let oldStart = arrStart
731 let oldStart = arrStart
@@ -875,10 +746,6 @@ reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do
875 , arrBound = newCapInBytes
746 , 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.
882-- | @realloc newCapacity array@ reallocates the array to the specified
749-- | @realloc newCapacity array@ reallocates the array to the specified
883-- capacity in bytes.
750-- capacity in bytes.
@@ -887,15 +754,9 @@ reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do
887-- down to multiples of array size. If the new size is more than
754-- down to multiples of array size. If the new size is more than
888-- 'largeObjectThreshold' then it is rounded up to the block size (4K).
755-- 'largeObjectThreshold' then it is rounded up to the block size (4K).
890−-- If the original array is pinned, the newly allocated array is also pinned.
891{-# INLINABLE realloc #-}
757{-# INLINABLE realloc #-}
892realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)
758realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)
898− in liftIO $ reallocExplicitAs ps (SIZE_OF(a)) bytes arr
759+realloc bytes arr = liftIO $ reallocExplicit (SIZE_OF(a)) bytes arr
900-- | @reallocWith label capSizer minIncrBytes array@. The label is used
761-- | @reallocWith label capSizer minIncrBytes array@. The label is used
901-- in error messages and the capSizer is used to determine the capacity of the
762-- in error messages and the capSizer is used to determine the capacity of the
@@ -918,14 +779,14 @@ reallocWith label capSizer minIncrBytes arr = do
920 badSize newSize =
781 badSize newSize =
921− Prelude.concat
782+ concat
923 , ": new array size (in bytes) is less than required size "
784 , ": new array size (in bytes) is less than required size "
924 , show newSize
785 , show newSize
925 , ". Please check the sizing function passed."
786 , ". Please check the sizing function passed."
928−-- | @grow newCapacity array@ changes the total capacity of the array so that
789+-- | @resize newCapacity array@ changes the total capacity of the array so that
929-- it is enough to hold the specified number of elements. Nothing is done if
790-- it is enough to hold the specified number of elements. Nothing is done if
930-- the specified capacity is less than the length of the array.
791-- the specified capacity is less than the length of the array.
@@ -933,46 +794,34 @@ reallocWith label capSizer minIncrBytes arr = do
933-- the block size (4K).
794-- the block size (4K).
935-- /Pre-release/
796-- /Pre-release/
936−{-# INLINE grow #-}
797+{-# INLINE resize #-}
937−grow :: forall m a. (MonadIO m, Unbox a) =>
798+resize :: forall m a. (MonadIO m, Unbox a) =>
938 Int -> MutArray a -> m (MutArray a)
799 Int -> MutArray a -> m (MutArray a)
939−grow nElems arr@MutArray{..} = do
800+resize nElems arr@MutArray{..} = do
940 let req = SIZE_OF(a) * nElems
801 let req = SIZE_OF(a) * nElems
941− cap = arrBound - arrStart
802+ len = arrEnd - arrStart
942− if req < cap
803+ if req < len
943 then return arr
804 then return arr
944 else realloc req arr
805 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)
952−-- | Like 'grow' but if the requested byte capacity is more than
807+-- | Like 'resize' but if the byte capacity is more than 'largeObjectThreshold'
953−-- 'largeObjectThreshold' then it is rounded up to the closest power of 2.
808+-- then it is rounded up to the closest power of 2.
955-- /Pre-release/
810-- /Pre-release/
956−{-# INLINE growExp #-}
811+{-# INLINE resizeExp #-}
957−growExp :: forall m a. (MonadIO m, Unbox a) =>
812+resizeExp :: forall m a. (MonadIO m, Unbox a) =>
958 Int -> MutArray a -> m (MutArray a)
813 Int -> MutArray a -> m (MutArray a)
959−growExp nElems arr@MutArray{..} = do
814+resizeExp nElems arr@MutArray{..} = do
960 let req = roundUpLargeArray (SIZE_OF(a) * nElems)
815 let req = roundUpLargeArray (SIZE_OF(a) * nElems)
962 if req > largeObjectThreshold
817 if req > largeObjectThreshold
963 then roundUpToPower2 req
818 then roundUpToPower2 req
965− cap = arrBound - arrStart
820+ len = arrEnd - arrStart
966− if req1 < cap
821+ if req1 < len
967 then return arr
822 then return arr
968 else realloc req1 arr
823 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)
976-- | Resize the allocated memory to drop any reserved free space at the end of
825-- | Resize the allocated memory to drop any reserved free space at the end of
977-- the array and reallocate it to reduce wastage.
826-- the array and reallocate it to reduce wastage.
@@ -1017,7 +866,7 @@ rightSize arr@MutArray{..} = do
1017snocNewEnd :: (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)
866snocNewEnd :: (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)
1018snocNewEnd newEnd arr@MutArray{..} x = liftIO $ do
867snocNewEnd newEnd arr@MutArray{..} x = liftIO $ do
1019 assert (newEnd <= arrBound) (return ())
868 assert (newEnd <= arrBound) (return ())
1020− pokeAt arrEnd arrContents x
869+ pokeWith arrContents arrEnd x
1021 return $ arr {arrEnd = newEnd}
870 return $ arr {arrEnd = newEnd}
1023-- | Really really unsafe, appends the element into the first array, may
872-- | Really really unsafe, appends the element into the first array, may
@@ -1037,7 +886,7 @@ snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr
1037{-# INLINE snocMay #-}
886{-# INLINE snocMay #-}
1038snocMay :: forall m a. (MonadIO m, Unbox a) =>
887snocMay :: forall m a. (MonadIO m, Unbox a) =>
1039 MutArray a -> a -> m (Maybe (MutArray a))
888 MutArray a -> a -> m (Maybe (MutArray a))
1040−snocMay arr@MutArray{..} x = do
889+snocMay arr@MutArray{..} x = liftIO $ do
1041 let newEnd = INDEX_NEXT(arrEnd,a)
890 let newEnd = INDEX_NEXT(arrEnd,a)
1042 if newEnd <= arrBound
891 if newEnd <= arrBound
1043 then Just <$> snocNewEnd newEnd arr x
892 then Just <$> snocNewEnd newEnd arr x
@@ -1051,7 +900,7 @@ snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>
1052 -> m (MutArray a)
901 -> m (MutArray a)
1053snocWithRealloc sizer arr x = do
902snocWithRealloc sizer arr x = do
1054− arr1 <- reallocWith "snocWith" sizer (SIZE_OF(a)) arr
903+ arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr
1055 snocUnsafe arr1 x
904 snocUnsafe arr1 x
1057-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of
906-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of
@@ -1073,7 +922,7 @@ snocWith :: forall m a. (MonadIO m, Unbox a) =>
1073 -> MutArray a
922 -> MutArray a
1075 -> m (MutArray a)
924 -> m (MutArray a)
1076−snocWith allocSize arr x = do
925+snocWith allocSize arr x = liftIO $ do
1077 let newEnd = INDEX_NEXT(arrEnd arr,a)
926 let newEnd = INDEX_NEXT(arrEnd arr,a)
1078 if newEnd <= arrBound arr
927 if newEnd <= arrBound arr
1079 then snocNewEnd newEnd arr x
928 then snocNewEnd newEnd arr x
@@ -1117,126 +966,6 @@ snoc = snocWith f
1117 then oldSize * 2
966 then oldSize * 2
1118 else roundUpToPower2 oldSize * 2
967 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)
1240-------------------------------------------------------------------------------
969-------------------------------------------------------------------------------
1241-- Random reads
970-- Random reads
1242-------------------------------------------------------------------------------
971-------------------------------------------------------------------------------
@@ -1251,17 +980,17 @@ getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a
1251getIndexUnsafe i MutArray{..} = do
980getIndexUnsafe i MutArray{..} = do
1252 let index = INDEX_OF(arrStart,i,a)
981 let index = INDEX_OF(arrStart,i,a)
1253 assert (i >= 0 && INDEX_VALID(index,arrEnd,a)) (return ())
982 assert (i >= 0 && INDEX_VALID(index,arrEnd,a)) (return ())
1254− liftIO $ peekAt index arrContents
983+ liftIO $ peekWith arrContents index
1256-- | /O(1)/ Lookup the element at the given index. Index starts from 0.
985-- | /O(1)/ Lookup the element at the given index. Index starts from 0.
1258{-# INLINE getIndex #-}
987{-# INLINE getIndex #-}
1259−getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (Maybe a)
988+getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a
1260getIndex i MutArray{..} = do
989getIndex i MutArray{..} = do
1261 let index = INDEX_OF(arrStart,i,a)
990 let index = INDEX_OF(arrStart,i,a)
1262 if i >= 0 && INDEX_VALID(index,arrEnd,a)
991 if i >= 0 && INDEX_VALID(index,arrEnd,a)
1263− then liftIO $ Just <$> peekAt index arrContents
992+ then liftIO $ peekWith arrContents index
1264− else return Nothing
993+ else invalidIndex "getIndex" i
1266-- | /O(1)/ Lookup the element at the given index from the end of the array.
995-- | /O(1)/ Lookup the element at the given index from the end of the array.
1267-- Index starts from 0.
996-- Index starts from 0.
@@ -1273,16 +1002,21 @@ getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a
1273getIndexRev i MutArray{..} = do
1002getIndexRev i MutArray{..} = do
1274 let index = RINDEX_OF(arrEnd,i,a)
1003 let index = RINDEX_OF(arrEnd,i,a)
1275 if i >= 0 && index >= arrStart
1004 if i >= 0 && index >= arrStart
1276− then liftIO $ peekAt index arrContents
1005+ then liftIO $ peekWith arrContents index
1277 else invalidIndex "getIndexRev" i
1006 else invalidIndex "getIndexRev" i
1279data GetIndicesState contents start end st =
1008data GetIndicesState contents start end st =
1280 GetIndicesState contents start end st
1009 GetIndicesState contents start end st
1282−{-# INLINE indexReaderWith #-}
1011+-- | Given an unfold that generates array indices, read the elements on those
1012+-- indices from the supplied MutArray. An error is thrown if an index is out of
1016+{-# INLINE getIndicesD #-}
1283−indexReaderWith :: (Monad m, Unbox a) =>
1017+getIndicesD :: (Monad m, Unbox a) =>
1284 (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a
1018 (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a
1285−indexReaderWith liftio (D.Stream stepi sti) = Unfold step inject
1019+getIndicesD liftio (D.Stream stepi sti) = Unfold step inject
@@ -1295,32 +1029,13 @@ indexReaderWith liftio (D.Stream stepi sti) = Unfold step inject
1295 case r of
1029 case r of
1296 D.Yield i s -> do
1030 D.Yield i s -> do
1297 x <- liftio $ getIndex i (MutArray contents start end undefined)
1031 x <- liftio $ getIndex i (MutArray contents start end undefined)
1299− Just v -> return $ D.Yield v (GetIndicesState contents start end s)
1032+ return $ D.Yield x (GetIndicesState contents start end s)
1300− Nothing -> error "Invalid Index"
1301 D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)
1033 D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)
1302 D.Stop -> return D.Stop
1034 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." #-}
1321{-# INLINE getIndices #-}
1036{-# INLINE getIndices #-}
1322getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
1037getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
1323−getIndices = indexReader
1038+getIndices = getIndicesD liftIO
1325-------------------------------------------------------------------------------
1040-------------------------------------------------------------------------------
1326-- Subarrays
1041-- Subarrays
@@ -1425,7 +1140,7 @@ partitionBy f arr@MutArray{..} = liftIO $ do
1426 -- Invariant low < high on entry, and on return as well
1141 -- Invariant low < high on entry, and on return as well
1427 moveHigh low high = do
1142 moveHigh low high = do
1428− h <- peekAt high arrContents
1143+ h <- peekWith arrContents high
1431 -- Correctly classified, continue the loop
1146 -- Correctly classified, continue the loop
@@ -1445,7 +1160,7 @@ partitionBy f arr@MutArray{..} = liftIO $ do
1445 -- low <= high
1160 -- low <= high
1446 -- Both low and high are valid locations within the array
1161 -- Both low and high are valid locations within the array
1447 go low high = do
1162 go low high = do
1448− l <- peekAt low arrContents
1163+ l <- peekWith arrContents low
1451 -- low is wrongly classified
1166 -- low is wrongly classified
@@ -1456,8 +1171,8 @@ partitionBy f arr@MutArray{..} = liftIO $ do
1456 case r of
1171 case r of
1457 Nothing -> return low
1172 Nothing -> return low
1458 Just (high1, h) -> do -- low < high1
1173 Just (high1, h) -> do -- low < high1
1459− pokeAt low arrContents h
1174+ pokeWith arrContents low h
1460− pokeAt high1 arrContents l
1175+ pokeWith arrContents high1 l
1461 let low1 = INDEX_NEXT(low,a)
1176 let low1 = INDEX_NEXT(low,a)
1462 high2 = INDEX_PREV(high1,a)
1177 high2 = INDEX_PREV(high1,a)
1463 if low1 <= high2
1178 if low1 <= high2
@@ -1569,10 +1284,20 @@ data GroupState s contents start end bound
1569 contents start end bound (GroupState s contents start end bound)
1284 contents start end bound (GroupState s contents start end bound)
1570 | GroupFinish
1285 | GroupFinish
1287+-- | @arraysOf n stream@ groups the input stream into a stream of
1288+-- arrays of size n.
1290+-- @arraysOf n = StreamD.foldMany (MutArray.writeN n)@
1572−{-# INLINE_NORMAL chunksOfAs #-}
1293+{-# INLINE_NORMAL arraysOf #-}
1573−chunksOfAs :: forall m a. (MonadIO m, Unbox a)
1294+arraysOf :: forall m a. (MonadIO m, Unbox a)
1574− => PinnedState -> Int -> D.Stream m a -> D.Stream m (MutArray a)
1295+ => Int -> D.Stream m a -> D.Stream m (MutArray a)
1296+-- XXX the idiomatic implementation leads to large regression in the D.reverse'
1297+-- benchmark. It seems it has difficulty producing optimized code when
1298+-- converting to StreamK. Investigate GHC optimizations.
1299+-- arraysOf n = D.foldMany (writeN n)
1575−chunksOfAs ps n (D.Stream step state) =
1300+arraysOf n (D.Stream step state) =
1576 D.Stream step' (GroupStart state)
1301 D.Stream step' (GroupStart state)
@@ -1581,17 +1306,17 @@ chunksOfAs ps n (D.Stream step state) =
1581 step' _ (GroupStart st) = do
1306 step' _ (GroupStart st) = do
1582 when (n <= 0) $
1307 when (n <= 0) $
1583 -- XXX we can pass the module string from the higher level API
1308 -- XXX we can pass the module string from the higher level API
1584− error $ "Streamly.Internal.Data.MutArray.Mut.Type.chunksOf: "
1309+ error $ "Streamly.Internal.Data.MutArray.Mut.Type.arraysOf: "
1585 ++ "the size of arrays [" ++ show n
1310 ++ "the size of arrays [" ++ show n
1586 ++ "] must be a natural number"
1311 ++ "] must be a natural number"
1587− (MutArray contents start end bound :: MutArray a) <- newAs ps n
1312+ (MutArray contents start end bound :: MutArray a) <- liftIO $ newPinned n
1588 return $ D.Skip (GroupBuffer st contents start end bound)
1313 return $ D.Skip (GroupBuffer st contents start end bound)
1590 step' gst (GroupBuffer st contents start end bound) = do
1315 step' gst (GroupBuffer st contents start end bound) = do
1591 r <- step (adaptState gst) st
1316 r <- step (adaptState gst) st
1592 case r of
1317 case r of
1593 D.Yield x s -> do
1318 D.Yield x s -> do
1594− liftIO $ pokeAt end contents x
1319+ liftIO $ pokeWith contents end x
1595 let end1 = INDEX_NEXT(end,a)
1320 let end1 = INDEX_NEXT(end,a)
1596 return $
1321 return $
1597 if end1 >= bound
1322 if end1 >= bound
@@ -1610,51 +1335,14 @@ chunksOfAs ps n (D.Stream step state) =
1611 step' _ GroupFinish = return D.Stop
1336 step' _ GroupFinish = return D.Stop
1613−-- | @chunksOf n stream@ groups the elements in the input stream into arrays of
1614−-- @n@ elements each.
1616−-- Same as the following but may be more efficient:
1618−-- >>> chunksOf n = Stream.foldMany (MutArray.createOf n)
1621−{-# INLINE_NORMAL chunksOf #-}
1622−chunksOf :: forall m a. (MonadIO m, Unbox a)
1623− => Int -> D.Stream m a -> D.Stream m (MutArray a)
1624−-- XXX the idiomatic implementation leads to large regression in the D.reverse'
1625−-- benchmark. It seems it has difficulty producing optimized code when
1626−-- converting to StreamK. Investigate GHC optimizations.
1627−-- chunksOf n = D.foldMany (createOf n)
1628−chunksOf = chunksOfAs Unpinned
1630−-- | Like 'chunksOf' but creates pinned arrays.
1631−{-# INLINE_NORMAL pinnedChunksOf #-}
1632−pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)
1633− => Int -> D.Stream m a -> D.Stream m (MutArray a)
1634−-- pinnedChunksOf n = D.foldMany (pinnedCreateOf n)
1635−pinnedChunksOf = chunksOfAs Pinned
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
1650-- XXX buffer to a list instead?
1338-- XXX buffer to a list instead?
1651-- | Buffer the stream into arrays in memory.
1339-- | Buffer the stream into arrays in memory.
1652−{-# INLINE arrayStreamKFromStreamDAs #-}
1340+{-# INLINE arrayStreamKFromStreamD #-}
1653−arrayStreamKFromStreamDAs :: forall m a. (MonadIO m, Unbox a) =>
1341+arrayStreamKFromStreamD :: forall m a. (MonadIO m, Unbox a) =>
1654− PinnedState -> D.Stream m a -> m (StreamK m (MutArray a))
1342+ D.Stream m a -> m (K.Stream m (MutArray a))
1655−arrayStreamKFromStreamDAs ps =
1343+arrayStreamKFromStreamD =
1656 let n = allocBytesToElemCount (undefined :: a) defaultChunkSize
1344 let n = allocBytesToElemCount (undefined :: a) defaultChunkSize
1657− in D.foldr K.cons K.nil . chunksOfAs ps n
1345+ in D.foldr K.cons K.nil . arraysOf n
1659-------------------------------------------------------------------------------
1347-------------------------------------------------------------------------------
1660-- Streams of arrays - Flattening
1348-- Streams of arrays - Flattening
@@ -1664,10 +1352,16 @@ data FlattenState s contents a =
1664 OuterLoop s
1352 OuterLoop s
1665 | InnerLoop s contents !Int !Int
1353 | InnerLoop s contents !Int !Int
1355+-- | Use the "reader" unfold instead.
1357+-- @flattenArrays = unfoldMany reader@
1359+-- We can try this if there are any fusion issues in the unfold.
1667−{-# INLINE_NORMAL concatWith #-}
1361+{-# INLINE_NORMAL flattenArrays #-}
1668−concatWith :: forall m a. (Monad m, Unbox a)
1362+flattenArrays :: forall m a. (MonadIO m, Unbox a)
1669− => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a
1363+ => D.Stream m (MutArray a) -> D.Stream m a
1670−concatWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
1364+flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)
@@ -1684,30 +1378,19 @@ concatWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
1684 return $ D.Skip $ OuterLoop st
1378 return $ D.Skip $ OuterLoop st
1686 step' _ (InnerLoop st contents p end) = do
1380 step' _ (InnerLoop st contents p end) = do
1687− x <- liftio $ peekAt p contents
1381+ x <- liftIO $ peekWith contents p
1688 return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)
1382 return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)
1690−-- | Use the "reader" unfold instead.
1384+-- | Use the "readerRev" unfold instead.
1692−-- @concat = unfoldMany reader@
1386+-- @flattenArrays = unfoldMany readerRev@
1694-- We can try this if there are any fusion issues in the unfold.
1388-- We can try this if there are any fusion issues in the unfold.
1696−{-# INLINE_NORMAL concat #-}
1390+{-# INLINE_NORMAL flattenArraysRev #-}
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 #-}
1703−flattenArrays :: forall m a. (MonadIO m, Unbox a)
1391+flattenArraysRev :: forall m a. (MonadIO m, Unbox a)
1704 => D.Stream m (MutArray a) -> D.Stream m a
1392 => 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
1710−concatRevWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
1393+flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)
@@ -1725,33 +1408,16 @@ concatRevWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
1725 return $ D.Skip $ OuterLoop st
1408 return $ D.Skip $ OuterLoop st
1727 step' _ (InnerLoop st contents p start) = do
1410 step' _ (InnerLoop st contents p start) = do
1728− x <- liftio $ peekAt p contents
1411+ x <- liftIO $ peekWith contents p
1729 let cur = INDEX_PREV(p,a)
1412 let cur = INDEX_PREV(p,a)
1730 return $ D.Yield x (InnerLoop st contents cur start)
1413 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
1749-------------------------------------------------------------------------------
1415-------------------------------------------------------------------------------
1750-- Unfolds
1416-- Unfolds
1751-------------------------------------------------------------------------------
1417-------------------------------------------------------------------------------
1753data ArrayUnsafe a = ArrayUnsafe
1419data ArrayUnsafe a = ArrayUnsafe
1754− {-# UNPACK #-} !MutByteArray -- contents
1420+ {-# UNPACK #-} !MutableByteArray -- contents
1755 {-# UNPACK #-} !Int -- index 1
1421 {-# UNPACK #-} !Int -- index 1
1756 {-# UNPACK #-} !Int -- index 2
1422 {-# UNPACK #-} !Int -- index 2
@@ -1781,7 +1447,7 @@ producerWith liftio = Producer step (return . toArrayUnsafe) extract
1781 -- few actions for correctness and execution order sanity. We want
1447 -- few actions for correctness and execution order sanity. We want
1782 -- the peek to occur right here and not lazily at some later point
1448 -- the peek to occur right here and not lazily at some later point
1783 -- because we want the peek to be ordered with respect to the touch.
1449 -- because we want the peek to be ordered with respect to the touch.
1784− !x <- liftio $ peekAt cur contents
1450+ !x <- liftio $ peekWith contents cur
1785 return $ D.Yield x (ArrayUnsafe contents (INDEX_NEXT(cur,a)) end)
1451 return $ D.Yield x (ArrayUnsafe contents (INDEX_NEXT(cur,a)) end)
1787 extract = return . fromArrayUnsafe
1453 extract = return . fromArrayUnsafe
@@ -1812,7 +1478,7 @@ readerRevWith liftio = Unfold step inject
1812 {-# INLINE_LATE step #-}
1478 {-# INLINE_LATE step #-}
1813 step (ArrayUnsafe _ start p) | p < start = return D.Stop
1479 step (ArrayUnsafe _ start p) | p < start = return D.Stop
1814 step (ArrayUnsafe contents start p) = do
1480 step (ArrayUnsafe contents start p) = do
1815− !x <- liftio $ peekAt p contents
1481+ !x <- liftio $ peekWith contents p
1816 return $ D.Yield x (ArrayUnsafe contents start (INDEX_PREV(p,a)))
1482 return $ D.Yield x (ArrayUnsafe contents start (INDEX_PREV(p,a)))
1818-- | Unfold an array into a stream in reverse order.
1484-- | Unfold an array into a stream in reverse order.
@@ -1843,15 +1509,14 @@ toListFB c n MutArray{..} = go arrStart
1843 -- evaluated/written to before we peek at them.
1509 -- evaluated/written to before we peek at them.
1845 let !x = unsafeInlineIO $ do
1511 let !x = unsafeInlineIO $ do
1846− r <- peekAt arrContents p
1512+ r <- peekWith arrContents p
1847 return r
1513 return r
1848 in c x (go (PTR_NEXT(p,a)))
1514 in c x (go (PTR_NEXT(p,a)))
1851-- XXX Monadic foldr/build fusion?
1517-- XXX Monadic foldr/build fusion?
1852-- Reference: https://www.researchgate.net/publication/220676509_Monadic_augment_and_generalised_short_cut_fusion
1518-- Reference: https://www.researchgate.net/publication/220676509_Monadic_augment_and_generalised_short_cut_fusion
1854−-- | Convert a 'MutArray' into a list.
1519+-- | Convert an 'MutArray' into a list.
1856{-# INLINE toList #-}
1521{-# INLINE toList #-}
1857toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]
1522toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]
@@ -1860,53 +1525,54 @@ toList MutArray{..} = liftIO $ go arrStart
1861 go p | assert (p <= arrEnd) (p == arrEnd) = return []
1526 go p | assert (p <= arrEnd) (p == arrEnd) = return []
1862 go p = do
1527 go p = do
1863− x <- peekAt p arrContents
1528+ x <- peekWith arrContents p
1864 (:) x <$> go (INDEX_NEXT(p,a))
1529 (:) x <$> go (INDEX_NEXT(p,a))
1866−{-# INLINE_NORMAL toStreamWith #-}
1531+{-# INLINE_NORMAL toStreamDWith #-}
1867−toStreamWith ::
1532+toStreamDWith ::
1868 forall m a. (Monad m, Unbox a)
1533 forall m a. (Monad m, Unbox a)
1869 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1534 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1870−toStreamWith liftio MutArray{..} = D.Stream step arrStart
1535+toStreamDWith liftio MutArray{..} = D.Stream step arrStart
1874 {-# INLINE_LATE step #-}
1539 {-# INLINE_LATE step #-}
1875 step _ p | assert (p <= arrEnd) (p == arrEnd) = return D.Stop
1540 step _ p | assert (p <= arrEnd) (p == arrEnd) = return D.Stop
1876 step _ p = liftio $ do
1541 step _ p = liftio $ do
1877− r <- peekAt p arrContents
1542+ r <- peekWith arrContents p
1878 return $ D.Yield r (INDEX_NEXT(p,a))
1543 return $ D.Yield r (INDEX_NEXT(p,a))
1880−-- | Convert a 'MutArray' into a stream.
1545+-- | Use the 'reader' unfold instead.
1882−-- >>> read = Stream.unfold MutArray.reader
1547+-- @toStreamD = D.unfold reader@
1549+-- We can try this if the unfold has any performance issues.
1884−{-# INLINE_NORMAL read #-}
1550+{-# INLINE_NORMAL toStreamD #-}
1885−read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1551+toStreamD :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1886−read = toStreamWith liftIO
1552+toStreamD = toStreamDWith liftIO
1888{-# INLINE toStreamKWith #-}
1554{-# INLINE toStreamKWith #-}
1889toStreamKWith ::
1555toStreamKWith ::
1890 forall m a. (Monad m, Unbox a)
1556 forall m a. (Monad m, Unbox a)
1891− => (forall b. IO b -> m b) -> MutArray a -> StreamK m a
1557+ => (forall b. IO b -> m b) -> MutArray a -> K.Stream m a
1892toStreamKWith liftio MutArray{..} = go arrStart
1558toStreamKWith liftio MutArray{..} = go arrStart
1896 go p | assert (p <= arrEnd) (p == arrEnd) = K.nil
1562 go p | assert (p <= arrEnd) (p == arrEnd) = K.nil
1897 | otherwise =
1563 | otherwise =
1898− let elemM = peekAt p arrContents
1564+ let elemM = peekWith arrContents p
1899 in liftio elemM `K.consM` go (INDEX_NEXT(p,a))
1565 in liftio elemM `K.consM` go (INDEX_NEXT(p,a))
1901{-# INLINE toStreamK #-}
1567{-# INLINE toStreamK #-}
1902−toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a
1568+toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> K.Stream m a
1903toStreamK = toStreamKWith liftIO
1569toStreamK = toStreamKWith liftIO
1905−{-# INLINE_NORMAL toStreamRevWith #-}
1571+{-# INLINE_NORMAL toStreamDRevWith #-}
1906−toStreamRevWith ::
1572+toStreamDRevWith ::
1907 forall m a. (Monad m, Unbox a)
1573 forall m a. (Monad m, Unbox a)
1908 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1574 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1909−toStreamRevWith liftio MutArray{..} =
1575+toStreamDRevWith liftio MutArray{..} =
1910 let p = INDEX_PREV(arrEnd,a)
1576 let p = INDEX_PREV(arrEnd,a)
1911 in D.Stream step p
1577 in D.Stream step p
@@ -1915,21 +1581,22 @@ toStreamRevWith liftio MutArray{..} =
1915 {-# INLINE_LATE step #-}
1581 {-# INLINE_LATE step #-}
1916 step _ p | p < arrStart = return D.Stop
1582 step _ p | p < arrStart = return D.Stop
1917 step _ p = liftio $ do
1583 step _ p = liftio $ do
1918− r <- peekAt p arrContents
1584+ r <- peekWith arrContents p
1919 return $ D.Yield r (INDEX_PREV(p,a))
1585 return $ D.Yield r (INDEX_PREV(p,a))
1921−-- | Convert a 'MutArray' into a stream in reverse order.
1587+-- | Use the 'readerRev' unfold instead.
1923−-- >>> readRev = Stream.unfold MutArray.readerRev
1589+-- @toStreamDRev = D.unfold readerRev@
1591+-- We can try this if the unfold has any perf issues.
1925−{-# INLINE_NORMAL readRev #-}
1592+{-# INLINE_NORMAL toStreamDRev #-}
1926−readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1593+toStreamDRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1927−readRev = toStreamRevWith liftIO
1594+toStreamDRev = toStreamDRevWith liftIO
1929{-# INLINE toStreamKRevWith #-}
1596{-# INLINE toStreamKRevWith #-}
1930toStreamKRevWith ::
1597toStreamKRevWith ::
1931 forall m a. (Monad m, Unbox a)
1598 forall m a. (Monad m, Unbox a)
1932− => (forall b. IO b -> m b) -> MutArray a -> StreamK m a
1599+ => (forall b. IO b -> m b) -> MutArray a -> K.Stream m a
1933toStreamKRevWith liftio MutArray {..} =
1600toStreamKRevWith liftio MutArray {..} =
1934 let p = INDEX_PREV(arrEnd,a)
1601 let p = INDEX_PREV(arrEnd,a)
@@ -1938,11 +1605,11 @@ toStreamKRevWith liftio MutArray {..} =
1939 go p | p < arrStart = K.nil
1606 go p | p < arrStart = K.nil
1940 | otherwise =
1607 | otherwise =
1941− let elemM = peekAt p arrContents
1608+ let elemM = peekWith arrContents p
1942 in liftio elemM `K.consM` go (INDEX_PREV(p,a))
1609 in liftio elemM `K.consM` go (INDEX_PREV(p,a))
1944{-# INLINE toStreamKRev #-}
1611{-# INLINE toStreamKRev #-}
1945−toStreamKRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a
1612+toStreamKRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> K.Stream m a
1946toStreamKRev = toStreamKRevWith liftIO
1613toStreamKRev = toStreamKRevWith liftIO
1948-------------------------------------------------------------------------------
1615-------------------------------------------------------------------------------
@@ -1955,12 +1622,12 @@ toStreamKRev = toStreamKRevWith liftIO
1955-- | Strict left fold of an array.
1622-- | Strict left fold of an array.
1956{-# INLINE_NORMAL foldl' #-}
1623{-# INLINE_NORMAL foldl' #-}
1957foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> MutArray a -> m b
1624foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> MutArray a -> m b
1958−foldl' f z arr = D.foldl' f z $ read arr
1625+foldl' f z arr = D.foldl' f z $ toStreamD arr
1960-- | Right fold of an array.
1627-- | Right fold of an array.
1961{-# INLINE_NORMAL foldr #-}
1628{-# INLINE_NORMAL foldr #-}
1962foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> MutArray a -> m b
1629foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> MutArray a -> m b
1963−foldr f z arr = D.foldr f z $ read arr
1630+foldr f z arr = D.foldr f z $ toStreamD arr
1965-------------------------------------------------------------------------------
1632-------------------------------------------------------------------------------
@@ -1973,7 +1640,7 @@ foldr f z arr = D.foldr f z $ read arr
1974-- XXX Keep the bound intact to not lose any free space? Perf impact?
1641-- XXX Keep the bound intact to not lose any free space? Perf impact?
1976−-- | @unsafeAppendN n arr@ appends up to @n@ input items to the supplied
1643+-- | @writeAppendNUnsafe n alloc@ appends up to @n@ input items to the supplied
1977-- array.
1644-- array.
1979-- Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory
1646-- Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory
@@ -1982,12 +1649,13 @@ foldr f z arr = D.foldr f z $ read arr
1982-- Any free space left in the array after appending @n@ elements is lost.
1649-- Any free space left in the array after appending @n@ elements is lost.
1984-- /Internal/
1651-- /Internal/
1985−{-# INLINE_NORMAL unsafeAppendN #-}
1652+{-# INLINE_NORMAL writeAppendNUnsafe #-}
1986−unsafeAppendN :: forall m a. (MonadIO m, Unbox a) =>
1653+writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>
1988 -> m (MutArray a)
1655 -> m (MutArray a)
1989 -> Fold m a (MutArray a)
1656 -> Fold m a (MutArray a)
1657+writeAppendNUnsafe n action =
1990−unsafeAppendN n action = fmap fromArrayUnsafe $ FL.foldlM' step initial
1658+ fmap fromArrayUnsafe $ FL.foldlM' step initial
@@ -2000,59 +1668,38 @@ unsafeAppendN n action = fmap fromArrayUnsafe $ FL.foldlM' step initial
2000 -- otherwise we lose that space.
1668 -- otherwise we lose that space.
2002 if free < needed
1670 if free < needed
2003− then noinline reallocWith "unsafeAppendN" (+ needed) needed arr
1671+ then noinline reallocWith "writeAppendNUnsafeWith" (+ needed) needed arr
2004 else return arr
1672 else return arr
2005 return $ toArrayUnsafe arr1
1673 return $ toArrayUnsafe arr1
2007 step (ArrayUnsafe contents start end) x = do
1675 step (ArrayUnsafe contents start end) x = do
2008− liftIO $ pokeAt end contents x
1676+ liftIO $ pokeWith contents end x
2009 return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
1677 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
2019-- | Append @n@ elements to an existing array. Any free space left in the array
1679-- | Append @n@ elements to an existing array. Any free space left in the array
2020-- after appending @n@ elements is lost.
1680-- after appending @n@ elements is lost.
2022−-- >>> appendN n initial = Fold.take n (MutArray.unsafeAppendN n initial)
1682+-- >>> writeAppendN n initial = Fold.take n (MutArray.writeAppendNUnsafe n initial)
2024−{-# INLINE_NORMAL appendN #-}
1684+{-# INLINE_NORMAL writeAppendN #-}
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 #-}
2032writeAppendN :: forall m a. (MonadIO m, Unbox a) =>
1685writeAppendN :: forall m a. (MonadIO m, Unbox a) =>
2033 Int -> m (MutArray a) -> Fold m a (MutArray a)
1686 Int -> m (MutArray a) -> Fold m a (MutArray a)
2034−writeAppendN = appendN
1687+writeAppendN n initial = FL.take n (writeAppendNUnsafe n initial)
2036−-- | @appendWith realloc action@ mutates the array generated by @action@ to
1689+-- | @writeAppendWith realloc action@ mutates the array generated by @action@ to
2037-- append the input stream. If there is no reserved space available in the
1690-- append the input stream. If there is no reserved space available in the
2038-- array it is reallocated to a size in bytes determined by @realloc oldSize@,
1691-- array it is reallocated to a size in bytes determined by @realloc oldSize@,
2039-- where @oldSize@ is the current size of the array in bytes.
1692-- where @oldSize@ is the current size of the array in bytes.
2041-- Note that the returned array may be a mutated version of original array.
1694-- Note that the returned array may be a mutated version of original array.
2043−-- >>> appendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)
1696+-- >>> writeAppendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)
2045-- /Pre-release/
1698-- /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." #-}
2052{-# INLINE writeAppendWith #-}
1699{-# INLINE writeAppendWith #-}
2053writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
1700writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
2054 (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
1701 (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
2055−writeAppendWith = appendWith
1702+writeAppendWith sizer = FL.foldlM' (snocWith sizer)
2057-- | @append action@ mutates the array generated by @action@ to append the
1704-- | @append action@ mutates the array generated by @action@ to append the
2058-- input stream. If there is no reserved space available in the array it is
1705-- input stream. If there is no reserved space available in the array it is
@@ -2060,144 +1707,72 @@ writeAppendWith = appendWith
2061-- Note that the returned array may be a mutated version of original array.
1708-- Note that the returned array may be a mutated version of original array.
2063−-- >>> append = MutArray.appendWith (* 2)
1710+-- >>> writeAppend = MutArray.writeAppendWith (* 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." #-}
2072{-# INLINE writeAppend #-}
1712{-# INLINE writeAppend #-}
2073writeAppend :: forall m a. (MonadIO m, Unbox a) =>
1713writeAppend :: forall m a. (MonadIO m, Unbox a) =>
2074 m (MutArray a) -> Fold m a (MutArray a)
1714 m (MutArray a) -> Fold m a (MutArray a)
2075−writeAppend = append
1715+writeAppend = writeAppendWith (* 2)
2077-- XXX We can carry bound as well in the state to make sure we do not lose the
1717-- XXX We can carry bound as well in the state to make sure we do not lose the
2078-- remaining capacity. Need to check perf impact.
1718-- remaining capacity. Need to check perf impact.
2080−-- | Like 'unsafeCreateOf' but takes a new array allocator @alloc size@
1720+-- | Like 'writeNUnsafe' but takes a new array allocator @alloc size@ function
2081−-- function as argument.
1721+-- as argument.
2083−-- >>> unsafeCreateOfWith alloc n = MutArray.unsafeAppendN (alloc n) n
1723+-- >>> writeNWithUnsafe alloc n = MutArray.writeAppendNUnsafe (alloc n) n
2085-- /Pre-release/
1725-- /Pre-release/
2086−{-# INLINE_NORMAL unsafeCreateOfWith #-}
1726+{-# INLINE_NORMAL writeNWithUnsafe #-}
2087−unsafeCreateOfWith :: forall m a. (MonadIO m, Unbox a)
1727+writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)
2088 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1728 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2089−unsafeCreateOfWith alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
1729+writeNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
2093 initial = toArrayUnsafe <$> alloc (max n 0)
1733 initial = toArrayUnsafe <$> alloc (max n 0)
2095 step (ArrayUnsafe contents start end) x = do
1735 step (ArrayUnsafe contents start end) x = do
2096− liftIO $ pokeAt end contents x
1736+ liftIO $ pokeWith contents end x
2098 $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
1738 $ 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
2106−{-# INLINE_NORMAL writeNUnsafeAs #-}
2107−writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)
2108− => PinnedState -> Int -> Fold m a (MutArray a)
2109−writeNUnsafeAs ps = unsafeCreateOfWith (newAs ps)
2111−-- | Like 'createOf' but does not check the array bounds when writing. The fold
1740+-- | Like 'writeN' but does not check the array bounds when writing. The fold
2112-- driver must not call the step function more than 'n' times otherwise it will
1741-- driver must not call the step function more than 'n' times otherwise it will
2113-- corrupt the memory and crash. This function exists mainly because any
1742-- corrupt the memory and crash. This function exists mainly because any
2114-- conditional in the step function blocks fusion causing 10x performance
1743-- conditional in the step function blocks fusion causing 10x performance
2115-- slowdown.
1744-- slowdown.
2117−-- >>> unsafeCreateOf = MutArray.unsafeCreateOfWith MutArray.emptyOf
1746+-- >>> writeNUnsafe = MutArray.writeNWithUnsafe MutArray.newPinned
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." #-}
2125−{-# INLINE writeNUnsafe #-}
1748+{-# INLINE_NORMAL writeNUnsafe #-}
2126writeNUnsafe :: forall m a. (MonadIO m, Unbox a)
1749writeNUnsafe :: forall m a. (MonadIO m, Unbox a)
2127 => Int -> Fold m a (MutArray a)
1750 => Int -> Fold m a (MutArray a)
2128−writeNUnsafe = unsafeCreateOf
1751+writeNUnsafe = writeNWithUnsafe newPinned
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
2136−{-# DEPRECATED pinnedWriteNUnsafe "Please use unsafePinnedCreateOf instead." #-}
2137−{-# INLINE pinnedWriteNUnsafe #-}
2138−pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)
2139− => Int -> Fold m a (MutArray a)
2140−pinnedWriteNUnsafe = unsafePinnedCreateOf
2142−-- | @createOfWith alloc n@ folds a maximum of @n@ elements into an array
1753+-- | @writeNWith alloc n@ folds a maximum of @n@ elements into an array
2143-- allocated using the @alloc@ function.
1754-- allocated using the @alloc@ function.
2145−-- >>> createOfWith alloc n = Fold.take n (MutArray.unsafeCreateOfWith alloc n)
1756+-- >>> writeNWith alloc n = Fold.take n (MutArray.writeNWithUnsafe alloc n)
2146−-- >>> createOfWith alloc n = MutArray.appendN (alloc n) n
1757+-- >>> writeNWith alloc n = MutArray.writeAppendN (alloc n) n
2148−{-# INLINE_NORMAL createOfWith #-}
1759+{-# INLINE_NORMAL writeNWith #-}
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 #-}
2155writeNWith :: forall m a. (MonadIO m, Unbox a)
1760writeNWith :: forall m a. (MonadIO m, Unbox a)
2156 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1761 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2157−writeNWith = createOfWith
1762+writeNWith alloc n = FL.take n (writeNWithUnsafe alloc n)
2159−{-# INLINE_NORMAL writeNAs #-}
2161− forall m a. (MonadIO m, Unbox a)
2164− -> Fold m a (MutArray a)
2165−writeNAs ps = createOfWith (newAs ps)
2167−-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an
1764+-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an
2168-- 'MutArray'.
1765-- 'MutArray'.
2170−-- >>> createOf = MutArray.createOfWith MutArray.new
1767+-- >>> writeN = MutArray.writeNWith MutArray.newPinned
2171−-- >>> createOf n = Fold.take n (MutArray.unsafeCreateOf n)
1768+-- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)
2172−-- >>> createOf n = MutArray.appendN n (MutArray.emptyOf n)
1769+-- >>> writeN n = MutArray.writeAppendN n (MutArray.newPinned n)
2174−{-# INLINE_NORMAL createOf #-}
1771+{-# INLINE_NORMAL writeN #-}
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 #-}
2181writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
1772writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2182−writeN = createOf
1773+writeN = writeNWith newPinned
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." #-}
2193−{-# INLINE pinnedWriteN #-}
2195− forall m a. (MonadIO m, Unbox a)
2197− -> Fold m a (MutArray a)
2198−pinnedWriteN = pinnedCreateOf
2200−-- | Like unsafeCreateOfWith but writes the array in reverse order.
1775+-- | Like writeNWithUnsafe but writes the array in reverse order.
2202-- /Internal/
1777-- /Internal/
2203{-# INLINE_NORMAL writeRevNWithUnsafe #-}
1778{-# INLINE_NORMAL writeRevNWithUnsafe #-}
@@ -2214,11 +1789,11 @@ writeRevNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
2215 step (ArrayUnsafe contents start end) x = do
1790 step (ArrayUnsafe contents start end) x = do
2216 let ptr = INDEX_PREV(start,a)
1791 let ptr = INDEX_PREV(start,a)
2217− liftIO $ pokeAt ptr contents x
1792+ liftIO $ pokeWith contents ptr x
2219 $ ArrayUnsafe contents ptr end
1794 $ ArrayUnsafe contents ptr end
2221−-- | Like createOfWith but writes the array in reverse order.
1796+-- | Like writeNWith but writes the array in reverse order.
2223-- /Internal/
1798-- /Internal/
2224{-# INLINE_NORMAL writeRevNWith #-}
1799{-# INLINE_NORMAL writeRevNWith #-}
@@ -2226,36 +1801,31 @@ writeRevNWith :: forall m a. (MonadIO m, Unbox a)
2226 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1801 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2227writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)
1802writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)
2229−-- | Like 'createOf' but writes the array in reverse order.
1804+-- | Like writeN but writes the array in reverse order.
2231-- /Pre-release/
1806-- /Pre-release/
2232−{-# INLINE_NORMAL revCreateOf #-}
1807+{-# INLINE_NORMAL writeRevN #-}
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 #-}
2238writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
1808writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2239−writeRevN = revCreateOf
1809+writeRevN = writeRevNWith newPinned
2241−-- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the
1811+-- | @writeNAligned align n@ folds a maximum of @n@ elements from the input
2242−-- input stream to a 'MutArray' aligned to the given size.
1812+-- stream to an 'MutArray' aligned to the given size.
2244−-- >>> pinnedWriteNAligned align = MutArray.createOfWith (MutArray.pinnedNewAligned align)
1814+-- >>> writeNAligned align = MutArray.writeNWith (MutArray.newAlignedPinned align)
2245−-- >>> pinnedWriteNAligned align n = MutArray.appendN n (MutArray.pinnedNewAligned align n)
1815+-- >>> writeNAligned align n = MutArray.writeAppendN n (MutArray.newAlignedPinned align n)
2247-- /Pre-release/
1817-- /Pre-release/
2249−{-# INLINE_NORMAL pinnedWriteNAligned #-}
1819+{-# INLINE_NORMAL writeNAligned #-}
2250−pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)
1820+writeNAligned :: forall m a. (MonadIO m, Unbox a)
2251 => Int -> Int -> Fold m a (MutArray a)
1821 => Int -> Int -> Fold m a (MutArray a)
2252−pinnedWriteNAligned align = createOfWith (pinnedNewAligned align)
1822+writeNAligned align = writeNWith (newAlignedPinned align)
2254-- XXX Buffer to a list instead?
1824-- XXX Buffer to a list instead?
2256-- | Buffer a stream into a stream of arrays.
1826-- | Buffer a stream into a stream of arrays.
2258−-- >>> buildChunks n = Fold.many (MutArray.createOf n) Fold.toStreamK
1828+-- >>> writeChunks n = Fold.many (MutArray.writeN n) Fold.toStreamK
2260-- Breaking an array into an array stream can be useful to consume a large
1830-- Breaking an array into an array stream can be useful to consume a large
2261-- array sequentially such that memory of the array is released incrementatlly.
1831-- array sequentially such that memory of the array is released incrementatlly.
@@ -2264,43 +1834,14 @@ pinnedWriteNAligned align = createOfWith (pinnedNewAligned align)
2265-- /Unimplemented/
1835-- /Unimplemented/
2267−{-# INLINE_NORMAL buildChunks #-}
1837+{-# INLINE_NORMAL writeChunks #-}
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 #-}
2274writeChunks :: (MonadIO m, Unbox a) =>
1838writeChunks :: (MonadIO m, Unbox a) =>
2275− Int -> Fold m a (StreamK n (MutArray a))
1839+ Int -> Fold m a (K.Stream n (MutArray a))
2276−writeChunks = buildChunks
1840+writeChunks n = FL.many (writeN n) FL.toStreamK
2278−{-# INLINE_NORMAL writeWithAs #-}
2279−writeWithAs :: forall m a. (MonadIO m, Unbox a)
2280− => PinnedState -> Int -> Fold m a (MutArray a)
2281−-- writeWithAs ps n = FL.rmapM rightSize $ appendWith (* 2) (newAs ps n)
2282−writeWithAs ps elemCount =
2283− FL.rmapM extract $ FL.foldlM' step initial
2288− when (elemCount < 0) $ error "createWith: elemCount is negative"
2291− step arr@(MutArray _ start end bound) x
2292− | INDEX_NEXT(end,a) > bound = do
2293− let oldSize = end - start
2294− newSize = max (oldSize * 2) 1
2295− arr1 <- liftIO $ reallocExplicitAs ps (SIZE_OF(a)) newSize arr
2297− step arr x = snocUnsafe arr x
2299− extract = liftIO . rightSize
2301−-- XXX Compare createWith with fromStreamD which uses an array of streams
1842+-- XXX Compare writeWith with fromStreamD which uses an array of streams
2302−-- implementation. We can write this using buildChunks above if that is faster.
1843+-- implementation. We can write this using writeChunks above if that is faster.
2303−-- If createWith is faster then we should use that to implement
1844+-- If writeWith is faster then we should use that to implement
2304-- fromStreamD.
1845-- fromStreamD.
2306-- XXX The realloc based implementation needs to make one extra copy if we use
1847-- XXX The realloc based implementation needs to make one extra copy if we use
@@ -2315,92 +1856,77 @@ writeWithAs ps elemCount =
2315-- XXX check if GHC's memory allocator is efficient enough. We can try the C
1856-- XXX check if GHC's memory allocator is efficient enough. We can try the C
2316-- malloc to compare against.
1857-- malloc to compare against.
2318−-- | @createWith minCount@ folds the whole input to a single array. The array
1859+-- | @writeWith minCount@ folds the whole input to a single array. The array
2319-- starts at a size big enough to hold minCount elements, the size is doubled
1860-- starts at a size big enough to hold minCount elements, the size is doubled
2320-- every time the array needs to be grown.
1861-- every time the array needs to be grown.
2322-- /Caution! Do not use this on infinite streams./
1863-- /Caution! Do not use this on infinite streams./
2324−-- >>> f n = MutArray.appendWith (* 2) (MutArray.emptyOf n)
1865+-- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.newPinned n)
2325−-- >>> createWith n = Fold.rmapM MutArray.rightSize (f n)
1866+-- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)
2326−-- >>> createWith n = Fold.rmapM MutArray.fromChunksK (MutArray.buildChunks n)
1867+-- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)
2328-- /Pre-release/
1869-- /Pre-release/
2329−{-# INLINE_NORMAL createWith #-}
1870+{-# INLINE_NORMAL writeWith #-}
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 #-}
2337writeWith :: forall m a. (MonadIO m, Unbox a)
1871writeWith :: forall m a. (MonadIO m, Unbox a)
2338 => Int -> Fold m a (MutArray a)
1872 => Int -> Fold m a (MutArray a)
2339−writeWith = createWith
1873+-- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (newPinned n)
1874+writeWith elemCount =
1875+ FL.rmapM extract $ FL.foldlM' step initial
1879+ insertElem (MutArray contents start end bound) x = do
1880+ liftIO $ pokeWith contents end x
1881+ return $ MutArray contents start (INDEX_NEXT(end,a)) bound
1884+ when (elemCount < 0) $ error "writeWith: elemCount is negative"
1885+ liftIO $ newPinned elemCount
1886+ step arr@(MutArray _ start end bound) x
1887+ | INDEX_NEXT(end,a) > bound = do
1888+ let oldSize = end - start
1889+ newSize = max (oldSize * 2) 1
1890+ arr1 <- liftIO $ reallocExplicit (SIZE_OF(a)) newSize arr
1892+ step arr x = insertElem arr x
1893+ extract = liftIO . rightSize
2341-- | Fold the whole input to a single array.
1895-- | Fold the whole input to a single array.
2343−-- Same as 'createWith' using an initial array size of 'arrayChunkBytes' bytes
1897+-- Same as 'writeWith' using an initial array size of 'arrayChunkBytes' bytes
2344-- rounded up to the element size.
1898-- rounded up to the element size.
2346-- /Caution! Do not use this on infinite streams./
1900-- /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." #-}
2354{-# INLINE write #-}
1902{-# INLINE write #-}
2355write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
1903write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
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)
1904+write = writeWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
2364−{-# DEPRECATED pinnedWrite "Please use pinnedCreate instead." #-}
2365−{-# INLINE pinnedWrite #-}
2366−pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2367−pinnedWrite = pinnedCreate
2369-------------------------------------------------------------------------------
1906-------------------------------------------------------------------------------
2370-- construct from streams, known size
1907-- construct from streams, known size
2371-------------------------------------------------------------------------------
1908-------------------------------------------------------------------------------
1910+-- | Use the 'writeN' fold instead.
1912+-- >>> fromStreamDN n = StreamD.fold (MutArray.writeN n)
2373−{-# INLINE_NORMAL fromStreamDNAs #-}
1914+{-# INLINE_NORMAL fromStreamDN #-}
2374−fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)
1915+fromStreamDN :: forall m a. (MonadIO m, Unbox a)
2375− => PinnedState -> Int -> D.Stream m a -> m (MutArray a)
1916+ => Int -> D.Stream m a -> m (MutArray a)
1917+-- fromStreamDN n = D.fold (writeN n)
2376−fromStreamDNAs ps limit str = do
1918+fromStreamDN limit str = do
2377− (arr :: MutArray a) <- newAs ps limit
1919+ (arr :: MutArray a) <- liftIO $ newPinned limit
2378 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str
1920 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str
2379 return $ arr {arrEnd = end}
1921 return $ arr {arrEnd = end}
2383 fwrite arrContents ptr x = do
1925 fwrite arrContents ptr x = do
2384− liftIO $ pokeAt ptr arrContents x
1926+ liftIO $ pokeWith arrContents ptr x
2385 return $ INDEX_NEXT(ptr,a)
1927 return $ INDEX_NEXT(ptr,a)
2387−-- | Use the 'createOf' fold instead.
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." #-}
2398−{-# INLINE fromStreamDN #-}
2399−fromStreamDN :: forall m a. (MonadIO m, Unbox a)
2400− => Int -> D.Stream m a -> m (MutArray a)
2401−fromStreamDN = fromStreamN
2403−-- | Create a 'MutArray' from the first N elements of a list. The array is
1929+-- | Create an 'MutArray' from the first N elements of a list. The array is
2404-- allocated to size N, if the list terminates before N elements then the
1930-- allocated to size N, if the list terminates before N elements then the
2405-- array may hold less than N elements.
1931-- array may hold less than N elements.
@@ -2408,167 +1934,54 @@ fromStreamDN = fromStreamN
2408fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
1934fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
2409fromListN n xs = fromStreamDN n $ D.fromList xs
1935fromListN n xs = fromStreamDN n $ D.fromList xs
2411−-- | Like 'fromListN' but creates a pinned array.
2412−{-# INLINABLE pinnedFromListN #-}
2413−pinnedFromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
2414−pinnedFromListN n xs = fromStreamDNAs Pinned n $ D.fromList xs
2416-- | Like fromListN but writes the array in reverse order.
1937-- | Like fromListN but writes the array in reverse order.
2418-- /Pre-release/
1939-- /Pre-release/
2419{-# INLINE fromListRevN #-}
1940{-# INLINE fromListRevN #-}
2420fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
1941fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
2421−fromListRevN n xs = D.fold (revCreateOf n) $ D.fromList xs
1942+fromListRevN n xs = D.fold (writeRevN 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
2430−-- | Convert a pure stream in Identity monad to a mutable array.
2431−{-# INLINABLE fromPureStream #-}
2432−fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)
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})
2462-------------------------------------------------------------------------------
1944-------------------------------------------------------------------------------
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−-------------------------------------------------------------------------------
2484−-- convert a stream of arrays to a single array by buffering arrays first
1945+-- convert stream to a single array
2485-------------------------------------------------------------------------------
1946-------------------------------------------------------------------------------
2487{-# INLINE arrayStreamKLength #-}
1948{-# INLINE arrayStreamKLength #-}
2488−arrayStreamKLength :: (Monad m, Unbox a) => StreamK m (MutArray a) -> m Int
1949+arrayStreamKLength :: (Monad m, Unbox a) => K.Stream m (MutArray a) -> m Int
2489arrayStreamKLength as = K.foldl' (+) 0 (K.map length as)
1950arrayStreamKLength as = K.foldl' (+) 0 (K.map length as)
2491-- | Convert an array stream to an array. Note that this requires peak memory
1952-- | Convert an array stream to an array. Note that this requires peak memory
2492-- that is double the size of the array stream.
1953-- 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." #-}
2518{-# INLINE fromArrayStreamK #-}
1955{-# INLINE fromArrayStreamK #-}
2519fromArrayStreamK :: (Unbox a, MonadIO m) =>
1956fromArrayStreamK :: (Unbox a, MonadIO m) =>
2520− StreamK m (MutArray a) -> m (MutArray a)
1957+ K.Stream m (MutArray a) -> m (MutArray a)
2521−fromArrayStreamK = fromChunksK
1958+fromArrayStreamK as = do
2522−
1959+ len <- arrayStreamKLength as
2523−{-# INLINE fromStreamDAs #-}
1960+ fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as
2525− (MonadIO m, Unbox a) => PinnedState -> D.Stream m a -> m (MutArray a)
2526−fromStreamDAs ps m =
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
2543-- CAUTION: a very large number (millions) of arrays can degrade performance
1962-- CAUTION: a very large number (millions) of arrays can degrade performance
2544-- due to GC overhead because we need to buffer the arrays before we flatten
1963-- due to GC overhead because we need to buffer the arrays before we flatten
2545-- all the arrays.
1964-- all the arrays.
2547−-- XXX Compare if this is faster or "fold create".
1966+-- XXX Compare if this is faster or "fold write".
2549-- | We could take the approach of doubling the memory allocation on each
1968-- | We could take the approach of doubling the memory allocation on each
2550-- overflow. This would result in more or less the same amount of copying as in
1969-- overflow. This would result in more or less the same amount of copying as in
2551-- the chunking approach. However, if we have to shrink in the end then it may
1970-- the chunking approach. However, if we have to shrink in the end then it may
2552-- result in an extra copy of the entire data.
1971-- result in an extra copy of the entire data.
2554−-- >>> fromStreamD = StreamD.fold MutArray.create
1973+-- >>> fromStreamD = StreamD.fold MutArray.write
2556{-# INLINE fromStreamD #-}
1975{-# INLINE fromStreamD #-}
2557−{-# DEPRECATED fromStreamD "Please use fromStream instead." #-}
2558fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)
1976fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)
2559−fromStreamD = fromStream
1977+fromStreamD m = arrayStreamKFromStreamD m >>= fromArrayStreamK
2561−-- | Create a 'MutArray' from a list. The list must be of finite size.
1979+-- | Create an 'MutArray' from a list. The list must be of finite size.
2563{-# INLINE fromList #-}
1981{-# INLINE fromList #-}
2564fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)
1982fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)
2565fromList xs = fromStreamD $ D.fromList xs
1983fromList xs = fromStreamD $ D.fromList xs
2567−-- | Like 'fromList' but creates a pinned array.
2568−{-# INLINE pinnedFromList #-}
2569−pinnedFromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)
2570−pinnedFromList xs = fromStreamDAs Pinned $ D.fromList xs
2572-- XXX We are materializing the whole list first for getting the length. Check
1985-- XXX We are materializing the whole list first for getting the length. Check
2573-- if the 'fromList' like chunked implementation would fare better.
1986-- if the 'fromList' like chunked implementation would fare better.
@@ -2577,75 +1990,44 @@ pinnedFromList xs = fromStreamDAs Pinned $ D.fromList xs
2577fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)
1990fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)
2578fromListRev xs = fromListRevN (Prelude.length xs) xs
1991fromListRev xs = fromListRevN (Prelude.length xs) xs
2580−-------------------------------------------------------------------------------
2582−-------------------------------------------------------------------------------
2584−-- Arrays are aligned on 64-bit boundaries. The fastest way to copy an array is
2585−-- to unsafeCast it to Word64, read it, write it to Word64 array and unsafeCast
2586−-- it again. We can use SIMD read/write as well.
2588−{-# INLINE cloneAs #-}
2595− => PinnedState -> MutArray a -> m (MutArray a)
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-------------------------------------------------------------------------------
1993-------------------------------------------------------------------------------
2625-- Combining
1994-- Combining
2626-------------------------------------------------------------------------------
1995-------------------------------------------------------------------------------
1997+-- | Put a sub range of a source array into a subrange of a destination array.
1998+-- This is not safe as it does not check the bounds.
1999+{-# INLINE putSliceUnsafe #-}
2000+putSliceUnsafe :: MonadIO m => MutArray a -> Int -> MutArray a -> Int -> Int -> m ()
2001+putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do
2002+ assertM(lenBytes <= arrBound dst - dstStartBytes)
2003+ assertM(lenBytes <= arrEnd src - srcStartBytes)
2004+ let !(I# srcStartBytes#) = srcStartBytes
2005+ !(I# dstStartBytes#) = dstStartBytes
2006+ !(I# lenBytes#) = lenBytes
2007+ let arrS# = getMutableByteArray# (arrContents src)
2008+ arrD# = getMutableByteArray# (arrContents dst)
2009+ IO $ \s# -> (# copyMutableByteArray#
2010+ arrS# srcStartBytes# arrD# dstStartBytes# lenBytes# s#
2628−-- | Copy two arrays into a newly allocated array. If the first array is pinned
2013+-- | Copy two arrays into a newly allocated array.
2629−-- the spliced array is also pinned.
2630{-# INLINE spliceCopy #-}
2014{-# INLINE spliceCopy #-}
2631spliceCopy :: forall m a. MonadIO m =>
2015spliceCopy :: forall m a. MonadIO m =>
2632#ifdef DEVBUILD
2016#ifdef DEVBUILD
2633 Unbox a =>
2017 Unbox a =>
2635 MutArray a -> MutArray a -> m (MutArray a)
2019 MutArray a -> MutArray a -> m (MutArray a)
2636−spliceCopy arr1 arr2 = do
2020+spliceCopy arr1 arr2 = liftIO $ do
2637 let start1 = arrStart arr1
2021 let start1 = arrStart arr1
2638 start2 = arrStart arr2
2022 start2 = arrStart arr2
2639 len1 = arrEnd arr1 - start1
2023 len1 = arrEnd arr1 - start1
2640 len2 = arrEnd arr2 - start2
2024 len2 = arrEnd arr2 - start2
2025+ newArrContents <- liftIO $ Unboxed.newPinnedBytes (len1 + len2)
2641 let len = len1 + len2
2026 let len = len1 + len2
2642− newArrContents <-
2027+ newArr = MutArray newArrContents 0 len len
2643− if Unboxed.isPinned (arrContents arr1)
2644− then liftIO $ Unboxed.pinnedNew len
2645− else liftIO $ Unboxed.new len
2646− putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1
2028+ putSliceUnsafe arr1 start1 newArr 0 len1
2647− putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2
2029+ putSliceUnsafe arr2 start2 newArr len1 len2
2648− return $ MutArray newArrContents 0 len len
2030+ return newArr
2650-- | Really really unsafe, appends the second array into the first array. If
2032-- | Really really unsafe, appends the second array into the first array. If
2651-- the first array does not have enough space it may cause silent data
2033-- the first array does not have enough space it may cause silent data
@@ -2654,13 +2036,12 @@ spliceCopy arr1 arr2 = do
2654spliceUnsafe :: MonadIO m =>
2036spliceUnsafe :: MonadIO m =>
2655 MutArray a -> MutArray a -> m (MutArray a)
2037 MutArray a -> MutArray a -> m (MutArray a)
2656spliceUnsafe dst src =
2038spliceUnsafe dst src =
2657− do
2039+ liftIO $ do
2658 let startSrc = arrStart src
2040 let startSrc = arrStart src
2659 srcLen = arrEnd src - startSrc
2041 srcLen = arrEnd src - startSrc
2660 endDst = arrEnd dst
2042 endDst = arrEnd dst
2661 assertM(endDst + srcLen <= arrBound dst)
2043 assertM(endDst + srcLen <= arrBound dst)
2663− (arrContents src) startSrc (arrContents dst) endDst srcLen
2044+ putSliceUnsafe src startSrc dst endDst srcLen
2664 return $ dst {arrEnd = endDst + srcLen}
2045 return $ dst {arrEnd = endDst + srcLen}
2666-- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no
2047-- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no
@@ -2676,7 +2057,7 @@ spliceWith :: forall m a. (MonadIO m, Unbox a) =>
2676 (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
2057 (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
2677spliceWith sizer dst@(MutArray _ start end bound) src = do
2058spliceWith sizer dst@(MutArray _ start end bound) src = do
2679− let f = appendWith (`sizer` byteLength src) (return dst)
2060+ let f = writeAppendWith (`sizer` byteLength src) (return dst)
2680 in D.fold f (toStreamD src)
2061 in D.fold f (toStreamD src)
2682 assert (end <= bound) (return ())
2063 assert (end <= bound) (return ())
@@ -2692,7 +2073,7 @@ spliceWith sizer dst@(MutArray _ start end bound) src = do
2692 $ "splice: newSize is less than the total size "
2073 $ "splice: newSize is less than the total size "
2693 ++ "of arrays being appended. Please check the "
2074 ++ "of arrays being appended. Please check the "
2694 ++ "sizer function passed."
2075 ++ "sizer function passed."
2695− realloc newSizeInBytes dst
2076+ liftIO $ realloc newSizeInBytes dst
2696 else return dst
2077 else return dst
2697 spliceUnsafe dst1 src
2078 spliceUnsafe dst1 src
@@ -2704,8 +2085,6 @@ spliceWith sizer dst@(MutArray _ start end bound) src = do
2705-- >>> splice = MutArray.spliceWith (+)
2086-- >>> splice = MutArray.spliceWith (+)
2707−-- If the original array is pinned the spliced array is also pinned.
2709-- /Pre-release/
2088-- /Pre-release/
2710{-# INLINE splice #-}
2089{-# INLINE splice #-}
2711splice :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)
2090splice :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)
@@ -2729,24 +2108,14 @@ spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))
2729-- Splitting
2108-- Splitting
2730-------------------------------------------------------------------------------
2109-------------------------------------------------------------------------------
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)
2743-- | Drops the separator byte
2111-- | Drops the separator byte
2744{-# INLINE breakOn #-}
2112{-# INLINE breakOn #-}
2745breakOn :: MonadIO m
2113breakOn :: MonadIO m
2746 => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
2114 => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
2747−breakOn sep arr@MutArray{..} = unsafeAsPtr arr $ \p -> liftIO $ do
2115+breakOn sep arr@MutArray{..} = asPtrUnsafe arr $ \p -> liftIO $ do
2116+ -- XXX Instead of using asPtrUnsafe (pinning memory) we can pass unlifted
2117+ -- Addr# to memchr and it should be safe (from ghc 8.4).
2748 -- XXX We do not need memchr here, we can use a Haskell equivalent.
2118 -- XXX We do not need memchr here, we can use a Haskell equivalent.
2749− -- Need efficient stream based primitives that work on Word64.
2750 loc <- c_memchr p sep (fromIntegral $ byteLength arr)
2119 loc <- c_memchr p sep (fromIntegral $ byteLength arr)
2751 let sepIndex = loc `minusPtr` p
2120 let sepIndex = loc `minusPtr` p
2752 return $
2121 return $
@@ -2767,41 +2136,32 @@ breakOn sep arr@MutArray{..} = unsafeAsPtr 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
2792-- | Create two slices of an array without copying the original array. The
2139-- | Create two slices of an array without copying the original array. The
2793-- specified index @i@ is the first index of the second slice.
2140-- specified index @i@ is the first index of the second slice.
2795−{-# INLINE splitAt #-}
2796splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)
2142splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)
2797−splitAt i arr =
2143+splitAt i arr@MutArray{..} =
2798 let maxIndex = length arr - 1
2144 let maxIndex = length arr - 1
2799 in if i < 0
2145 in if i < 0
2800 then error "sliceAt: negative array index"
2146 then error "sliceAt: negative array index"
2801 else if i > maxIndex
2147 else if i > maxIndex
2802 then error $ "sliceAt: specified array index " ++ show i
2148 then error $ "sliceAt: specified array index " ++ show i
2803 ++ " is beyond the maximum index " ++ show maxIndex
2149 ++ " is beyond the maximum index " ++ show maxIndex
2804− else unsafeSplitAt i arr
2150+ else let off = i * SIZE_OF(a)
2153+ { arrContents = arrContents
2154+ , arrStart = arrStart
2159+ { arrContents = arrContents
2162+ , arrBound = arrBound
2806-------------------------------------------------------------------------------
2166-------------------------------------------------------------------------------
2807-- Casting
2167-- Casting
@@ -2851,16 +2211,13 @@ cast arr =
2851-- guarantees that unsafe calls will be performed in the calling thread. Making
2211-- guarantees that unsafe calls will be performed in the calling thread. Making
2852-- it safe to pass heap-allocated objects to unsafe functions.
2212-- it safe to pass heap-allocated objects to unsafe functions.
2214+-- Unsafe because of direct pointer operations. The user must ensure that they
2215+-- are writing within the legal bounds of the array. Should we just name it
2854−-- XXX Should we just name it asPtr, the unsafety is implicit for any pointer
2216+-- asPtr, the unsafety is implicit for any pointer operations. And we are safe
2855−-- operations. And we are safe from Haskell perspective because we will be
2217+-- from Haskell perspective because we will be pinning the memory.
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.
2862−-- | Use a @MutArray a@ as @Ptr a@. This is useful when we want to pass an
2219+-- | Use an @MutArray a@ as @Ptr a@. This is useful when we want to pass an array
2863−-- array as a pointer to some operating system call or to a "safe" FFI call.
2220+-- as a pointer to some operating system call or to a "safe" FFI call.
2865-- If the array is not pinned it is copied to pinned memory before passing it
2222-- If the array is not pinned it is copied to pinned memory before passing it
2866-- to the monadic action.
2223-- to the monadic action.
@@ -2870,382 +2227,57 @@ cast arr =
2870-- opportunistically before this operation occurs, to avoid the cost of a copy
2227-- opportunistically before this operation occurs, to avoid the cost of a copy
2871-- if possible.
2228-- if possible.
2873−-- /Unsafe/ because of direct pointer operations. The user must ensure that
2230+-- /Unsafe/
2874−-- they are writing within the legal bounds of the array.
2876-- /Pre-release/
2232-- /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 #-}
2886asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2234asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2887−asPtrUnsafe = unsafePinnedAsPtr
2235+asPtrUnsafe arr f = do
2888−
2236+ let contents = arrContents arr
2889−{-# INLINE unsafeAsPtr #-}
2237+ !ptr = Ptr (byteArrayContents#
2890−unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2238+ (unsafeCoerce# (getMutableByteArray# contents)))
2891−unsafeAsPtr arr f =
2239+ -- XXX Check if the array is pinned, if not, copy it to a pinned array
2892− Unboxed.unsafeAsPtr
2240+ -- XXX We should probably pass to the IO action the byte length of the array
2241+ -- as well so that bounds can be checked.
2893− (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2242+ r <- f (ptr `plusPtr` arrStart arr)
2243+ liftIO $ touch contents
2895-------------------------------------------------------------------------------
2246-------------------------------------------------------------------------------
2896-- Equality
2247-- Equality
2897-------------------------------------------------------------------------------
2248-------------------------------------------------------------------------------
2899−-- | Byte compare two arrays. Compare the length of the arrays. If the length
2250+-- | Compare the length of the arrays. If the length is equal, compare the
2900−-- is equal, compare the lexicographical ordering of two underlying byte arrays
2251+-- lexicographical ordering of two underlying byte arrays
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.
2907-- /Pre-release/
2253-- /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
2931{-# INLINE cmp #-}
2254{-# INLINE cmp #-}
2932−{-# DEPRECATED cmp "Please use byteCmp instead." #-}
2933cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
2255cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
2934−cmp = byteCmp
2256+cmp arr1 arr2 =
2936−-- | Byte equality of two arrays.
2258+ $ do
2937−--
2259+ let marr1 = getMutableByteArray# (arrContents arr1)
2938−-- >>> byteEq arr1 arr2 = (==) EQ $ MArray.byteCmp arr1 arr2
2260+ marr2 = getMutableByteArray# (arrContents arr2)
2939−--
2261+ !(I# st1#) = arrStart arr1
2940−-- /Unsafe/: See 'byteCmp'.
2262+ !(I# st2#) = arrStart arr2
2941−{-# INLINE byteEq #-}
2263+ !(I# len#) = byteLength arr1
2942−byteEq :: MonadIO m => MutArray a -> MutArray a -> m Bool
2264+ case compare (byteLength arr1) (byteLength arr2) of
2943−byteEq arr1 arr2 = fmap (EQ ==) $ byteCmp arr1 arr2
2265+ EQ -> do
2266+ r <- liftIO $ IO $ \s# ->
2269+ (compareByteArrays#
2270+ (unsafeCoerce# marr1)
2272+ (unsafeCoerce# marr2)
2276+ return $ compare r 0
2945-------------------------------------------------------------------------------
2279-------------------------------------------------------------------------------
2946−-- Compact
2280+-- NFData
2947−-------------------------------------------------------------------------------
2949−-- Note: LE versions avoid an extra copy compared to GE. LE parser trades
2950−-- backtracking one array in lieu of avoiding a copy. However, LE and GE both
2951−-- can leave some memory unused. They can split the last array to fit it
2952−-- exactly in the space.
2954−{-# INLINE_NORMAL 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)
3247−-------------------------------------------------------------------------------
3248−-- In-place mutation algorithms
3249-------------------------------------------------------------------------------
2281-------------------------------------------------------------------------------
3251-- | Strip elements which match with predicate from both ends.
2283-- | Strip elements which match with predicate from both ends.
@@ -3274,7 +2306,7 @@ strip eq arr@MutArray{..} = liftIO $ do
3274 getStart cur = do
2306 getStart cur = do
3275 if cur < arrEnd
2307 if cur < arrEnd
3277− r <- peekAt cur arrContents
2309+ r <- peekWith arrContents cur
3279 then getStart (INDEX_NEXT(cur,a))
2311 then getStart (INDEX_NEXT(cur,a))
3280 else return cur
2312 else return cur
@@ -3284,7 +2316,7 @@ strip eq arr@MutArray{..} = liftIO $ do
3284 if cur > low
2316 if cur > low
3286 let prev = INDEX_PREV(cur,a)
2318 let prev = INDEX_PREV(cur,a)
3287− r <- peekAt prev arrContents
2319+ r <- peekWith arrContents prev
3289 then getLast prev low
2321 then getLast prev low
3290 else return cur
2322 else return cur