@@ -31,57 +31,39 @@ module Streamly.Internal.Data.MutArray.Type
31 -- ** Type
31 -- ** Type
32 -- $arrayNotes
32 -- $arrayNotes
33 MutArray (..)
33 MutArray (..)
35− -- ** Conversion
35+ , MutableByteArray
36− -- *** Pinned and Unpinned
39 , isPinned
38 , isPinned
41− -- ** Casting
40+ -- -- * Constructing and Writing
43− , castUnsafe -- XXX unsafeCast
48 -- ** Construction
41 -- ** 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
64− -- *** Slicing
44+ -- *** Uninitialized Arrays
65− -- | Get a subarray without copying
45+ , pinnedNew
66− , getSliceUnsafe -- XXX unsafeGetSlice
46+ , pinnedNewBytes
67− , getSlice
47+ , pinnedNewAligned
68− , splitAt -- XXX should be able to express using getSlice
48+ , new
69− , breakOn
49+ , newArrayWith
71− -- *** Stream Folds
51+ -- *** From streams
72 , ArrayUnsafe (..)
52 , ArrayUnsafe (..)
73− , unsafeCreateOfWith
53+ , writeNWithUnsafe
74− , unsafeCreateOf
54+ , writeNWith
75− , unsafePinnedCreateOf
55+ , writeNUnsafe
76− , pinnedCreateOf
56+ , pinnedWriteNUnsafe
77− , createOfWith
57+ , writeN
78− , createOf
58+ , pinnedWriteN
79− , revCreateOf
59+ , pinnedWriteNAligned
81− , pinnedCreate
61+ , writeWith
82− , createWith
62+ , write
83− , create
63+ , pinnedWrite
86 -- *** From containers
68 -- *** From containers
87 , fromListN
69 , fromListN
@@ -90,18 +72,18 @@ module Streamly.Internal.Data.MutArray.Type
90 , pinnedFromList
72 , pinnedFromList
91 , fromListRevN
73 , fromListRevN
92 , fromListRev
74 , fromListRev
93− , fromStreamN
75+ , fromStreamDN
94− , fromStream
76+ , fromStreamD
95 , fromPureStreamN
77 , fromPureStreamN
96 , fromPureStream
78 , fromPureStream
97 , fromByteStr#
79 , fromByteStr#
98 , fromPtrN
80 , fromPtrN
99− , fromChunksK
81+ , fromArrayStreamK
100− , fromChunksRealloced -- fromSmallChunks
82+ , fromArrayStreamRealloced
102 -- ** Random writes
84 -- ** Random writes
103 , putIndex
85 , putIndex
104− , putIndexUnsafe -- XXX unsafePutIndex
86+ , putIndexUnsafe
105 , putIndices
87 , putIndices
106 -- , putFromThenTo
88 -- , putFromThenTo
107 -- , putFrom -- start writing at the given position
89 -- , putFrom -- start writing at the given position
@@ -109,69 +91,76 @@ module Streamly.Internal.Data.MutArray.Type
109 -- , putFromTo
91 -- , putFromTo
110 -- , putFromRev
92 -- , putFromRev
111 -- , putUptoRev
93 -- , putUptoRev
112− , modifyIndexUnsafe -- XXX unsafeModifyIndex
94+ , modifyIndexUnsafe
113 , modifyIndex
95 , modifyIndex
114 , modifyIndices
96 , modifyIndices
116 , swapIndices
98 , swapIndices
117 , unsafeSwapIndices
99 , unsafeSwapIndices
119− -- ** Reading
101+ -- ** Growing and Shrinking
102+ -- | Arrays grow only at the end, though it is possible to grow on both sides
103+ -- and therefore have a cons as well as snoc. But that will require two
104+ -- bounds in the array representation.
121− -- *** Indexing
106+ -- *** Appending elements
122− , getIndex
107+ , snocWith
123− , getIndexUnsafe -- XXX unsafeGetIndex
108+ , snoc
124− -- , getFromThenTo
109+ , snocLinear
125− , getIndexRev -- getRevIndex?
110+ , snocMay
126− , indexReader
111+ , snocUnsafe
129− -- *** To Streams
113+ -- *** Appending streams
114+ , writeAppendNUnsafe
119+ -- ** Eliminating and Reading
126+ -- *** To containers
131 , readRev
132 , readRev
134 , toStreamK
133 , toStreamK
136 , toStreamKRev
134 , toStreamKRev
139− -- *** To Containers
143 -- experimental
137 -- experimental
144 , producerWith
138 , producerWith
145 , producer
139 , producer
147− , reader
141+ -- *** Random reads
148− , readerRevWith
142+ , getIndex
149− , readerRev
143+ , getIndexUnsafe
151− -- ** Size and Capacity
145+ , getIndicesD
152− -- *** Size
146+ -- , getFromThenTo
153− , length
147+ , getIndexRev
161− -- *** Capacity Management
149+ -- ** Memory Management
162 , blockSize
150 , blockSize
163 , arrayChunkBytes
151 , arrayChunkBytes
164 , allocBytesToElemCount
152 , allocBytesToElemCount
165− , realloc -- this is "resize"
153+ , realloc
167− , growExp
155+ , resizeExp
168 , rightSize
156 , rightSize
170− -- ** Folding
158+ -- ** Size
171− , foldl'
159+ , length
172− , foldr
160+ , byteLength
173− , byteCmp
161+ -- , capacity
174− , byteEq
162+ , byteCapacity
176 -- ** In-place Mutation Algorithms
165 -- ** In-place Mutation Algorithms
@@ -183,82 +172,58 @@ module Streamly.Internal.Data.MutArray.Type
183 , mergeBy
172 , mergeBy
186− -- ** Growing and Shrinking
175+ -- ** Casting
187− -- | Arrays grow only at the end, though it is possible to grow on both
176+ , cast
188− -- sides and therefore have a cons as well as snoc. But that will require
177+ , castUnsafe
189− -- both lower and upper bound in the array representation.
178+ , asBytes
191− -- *** Appending elements
180+ , asUnpinnedPtrUnsafe
196− , snocUnsafe -- XXX unsafeSnoc
198− -- *** Appending streams
204− -- *** Appending arrays
209− , spliceUnsafe -- XXX unsafeSplice
212− -- , appendSliceFrom
214− -- ** Serialization using Unbox
217− , pokeSkipUnsafe -- unsafePokeSkip
219− -- ** Deserialization using Unbox
182+ -- ** Folding
220− , peekUncons
183+ , foldl'
221− , peekUnconsUnsafe -- unsafePeekUncons
184+ , foldr
222− , peekSkipUnsafe -- unsafePeekSkip
185+ , cmp
224− -- Arrays of arrays
189+ -- ** Arrays of arrays
225 -- We can add dimensionality parameter to the array type to get
190 -- We can add dimensionality parameter to the array type to get
226 -- multidimensional arrays. Multidimensional arrays would just be a
191 -- multidimensional arrays. Multidimensional arrays would just be a
227 -- convenience wrapper on top of single dimensional arrays.
192 -- convenience wrapper on top of single dimensional arrays.
229− -- ** Streams of Arrays
194+ -- | Operations dealing with multiple arrays, streams of arrays or
230− -- *** Chunk
195+ -- multidimensional array representations.
231− -- | Group a stream into arrays.
196+
197+ -- *** Construct from streams
232 , chunksOf
198 , chunksOf
233 , pinnedChunksOf
199 , pinnedChunksOf
234 , buildChunks
200 , buildChunks
236− -- *** Split
202+ -- *** Eliminate to streams
237− -- | Split an array into slices.
203+ , concatChunks
206+ -- *** Construct from arrays
207+ -- get chunks without copying
239 -- , getSlicesFromLenN
210 -- , getSlicesFromLenN
240− , splitOn
211+ , splitAt -- XXX should be able to express using getSlice
241− -- , slicesOf
212+ , breakOn
243− -- *** Concat
214+ -- ** Cloning arrays
244− -- | Append the arrays in a stream to form a stream of elements.
215+ , clone
245− , concatWith
216+ , pinnedClone
247− , concat
218+ -- ** Appending arrays
248− , concatRev
219+ , spliceCopy
250− -- *** Compact
221+ , splice
251− -- | Append the arrays in a stream to form a stream of larger arrays.
222+ , spliceExp
252− , SpliceState (..)
223+ , spliceUnsafe
253− , pCompactLE
224+ -- , putSlice
254− , pPinnedCompactLE
225+ -- , appendSlice
255− , compactLeAs
226+ -- , appendSliceFrom
263 -- ** Utilities
228 -- ** Utilities
264 , roundUpToPower2
229 , roundUpToPower2
@@ -267,37 +232,9 @@ module Streamly.Internal.Data.MutArray.Type
267 , c_memchr
232 , c_memchr
269 -- * Deprecated
234 -- * Deprecated
271 , writeChunks
235 , writeChunks
272 , flattenArrays
236 , flattenArrays
273 , flattenArraysRev
237 , flattenArraysRev
286− , writeAppendNUnsafe
293− , pinnedWriteNUnsafe
296− , pinnedWriteNAligned -- XXX not required
@@ -308,7 +245,6 @@ where
309import Control.Monad (when, void)
246import Control.Monad (when, void)
310import Control.Monad.IO.Class (MonadIO(..))
247import Control.Monad.IO.Class (MonadIO(..))
311−import Data.Bifunctor (first)
312import Data.Bits (shiftR, (.|.), (.&.))
248import Data.Bits (shiftR, (.|.), (.&.))
313import Data.Functor.Identity (Identity(..))
249import Data.Functor.Identity (Identity(..))
314import Data.Proxy (Proxy(..))
250import Data.Proxy (Proxy(..))
@@ -317,6 +253,7 @@ import Foreign.C.Types (CSize(..), CInt(..))
317import Foreign.Ptr (plusPtr, minusPtr, nullPtr)
253import Foreign.Ptr (plusPtr, minusPtr, nullPtr)
318import Streamly.Internal.Data.MutByteArray.Type
254import Streamly.Internal.Data.MutByteArray.Type
319 ( MutByteArray(..)
255 ( MutByteArray(..)
320 , PinnedState(..)
257 , PinnedState(..)
321 , getMutableByteArray#
258 , getMutableByteArray#
322 , putSliceUnsafe
259 , putSliceUnsafe
@@ -335,17 +272,13 @@ import GHC.Ptr (Ptr(..))
335import Streamly.Internal.Data.Fold.Type (Fold(..))
272import Streamly.Internal.Data.Fold.Type (Fold(..))
336import Streamly.Internal.Data.Producer.Type (Producer (..))
273import Streamly.Internal.Data.Producer.Type (Producer (..))
337import Streamly.Internal.Data.Stream.Type (Stream)
274import Streamly.Internal.Data.Stream.Type (Stream)
338−import Streamly.Internal.Data.Parser.Type (Parser (..))
339import Streamly.Internal.Data.StreamK.Type (StreamK)
275import Streamly.Internal.Data.StreamK.Type (StreamK)
340import Streamly.Internal.Data.SVar.Type (adaptState, defState)
276import Streamly.Internal.Data.SVar.Type (adaptState, defState)
341−import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
342import Streamly.Internal.Data.Unfold.Type (Unfold(..))
277import Streamly.Internal.Data.Unfold.Type (Unfold(..))
343import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)
278import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)
345import qualified Streamly.Internal.Data.Fold.Type as FL
280import qualified Streamly.Internal.Data.Fold.Type as FL
346import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed
281import 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
282import qualified Streamly.Internal.Data.Producer as Producer
350import qualified Streamly.Internal.Data.Stream.Type as D
283import qualified Streamly.Internal.Data.Stream.Type as D
351import qualified Streamly.Internal.Data.Stream.Lift as D
284import qualified Streamly.Internal.Data.Stream.Lift as D
@@ -353,7 +286,7 @@ import qualified Streamly.Internal.Data.StreamK.Type as K
353import qualified Prelude
286import qualified Prelude
355import Prelude hiding
288import Prelude hiding
356− (Foldable(..), concat, read, unlines, splitAt, reverse, truncate)
289+ (Foldable(..), read, unlines, splitAt, reverse, truncate)
358#include "DocTestDataMutArray.hs"
291#include "DocTestDataMutArray.hs"
@@ -479,8 +412,6 @@ isPinned MutArray{..} = Unboxed.isPinned arrContents
479-- we need more than that. See stg_pinnedNewAlignedByteArrayzh and
412-- we need more than that. See stg_pinnedNewAlignedByteArrayzh and
480-- allocatePinned in GHC source.
413-- 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
415-- | @newArrayWith allocator alignment count@ allocates a new array of zero
485-- length and with a capacity to hold @count@ elements, using @allocator
416-- length and with a capacity to hold @count@ elements, using @allocator
486-- size alignment@ as the memory allocator function.
417-- size alignment@ as the memory allocator function.
@@ -504,25 +435,12 @@ newArrayWith alloc alignSize count = do
504 , arrBound = size
435 , 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
439#ifdef DEVBUILD
522 Unbox a =>
440 Unbox a =>
524 MutArray a
442 MutArray a
525−nil = empty
443+nil = MutArray Unboxed.nil 0 0 0
527{-# INLINE newBytesAs #-}
445{-# INLINE newBytesAs #-}
528newBytesAs :: MonadIO m =>
446newBytesAs :: MonadIO m =>
@@ -539,13 +457,12 @@ newBytesAs ps bytes = do
539 , arrBound = bytes
457 , arrBound = bytes
542−-- | Allocates a pinned empty array that with a reserved capacity of bytes.
460+-- | Allocates a pinned empty array that can hold 'count' items. The memory of
543−-- The memory of the array is uninitialized and the allocation is aligned as
461+-- the array is uninitialized and the allocation is aligned as per the
544−-- per the 'Unboxed' instance of the type.
462+-- 'Unboxed' instance of the type.
546-- /Pre-release/
464-- /Pre-release/
547{-# INLINE pinnedNewBytes #-}
465{-# INLINE pinnedNewBytes #-}
548−{-# DEPRECATED pinnedNewBytes "Please use pinnedEmptyOf with appropriate calculation" #-}
549pinnedNewBytes :: MonadIO m =>
466pinnedNewBytes :: MonadIO m =>
550#ifdef DEVBUILD
467#ifdef DEVBUILD
551 Unbox a =>
468 Unbox a =>
@@ -570,31 +487,21 @@ newAs ps =
570 (error "new: alignment is not used in unpinned arrays.")
487 (error "new: alignment is not used in unpinned arrays.")
572-- XXX can unaligned allocation be more efficient when alignment is not needed?
489-- 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
491+-- | Allocates an empty pinned array that can hold 'count' items. The memory of
575−-- capacity without reallocation.
492+-- the array is uninitialized and the allocation is aligned as per the 'Unboxed'
576−{-# INLINE pinnedEmptyOf #-}
493+-- instance of the type.
577−pinnedEmptyOf :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
494+--
578−pinnedEmptyOf = newAs Pinned
580−-- XXX Deprecate in major
581−-- {-# DEPRECATED pinnedNew "Please use pinnedEmptyOf instead." #-}
582{-# INLINE pinnedNew #-}
495{-# INLINE pinnedNew #-}
583pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
496pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
584−pinnedNew = pinnedEmptyOf
497+pinnedNew = newAs Pinned
586−-- | Allocates an unpinned array of zero length but growable to the specified
499+-- | Allocates an empty unpinned array that can hold 'count' items. The memory
587−-- capacity without reallocation.
500+-- of the array is uninitialized.
589−{-# INLINE emptyOf #-}
590−emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
591−emptyOf = newAs Unpinned
593−-- XXX Deprecate in major
594−-- {-# DEPRECATED new "Please use emptyOf instead." #-}
595{-# INLINE new #-}
502{-# INLINE new #-}
596new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
503new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
597−new = emptyOf
504+new = newAs Unpinned
599-------------------------------------------------------------------------------
506-------------------------------------------------------------------------------
600-- Random writes
507-- Random writes
@@ -642,7 +549,7 @@ putIndices arr = FL.foldlM' step (return ())
645− step () (i, x) = putIndex i arr x
552+ step () (i, x) = liftIO (putIndex i arr x)
647-- | Modify a given index of an array using a modifier function.
554-- | Modify a given index of an array using a modifier function.
@@ -838,19 +745,22 @@ arrayChunkBytes = 1024
838roundDownTo :: Int -> Int -> Int
745roundDownTo :: Int -> Int -> Int
839roundDownTo elemSize size = size - (size `mod` elemSize)
746roundDownTo elemSize size = size - (size `mod` elemSize)
748+-- XXX See if resizing can be implemented by reading the old array as a stream
749+-- and then using writeN to the new array.
841-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.
751-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.
842-- Since this is not inlined Unboxed consrraint leads to dictionary passing
752-- Since this is not inlined Unboxed consrraint leads to dictionary passing
843-- which complicates some inspection tests.
753-- which complicates some inspection tests.
845−{-# NOINLINE reallocExplicitAs #-}
755+{-# NOINLINE reallocExplicit #-}
846−reallocExplicitAs :: PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
756+reallocExplicit :: Int -> Int -> MutArray a -> IO (MutArray a)
847−reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do
757+reallocExplicit elemSize newCapacityInBytes MutArray{..} = do
848 assertM(arrEnd <= arrBound)
758 assertM(arrEnd <= arrBound)
850 -- Allocate new array
760 -- Allocate new array
851 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
761 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
852 contents <-
762 contents <-
853− if ps == Pinned
763+ if Unboxed.isPinned arrContents
854 then Unboxed.pinnedNew newCapMaxInBytes
764 then Unboxed.pinnedNew newCapMaxInBytes
855 else Unboxed.new newCapMaxInBytes
765 else Unboxed.new newCapMaxInBytes
856 let !(MutByteArray mbarrFrom#) = arrContents
766 let !(MutByteArray mbarrFrom#) = arrContents
@@ -875,10 +785,6 @@ reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do
875 , arrBound = newCapInBytes
785 , 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
788-- | @realloc newCapacity array@ reallocates the array to the specified
883-- capacity in bytes.
789-- capacity in bytes.
@@ -890,12 +796,7 @@ reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do
890-- If the original array is pinned, the newly allocated array is also pinned.
796-- If the original array is pinned, the newly allocated array is also pinned.
891{-# INLINABLE realloc #-}
797{-# INLINABLE realloc #-}
892realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)
798realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)
898− in liftIO $ reallocExplicitAs ps (SIZE_OF(a)) bytes arr
799+realloc bytes arr = liftIO $ reallocExplicit (SIZE_OF(a)) bytes arr
900-- | @reallocWith label capSizer minIncrBytes array@. The label is used
801-- | @reallocWith label capSizer minIncrBytes array@. The label is used
901-- in error messages and the capSizer is used to determine the capacity of the
802-- in error messages and the capSizer is used to determine the capacity of the
@@ -918,14 +819,14 @@ reallocWith label capSizer minIncrBytes arr = do
920 badSize newSize =
821 badSize newSize =
921− Prelude.concat
822+ concat
923 , ": new array size (in bytes) is less than required size "
824 , ": new array size (in bytes) is less than required size "
924 , show newSize
825 , show newSize
925 , ". Please check the sizing function passed."
826 , ". Please check the sizing function passed."
928−-- | @grow newCapacity array@ changes the total capacity of the array so that
829+-- | @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
830-- 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.
831-- the specified capacity is less than the length of the array.
@@ -933,46 +834,34 @@ reallocWith label capSizer minIncrBytes arr = do
933-- the block size (4K).
834-- the block size (4K).
935-- /Pre-release/
836-- /Pre-release/
936−{-# INLINE grow #-}
837+{-# INLINE resize #-}
937−grow :: forall m a. (MonadIO m, Unbox a) =>
838+resize :: forall m a. (MonadIO m, Unbox a) =>
938 Int -> MutArray a -> m (MutArray a)
839 Int -> MutArray a -> m (MutArray a)
939−grow nElems arr@MutArray{..} = do
840+resize nElems arr@MutArray{..} = do
940 let req = SIZE_OF(a) * nElems
841 let req = SIZE_OF(a) * nElems
941− cap = arrBound - arrStart
842+ len = arrEnd - arrStart
942− if req < cap
843+ if req < len
943 then return arr
844 then return arr
944 else realloc req arr
845 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
847+-- | Like 'resize' but if the byte capacity is more than 'largeObjectThreshold'
953−-- 'largeObjectThreshold' then it is rounded up to the closest power of 2.
848+-- then it is rounded up to the closest power of 2.
955-- /Pre-release/
850-- /Pre-release/
956−{-# INLINE growExp #-}
851+{-# INLINE resizeExp #-}
957−growExp :: forall m a. (MonadIO m, Unbox a) =>
852+resizeExp :: forall m a. (MonadIO m, Unbox a) =>
958 Int -> MutArray a -> m (MutArray a)
853 Int -> MutArray a -> m (MutArray a)
959−growExp nElems arr@MutArray{..} = do
854+resizeExp nElems arr@MutArray{..} = do
960 let req = roundUpLargeArray (SIZE_OF(a) * nElems)
855 let req = roundUpLargeArray (SIZE_OF(a) * nElems)
962 if req > largeObjectThreshold
857 if req > largeObjectThreshold
963 then roundUpToPower2 req
858 then roundUpToPower2 req
965− cap = arrBound - arrStart
860+ len = arrEnd - arrStart
966− if req1 < cap
861+ if req1 < len
967 then return arr
862 then return arr
968 else realloc req1 arr
863 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
865-- | Resize the allocated memory to drop any reserved free space at the end of
977-- the array and reallocate it to reduce wastage.
866-- the array and reallocate it to reduce wastage.
@@ -1037,7 +926,7 @@ snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr
1037{-# INLINE snocMay #-}
926{-# INLINE snocMay #-}
1038snocMay :: forall m a. (MonadIO m, Unbox a) =>
927snocMay :: forall m a. (MonadIO m, Unbox a) =>
1039 MutArray a -> a -> m (Maybe (MutArray a))
928 MutArray a -> a -> m (Maybe (MutArray a))
1040−snocMay arr@MutArray{..} x = do
929+snocMay arr@MutArray{..} x = liftIO $ do
1041 let newEnd = INDEX_NEXT(arrEnd,a)
930 let newEnd = INDEX_NEXT(arrEnd,a)
1042 if newEnd <= arrBound
931 if newEnd <= arrBound
1043 then Just <$> snocNewEnd newEnd arr x
932 then Just <$> snocNewEnd newEnd arr x
@@ -1051,7 +940,7 @@ snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>
1052 -> m (MutArray a)
941 -> m (MutArray a)
1053snocWithRealloc sizer arr x = do
942snocWithRealloc sizer arr x = do
1054− arr1 <- reallocWith "snocWith" sizer (SIZE_OF(a)) arr
943+ arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr
1055 snocUnsafe arr1 x
944 snocUnsafe arr1 x
1057-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of
946-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of
@@ -1073,7 +962,7 @@ snocWith :: forall m a. (MonadIO m, Unbox a) =>
1073 -> MutArray a
962 -> MutArray a
1075 -> m (MutArray a)
964 -> m (MutArray a)
1076−snocWith allocSize arr x = do
965+snocWith allocSize arr x = liftIO $ do
1077 let newEnd = INDEX_NEXT(arrEnd arr,a)
966 let newEnd = INDEX_NEXT(arrEnd arr,a)
1078 if newEnd <= arrBound arr
967 if newEnd <= arrBound arr
1079 then snocNewEnd newEnd arr x
968 then snocNewEnd newEnd arr x
@@ -1117,126 +1006,6 @@ snoc = snocWith f
1117 then oldSize * 2
1006 then oldSize * 2
1118 else roundUpToPower2 oldSize * 2
1007 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-------------------------------------------------------------------------------
1009-------------------------------------------------------------------------------
1241-- Random reads
1010-- Random reads
1242-------------------------------------------------------------------------------
1011-------------------------------------------------------------------------------
@@ -1279,10 +1048,15 @@ getIndexRev i MutArray{..} = do
1279data GetIndicesState contents start end st =
1048data GetIndicesState contents start end st =
1280 GetIndicesState contents start end st
1049 GetIndicesState contents start end st
1282−{-# INLINE indexReaderWith #-}
1051+-- | Given an unfold that generates array indices, read the elements on those
1052+-- indices from the supplied MutArray. An error is thrown if an index is out of
1056+{-# INLINE getIndicesD #-}
1283−indexReaderWith :: (Monad m, Unbox a) =>
1057+getIndicesD :: (Monad m, Unbox a) =>
1284 (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a
1058 (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
1059+getIndicesD liftio (D.Stream stepi sti) = Unfold step inject
@@ -1301,26 +1075,9 @@ indexReaderWith liftio (D.Stream stepi sti) = Unfold step inject
1301 D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)
1075 D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)
1302 D.Stop -> return D.Stop
1076 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 #-}
1078{-# INLINE getIndices #-}
1322getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
1079getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
1323−getIndices = indexReader
1080+getIndices = getIndicesD liftIO
1325-------------------------------------------------------------------------------
1082-------------------------------------------------------------------------------
1326-- Subarrays
1083-- Subarrays
@@ -1615,7 +1372,7 @@ chunksOfAs ps n (D.Stream step state) =
1616-- Same as the following but may be more efficient:
1373-- Same as the following but may be more efficient:
1618−-- >>> chunksOf n = Stream.foldMany (MutArray.createOf n)
1375+-- >>> chunksOf n = Stream.foldMany (MutArray.writeN n)
1620-- /Pre-release/
1377-- /Pre-release/
1621{-# INLINE_NORMAL chunksOf #-}
1378{-# INLINE_NORMAL chunksOf #-}
@@ -1624,14 +1381,14 @@ chunksOf :: forall m a. (MonadIO m, Unbox a)
1624-- XXX the idiomatic implementation leads to large regression in the D.reverse'
1381-- XXX the idiomatic implementation leads to large regression in the D.reverse'
1625-- benchmark. It seems it has difficulty producing optimized code when
1382-- benchmark. It seems it has difficulty producing optimized code when
1626-- converting to StreamK. Investigate GHC optimizations.
1383-- converting to StreamK. Investigate GHC optimizations.
1627−-- chunksOf n = D.foldMany (createOf n)
1384+-- chunksOf n = D.foldMany (writeN n)
1628chunksOf = chunksOfAs Unpinned
1385chunksOf = chunksOfAs Unpinned
1630-- | Like 'chunksOf' but creates pinned arrays.
1387-- | Like 'chunksOf' but creates pinned arrays.
1631{-# INLINE_NORMAL pinnedChunksOf #-}
1388{-# INLINE_NORMAL pinnedChunksOf #-}
1632pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)
1389pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)
1633 => Int -> D.Stream m a -> D.Stream m (MutArray a)
1390 => Int -> D.Stream m a -> D.Stream m (MutArray a)
1634−-- pinnedChunksOf n = D.foldMany (pinnedCreateOf n)
1391+-- pinnedChunksOf n = D.foldMany (pinnedWriteN n)
1635pinnedChunksOf = chunksOfAs Pinned
1392pinnedChunksOf = chunksOfAs Pinned
1637-- | When we are buffering a stream of unknown size into an array we do not
1394-- | When we are buffering a stream of unknown size into an array we do not
@@ -1664,10 +1421,16 @@ data FlattenState s contents a =
1664 OuterLoop s
1421 OuterLoop s
1665 | InnerLoop s contents !Int !Int
1422 | InnerLoop s contents !Int !Int
1424+-- | Use the "reader" unfold instead.
1426+-- @concatChunks = unfoldMany reader@
1428+-- We can try this if there are any fusion issues in the unfold.
1667−{-# INLINE_NORMAL concatWith #-}
1430+{-# INLINE_NORMAL concatChunks #-}
1668−concatWith :: forall m a. (Monad m, Unbox a)
1431+concatChunks :: forall m a. (MonadIO m, Unbox a)
1669− => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a
1432+ => D.Stream m (MutArray a) -> D.Stream m a
1670−concatWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
1433+concatChunks (D.Stream step state) = D.Stream step' (OuterLoop state)
@@ -1684,30 +1447,24 @@ concatWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
1684 return $ D.Skip $ OuterLoop st
1447 return $ D.Skip $ OuterLoop st
1686 step' _ (InnerLoop st contents p end) = do
1449 step' _ (InnerLoop st contents p end) = do
1687− x <- liftio $ peekAt p contents
1450+ x <- liftIO $ peekAt p contents
1688 return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)
1451 return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)
1453+{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}
1454+flattenArrays :: forall m a. (MonadIO m, Unbox a)
1455+ => D.Stream m (MutArray a) -> D.Stream m a
1456+flattenArrays = concatChunks
1690−-- | Use the "reader" unfold instead.
1458+-- | Use the "readerRev" unfold instead.
1692−-- @concat = unfoldMany reader@
1460+-- @concatChunks = unfoldMany readerRev@
1694-- We can try this if there are any fusion issues in the unfold.
1462-- We can try this if there are any fusion issues in the unfold.
1696−{-# INLINE_NORMAL concat #-}
1464+{-# INLINE_NORMAL concatChunksRev #-}
1697−concat :: forall m a. (MonadIO m, Unbox a)
1465+concatChunksRev :: forall m a. (MonadIO m, Unbox a)
1698 => D.Stream m (MutArray a) -> D.Stream m a
1466 => 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)
1704− => D.Stream m (MutArray a) -> D.Stream m a
1705−flattenArrays = concat
1707−{-# INLINE_NORMAL concatRevWith #-}
1708−concatRevWith :: forall m a. (Monad m, Unbox a)
1709− => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a
1710−concatRevWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
1467+concatChunksRev (D.Stream step state) = D.Stream step' (OuterLoop state)
@@ -1725,26 +1482,14 @@ concatRevWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
1725 return $ D.Skip $ OuterLoop st
1482 return $ D.Skip $ OuterLoop st
1727 step' _ (InnerLoop st contents p start) = do
1484 step' _ (InnerLoop st contents p start) = do
1728− x <- liftio $ peekAt p contents
1485+ x <- liftIO $ peekAt p contents
1729 let cur = INDEX_PREV(p,a)
1486 let cur = INDEX_PREV(p,a)
1730 return $ D.Yield x (InnerLoop st contents cur start)
1487 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." #-}
1489{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}
1744−{-# INLINE flattenArraysRev #-}
1745flattenArraysRev :: forall m a. (MonadIO m, Unbox a)
1490flattenArraysRev :: forall m a. (MonadIO m, Unbox a)
1746 => D.Stream m (MutArray a) -> D.Stream m a
1491 => D.Stream m (MutArray a) -> D.Stream m a
1747−flattenArraysRev = concatRev
1492+flattenArraysRev = concatChunksRev
1749-------------------------------------------------------------------------------
1494-------------------------------------------------------------------------------
1750-- Unfolds
1495-- Unfolds
@@ -1863,11 +1608,11 @@ toList MutArray{..} = liftIO $ go arrStart
1863 x <- peekAt p arrContents
1608 x <- peekAt p arrContents
1864 (:) x <$> go (INDEX_NEXT(p,a))
1609 (:) x <$> go (INDEX_NEXT(p,a))
1866−{-# INLINE_NORMAL toStreamWith #-}
1611+{-# INLINE_NORMAL toStreamDWith #-}
1867−toStreamWith ::
1612+toStreamDWith ::
1868 forall m a. (Monad m, Unbox a)
1613 forall m a. (Monad m, Unbox a)
1869 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1614 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1870−toStreamWith liftio MutArray{..} = D.Stream step arrStart
1615+toStreamDWith liftio MutArray{..} = D.Stream step arrStart
@@ -1883,7 +1628,7 @@ toStreamWith liftio MutArray{..} = D.Stream step arrStart
1884{-# INLINE_NORMAL read #-}
1629{-# INLINE_NORMAL read #-}
1885read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1630read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1886−read = toStreamWith liftIO
1631+read = toStreamDWith liftIO
1888{-# INLINE toStreamKWith #-}
1633{-# INLINE toStreamKWith #-}
1889toStreamKWith ::
1634toStreamKWith ::
@@ -1902,11 +1647,11 @@ toStreamKWith liftio MutArray{..} = go arrStart
1902toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a
1647toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a
1903toStreamK = toStreamKWith liftIO
1648toStreamK = toStreamKWith liftIO
1905−{-# INLINE_NORMAL toStreamRevWith #-}
1650+{-# INLINE_NORMAL toStreamDRevWith #-}
1906−toStreamRevWith ::
1651+toStreamDRevWith ::
1907 forall m a. (Monad m, Unbox a)
1652 forall m a. (Monad m, Unbox a)
1908 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1653 => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
1909−toStreamRevWith liftio MutArray{..} =
1654+toStreamDRevWith liftio MutArray{..} =
1910 let p = INDEX_PREV(arrEnd,a)
1655 let p = INDEX_PREV(arrEnd,a)
1911 in D.Stream step p
1656 in D.Stream step p
@@ -1924,7 +1669,7 @@ toStreamRevWith liftio MutArray{..} =
1925{-# INLINE_NORMAL readRev #-}
1670{-# INLINE_NORMAL readRev #-}
1926readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1671readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
1927−readRev = toStreamRevWith liftIO
1672+readRev = toStreamDRevWith liftIO
1929{-# INLINE toStreamKRevWith #-}
1674{-# INLINE toStreamKRevWith #-}
1930toStreamKRevWith ::
1675toStreamKRevWith ::
@@ -1973,7 +1718,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?
1719-- 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
1721+-- | @writeAppendNUnsafe n arr@ appends up to @n@ input items to the supplied
1977-- array.
1722-- array.
1979-- Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory
1724-- Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory
@@ -1982,12 +1727,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.
1727-- Any free space left in the array after appending @n@ elements is lost.
1984-- /Internal/
1729-- /Internal/
1985−{-# INLINE_NORMAL unsafeAppendN #-}
1730+{-# INLINE_NORMAL writeAppendNUnsafe #-}
1986−unsafeAppendN :: forall m a. (MonadIO m, Unbox a) =>
1731+writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>
1988 -> m (MutArray a)
1733 -> m (MutArray a)
1989 -> Fold m a (MutArray a)
1734 -> Fold m a (MutArray a)
1735+writeAppendNUnsafe n action =
1990−unsafeAppendN n action = fmap fromArrayUnsafe $ FL.foldlM' step initial
1736+ fmap fromArrayUnsafe $ FL.foldlM' step initial
@@ -2000,7 +1746,7 @@ unsafeAppendN n action = fmap fromArrayUnsafe $ FL.foldlM' step initial
2000 -- otherwise we lose that space.
1746 -- otherwise we lose that space.
2002 if free < needed
1748 if free < needed
2003− then noinline reallocWith "unsafeAppendN" (+ needed) needed arr
1749+ then noinline reallocWith "writeAppendNUnsafeWith" (+ needed) needed arr
2004 else return arr
1750 else return arr
2005 return $ toArrayUnsafe arr1
1751 return $ toArrayUnsafe arr1
@@ -2008,51 +1754,30 @@ unsafeAppendN n action = fmap fromArrayUnsafe $ FL.foldlM' step initial
2008 liftIO $ pokeAt end contents x
1754 liftIO $ pokeAt end contents x
2009 return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
1755 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
1757-- | Append @n@ elements to an existing array. Any free space left in the array
2020-- after appending @n@ elements is lost.
1758-- after appending @n@ elements is lost.
2022−-- >>> appendN n initial = Fold.take n (MutArray.unsafeAppendN n initial)
1760+-- >>> writeAppendN n initial = Fold.take n (MutArray.writeAppendNUnsafe n initial)
2024−{-# INLINE_NORMAL appendN #-}
1762+{-# 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) =>
1763writeAppendN :: forall m a. (MonadIO m, Unbox a) =>
2033 Int -> m (MutArray a) -> Fold m a (MutArray a)
1764 Int -> m (MutArray a) -> Fold m a (MutArray a)
2034−writeAppendN = appendN
1765+writeAppendN n initial = FL.take n (writeAppendNUnsafe n initial)
2036−-- | @appendWith realloc action@ mutates the array generated by @action@ to
1767+-- | @writeAppendWith realloc action@ mutates the array generated by @action@ to
2037-- append the input stream. If there is no reserved space available in the
1768-- 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@,
1769-- 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.
1770-- 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.
1772-- Note that the returned array may be a mutated version of original array.
2043−-- >>> appendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)
1774+-- >>> writeAppendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)
2045-- /Pre-release/
1776-- /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 #-}
1777{-# INLINE writeAppendWith #-}
2053writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
1778writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
2054 (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
1779 (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
2055−writeAppendWith = appendWith
1780+writeAppendWith sizer = FL.foldlM' (snocWith sizer)
2057-- | @append action@ mutates the array generated by @action@ to append the
1782-- | @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
1783-- input stream. If there is no reserved space available in the array it is
@@ -2060,33 +1785,26 @@ writeAppendWith = appendWith
2061-- Note that the returned array may be a mutated version of original array.
1786-- Note that the returned array may be a mutated version of original array.
2063−-- >>> append = MutArray.appendWith (* 2)
1788+-- >>> 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 #-}
1790{-# INLINE writeAppend #-}
2073writeAppend :: forall m a. (MonadIO m, Unbox a) =>
1791writeAppend :: forall m a. (MonadIO m, Unbox a) =>
2074 m (MutArray a) -> Fold m a (MutArray a)
1792 m (MutArray a) -> Fold m a (MutArray a)
2075−writeAppend = append
1793+writeAppend = writeAppendWith (* 2)
2077-- XXX We can carry bound as well in the state to make sure we do not lose the
1795-- 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.
1796-- remaining capacity. Need to check perf impact.
2080−-- | Like 'unsafeCreateOf' but takes a new array allocator @alloc size@
1798+-- | Like 'writeNUnsafe' but takes a new array allocator @alloc size@ function
2081−-- function as argument.
1799+-- as argument.
2083−-- >>> unsafeCreateOfWith alloc n = MutArray.unsafeAppendN (alloc n) n
1801+-- >>> writeNWithUnsafe alloc n = MutArray.writeAppendNUnsafe (alloc n) n
2085-- /Pre-release/
1803-- /Pre-release/
2086−{-# INLINE_NORMAL unsafeCreateOfWith #-}
1804+{-# INLINE_NORMAL writeNWithUnsafe #-}
2087−unsafeCreateOfWith :: forall m a. (MonadIO m, Unbox a)
1805+writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)
2088 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1806 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2089−unsafeCreateOfWith alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
1807+writeNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
@@ -2097,64 +1815,40 @@ unsafeCreateOfWith alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
2098 $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
1816 $ 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 #-}
1818{-# INLINE_NORMAL writeNUnsafeAs #-}
2107writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)
1819writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)
2108 => PinnedState -> Int -> Fold m a (MutArray a)
1820 => PinnedState -> Int -> Fold m a (MutArray a)
2109−writeNUnsafeAs ps = unsafeCreateOfWith (newAs ps)
1821+writeNUnsafeAs ps = writeNWithUnsafe (newAs ps)
2111−-- | Like 'createOf' but does not check the array bounds when writing. The fold
1823+-- | 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
1824-- 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
1825-- corrupt the memory and crash. This function exists mainly because any
2114-- conditional in the step function blocks fusion causing 10x performance
1826-- conditional in the step function blocks fusion causing 10x performance
2115-- slowdown.
1827-- slowdown.
2117−-- >>> unsafeCreateOf = MutArray.unsafeCreateOfWith MutArray.emptyOf
1829+-- >>> writeNUnsafe = MutArray.writeNWithUnsafe MutArray.new
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 #-}
1831+{-# INLINE_NORMAL writeNUnsafe #-}
2126writeNUnsafe :: forall m a. (MonadIO m, Unbox a)
1832writeNUnsafe :: forall m a. (MonadIO m, Unbox a)
2127 => Int -> Fold m a (MutArray a)
1833 => Int -> Fold m a (MutArray a)
2128−writeNUnsafe = unsafeCreateOf
1834+writeNUnsafe = writeNUnsafeAs Unpinned
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." #-}
1836+-- | Like 'writeNUnsafe' but creates a pinned array.
2137−{-# INLINE pinnedWriteNUnsafe #-}
1837+{-# INLINE_NORMAL pinnedWriteNUnsafe #-}
2138pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)
1838pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)
2139 => Int -> Fold m a (MutArray a)
1839 => Int -> Fold m a (MutArray a)
2140−pinnedWriteNUnsafe = unsafePinnedCreateOf
1840+pinnedWriteNUnsafe = writeNUnsafeAs Pinned
2142−-- | @createOfWith alloc n@ folds a maximum of @n@ elements into an array
1842+-- | @writeNWith alloc n@ folds a maximum of @n@ elements into an array
2143-- allocated using the @alloc@ function.
1843-- allocated using the @alloc@ function.
2145−-- >>> createOfWith alloc n = Fold.take n (MutArray.unsafeCreateOfWith alloc n)
1845+-- >>> writeNWith alloc n = Fold.take n (MutArray.writeNWithUnsafe alloc n)
2146−-- >>> createOfWith alloc n = MutArray.appendN (alloc n) n
1846+-- >>> writeNWith alloc n = MutArray.writeAppendN (alloc n) n
2148−{-# INLINE_NORMAL createOfWith #-}
1848+{-# 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)
1849writeNWith :: forall m a. (MonadIO m, Unbox a)
2156 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1850 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2157−writeNWith = createOfWith
1851+writeNWith alloc n = FL.take n (writeNWithUnsafe alloc n)
2159{-# INLINE_NORMAL writeNAs #-}
1853{-# INLINE_NORMAL writeNAs #-}
2160writeNAs ::
1854writeNAs ::
@@ -2162,42 +1856,28 @@ writeNAs ::
2162 => PinnedState
1856 => PinnedState
2164 -> Fold m a (MutArray a)
1858 -> Fold m a (MutArray a)
2165−writeNAs ps = createOfWith (newAs ps)
1859+writeNAs ps = writeNWith (newAs ps)
2167−-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an
1861+-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an
2168-- 'MutArray'.
1862-- 'MutArray'.
2170−-- >>> createOf = MutArray.createOfWith MutArray.new
1864+-- >>> writeN = MutArray.writeNWith MutArray.new
2171−-- >>> createOf n = Fold.take n (MutArray.unsafeCreateOf n)
1865+-- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)
2172−-- >>> createOf n = MutArray.appendN n (MutArray.emptyOf n)
1866+-- >>> writeN n = MutArray.writeAppendN n (MutArray.new n)
2174−{-# INLINE_NORMAL createOf #-}
1868+{-# 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)
1869writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2182−writeN = createOf
1870+writeN = writeNAs Unpinned
2184−-- | Like 'createOf' but creates a pinned array.
1872+-- | Like 'writeN' 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 #-}
1873+{-# INLINE_NORMAL pinnedWriteN #-}
2194pinnedWriteN ::
1874pinnedWriteN ::
2195 forall m a. (MonadIO m, Unbox a)
1875 forall m a. (MonadIO m, Unbox a)
2197 -> Fold m a (MutArray a)
1877 -> Fold m a (MutArray a)
2198−pinnedWriteN = pinnedCreateOf
1878+pinnedWriteN = writeNAs Pinned
2200−-- | Like unsafeCreateOfWith but writes the array in reverse order.
1880+-- | Like writeNWithUnsafe but writes the array in reverse order.
2202-- /Internal/
1882-- /Internal/
2203{-# INLINE_NORMAL writeRevNWithUnsafe #-}
1883{-# INLINE_NORMAL writeRevNWithUnsafe #-}
@@ -2218,7 +1898,7 @@ writeRevNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
2219 $ ArrayUnsafe contents ptr end
1899 $ ArrayUnsafe contents ptr end
2221−-- | Like createOfWith but writes the array in reverse order.
1901+-- | Like writeNWith but writes the array in reverse order.
2223-- /Internal/
1903-- /Internal/
2224{-# INLINE_NORMAL writeRevNWith #-}
1904{-# INLINE_NORMAL writeRevNWith #-}
@@ -2226,36 +1906,31 @@ writeRevNWith :: forall m a. (MonadIO m, Unbox a)
2226 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1906 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2227writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)
1907writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)
2229−-- | Like 'createOf' but writes the array in reverse order.
1909+-- | Like writeN but writes the array in reverse order.
2231-- /Pre-release/
1911-- /Pre-release/
2232−{-# INLINE_NORMAL revCreateOf #-}
1912+{-# 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)
1913writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2239−writeRevN = revCreateOf
1914+writeRevN = writeRevNWith new
2241-- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the
1916-- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the
2242-- input stream to a 'MutArray' aligned to the given size.
1917-- input stream to a 'MutArray' aligned to the given size.
2244−-- >>> pinnedWriteNAligned align = MutArray.createOfWith (MutArray.pinnedNewAligned align)
1919+-- >>> pinnedWriteNAligned align = MutArray.writeNWith (MutArray.pinnedNewAligned align)
2245−-- >>> pinnedWriteNAligned align n = MutArray.appendN n (MutArray.pinnedNewAligned align n)
1920+-- >>> pinnedWriteNAligned align n = MutArray.writeAppendN n (MutArray.pinnedNewAligned align n)
2247-- /Pre-release/
1922-- /Pre-release/
2249{-# INLINE_NORMAL pinnedWriteNAligned #-}
1924{-# INLINE_NORMAL pinnedWriteNAligned #-}
2250pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)
1925pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)
2251 => Int -> Int -> Fold m a (MutArray a)
1926 => Int -> Int -> Fold m a (MutArray a)
2252−pinnedWriteNAligned align = createOfWith (pinnedNewAligned align)
1927+pinnedWriteNAligned align = writeNWith (pinnedNewAligned align)
2254-- XXX Buffer to a list instead?
1929-- XXX Buffer to a list instead?
2256-- | Buffer a stream into a stream of arrays.
1931-- | Buffer a stream into a stream of arrays.
2258−-- >>> buildChunks n = Fold.many (MutArray.createOf n) Fold.toStreamK
1933+-- >>> buildChunks n = Fold.many (MutArray.writeN n) Fold.toStreamK
2260-- Breaking an array into an array stream can be useful to consume a large
1935-- 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.
1936-- array sequentially such that memory of the array is released incrementatlly.
@@ -2267,10 +1942,9 @@ pinnedWriteNAligned align = createOfWith (pinnedNewAligned align)
2267{-# INLINE_NORMAL buildChunks #-}
1942{-# INLINE_NORMAL buildChunks #-}
2268buildChunks :: (MonadIO m, Unbox a) =>
1943buildChunks :: (MonadIO m, Unbox a) =>
2269 Int -> Fold m a (StreamK n (MutArray a))
1944 Int -> Fold m a (StreamK n (MutArray a))
2270−buildChunks n = FL.many (createOf n) FL.toStreamK
1945+buildChunks n = FL.many (writeN n) FL.toStreamK
2272{-# DEPRECATED writeChunks "Please use buildChunks instead." #-}
1947{-# DEPRECATED writeChunks "Please use buildChunks instead." #-}
2273−{-# INLINE writeChunks #-}
2274writeChunks :: (MonadIO m, Unbox a) =>
1948writeChunks :: (MonadIO m, Unbox a) =>
2275 Int -> Fold m a (StreamK n (MutArray a))
1949 Int -> Fold m a (StreamK n (MutArray a))
2276writeChunks = buildChunks
1950writeChunks = buildChunks
@@ -2278,29 +1952,29 @@ writeChunks = buildChunks
2278{-# INLINE_NORMAL writeWithAs #-}
1952{-# INLINE_NORMAL writeWithAs #-}
2279writeWithAs :: forall m a. (MonadIO m, Unbox a)
1953writeWithAs :: forall m a. (MonadIO m, Unbox a)
2280 => PinnedState -> Int -> Fold m a (MutArray a)
1954 => PinnedState -> Int -> Fold m a (MutArray a)
2281−-- writeWithAs ps n = FL.rmapM rightSize $ appendWith (* 2) (newAs ps n)
1955+-- writeWithAs ps n = FL.rmapM rightSize $ writeAppendWith (* 2) (newAs ps n)
2282writeWithAs ps elemCount =
1956writeWithAs ps elemCount =
2283 FL.rmapM extract $ FL.foldlM' step initial
1957 FL.rmapM extract $ FL.foldlM' step initial
2287 initial = do
1961 initial = do
2288− when (elemCount < 0) $ error "createWith: elemCount is negative"
1962+ when (elemCount < 0) $ error "writeWith: elemCount is negative"
2289− newAs ps elemCount
1963+ liftIO $ newAs ps elemCount
2291 step arr@(MutArray _ start end bound) x
1965 step arr@(MutArray _ start end bound) x
2292 | INDEX_NEXT(end,a) > bound = do
1966 | INDEX_NEXT(end,a) > bound = do
2293 let oldSize = end - start
1967 let oldSize = end - start
2294 newSize = max (oldSize * 2) 1
1968 newSize = max (oldSize * 2) 1
2295− arr1 <- liftIO $ reallocExplicitAs ps (SIZE_OF(a)) newSize arr
1969+ arr1 <- liftIO $ reallocExplicit (SIZE_OF(a)) newSize arr
2296 snocUnsafe arr1 x
1970 snocUnsafe arr1 x
2297 step arr x = snocUnsafe arr x
1971 step arr x = snocUnsafe arr x
2299 extract = liftIO . rightSize
1973 extract = liftIO . rightSize
2301−-- XXX Compare createWith with fromStreamD which uses an array of streams
1975+-- XXX Compare writeWith with fromStreamD which uses an array of streams
2302-- implementation. We can write this using buildChunks above if that is faster.
1976-- implementation. We can write this using buildChunks above if that is faster.
2303−-- If createWith is faster then we should use that to implement
1977+-- If writeWith is faster then we should use that to implement
2304-- fromStreamD.
1978-- fromStreamD.
2306-- XXX The realloc based implementation needs to make one extra copy if we use
1980-- XXX The realloc based implementation needs to make one extra copy if we use
@@ -2315,56 +1989,39 @@ writeWithAs ps elemCount =
2315-- XXX check if GHC's memory allocator is efficient enough. We can try the C
1989-- XXX check if GHC's memory allocator is efficient enough. We can try the C
2316-- malloc to compare against.
1990-- malloc to compare against.
2318−-- | @createWith minCount@ folds the whole input to a single array. The array
1992+-- | @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
1993-- starts at a size big enough to hold minCount elements, the size is doubled
2320-- every time the array needs to be grown.
1994-- every time the array needs to be grown.
2322-- /Caution! Do not use this on infinite streams./
1996-- /Caution! Do not use this on infinite streams./
2324−-- >>> f n = MutArray.appendWith (* 2) (MutArray.emptyOf n)
1998+-- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.new n)
2325−-- >>> createWith n = Fold.rmapM MutArray.rightSize (f n)
1999+-- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)
2326−-- >>> createWith n = Fold.rmapM MutArray.fromChunksK (MutArray.buildChunks n)
2000+-- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.buildChunks n)
2328-- /Pre-release/
2002-- /Pre-release/
2329−{-# INLINE_NORMAL createWith #-}
2003+{-# 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)
2004writeWith :: forall m a. (MonadIO m, Unbox a)
2338 => Int -> Fold m a (MutArray a)
2005 => Int -> Fold m a (MutArray a)
2339−writeWith = createWith
2006+-- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (new n)
2007+writeWith = writeWithAs Unpinned
2341-- | Fold the whole input to a single array.
2009-- | Fold the whole input to a single array.
2343−-- Same as 'createWith' using an initial array size of 'arrayChunkBytes' bytes
2011+-- Same as 'writeWith' using an initial array size of 'arrayChunkBytes' bytes
2344-- rounded up to the element size.
2012-- rounded up to the element size.
2346-- /Caution! Do not use this on infinite streams./
2014-- /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 #-}
2016{-# INLINE write #-}
2355write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2017write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2356−write = create
2018+write = writeWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
2358−-- | Like 'create' but creates a pinned array.
2020+-- | Like 'write' but creates a pinned array.
2359−{-# INLINE pinnedCreate #-}
2360−pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2362− writeWithAs Pinned (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
2364−{-# DEPRECATED pinnedWrite "Please use pinnedCreate instead." #-}
2365{-# INLINE pinnedWrite #-}
2021{-# INLINE pinnedWrite #-}
2366pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2022pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2367−pinnedWrite = pinnedCreate
2023+pinnedWrite =
2024+ writeWithAs Pinned (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
2369-------------------------------------------------------------------------------
2026-------------------------------------------------------------------------------
2370-- construct from streams, known size
2027-- construct from streams, known size
@@ -2374,7 +2031,7 @@ pinnedWrite = pinnedCreate
2374fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)
2031fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)
2375 => PinnedState -> Int -> D.Stream m a -> m (MutArray a)
2032 => PinnedState -> Int -> D.Stream m a -> m (MutArray a)
2376fromStreamDNAs ps limit str = do
2033fromStreamDNAs ps limit str = do
2377− (arr :: MutArray a) <- newAs ps limit
2034+ (arr :: MutArray a) <- liftIO $ newAs ps limit
2378 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str
2035 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str
2379 return $ arr {arrEnd = end}
2036 return $ arr {arrEnd = end}
@@ -2384,21 +2041,15 @@ fromStreamDNAs ps limit str = do
2384 liftIO $ pokeAt ptr arrContents x
2041 liftIO $ pokeAt ptr arrContents x
2385 return $ INDEX_NEXT(ptr,a)
2042 return $ INDEX_NEXT(ptr,a)
2387−-- | Use the 'createOf' fold instead.
2044+-- | Use the 'writeN' fold instead.
2389−-- >>> fromStreamN n = Stream.fold (MutArray.createOf n)
2046+-- >>> fromStreamDN n = Stream.fold (MutArray.writeN 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 #-}
2048+{-# INLINE_NORMAL fromStreamDN #-}
2399fromStreamDN :: forall m a. (MonadIO m, Unbox a)
2049fromStreamDN :: forall m a. (MonadIO m, Unbox a)
2400 => Int -> D.Stream m a -> m (MutArray a)
2050 => Int -> D.Stream m a -> m (MutArray a)
2051+-- fromStreamDN n = D.fold (writeN n)
2401−fromStreamDN = fromStreamN
2052+fromStreamDN = fromStreamDNAs Unpinned
2403-- | Create a 'MutArray' from the first N elements of a list. The array is
2054-- | Create a '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
2055-- allocated to size N, if the list terminates before N elements then the
@@ -2418,20 +2069,20 @@ pinnedFromListN n xs = fromStreamDNAs Pinned n $ D.fromList xs
2418-- /Pre-release/
2069-- /Pre-release/
2419{-# INLINE fromListRevN #-}
2070{-# INLINE fromListRevN #-}
2420fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
2071fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
2421−fromListRevN n xs = D.fold (revCreateOf n) $ D.fromList xs
2072+fromListRevN n xs = D.fold (writeRevN n) $ D.fromList xs
2423-- | Convert a pure stream in Identity monad to a mutable array.
2074-- | Convert a pure stream in Identity monad to a mutable array.
2424{-# INLINABLE fromPureStreamN #-}
2075{-# INLINABLE fromPureStreamN #-}
2425fromPureStreamN :: (MonadIO m, Unbox a) =>
2076fromPureStreamN :: (MonadIO m, Unbox a) =>
2426 Int -> Stream Identity a -> m (MutArray a)
2077 Int -> Stream Identity a -> m (MutArray a)
2427fromPureStreamN n xs =
2078fromPureStreamN n xs =
2428− D.fold (createOf n) $ D.morphInner (return . runIdentity) xs
2079+ liftIO $ D.fold (writeN n) $ D.morphInner (return . runIdentity) xs
2430-- | Convert a pure stream in Identity monad to a mutable array.
2081-- | Convert a pure stream in Identity monad to a mutable array.
2431{-# INLINABLE fromPureStream #-}
2082{-# INLINABLE fromPureStream #-}
2432fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)
2083fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)
2433fromPureStream xs =
2084fromPureStream xs =
2434− D.fold create $ D.morphInner (return . runIdentity) xs
2085+ liftIO $ D.fold write $ D.morphInner (return . runIdentity) xs
2436{-# INLINABLE fromPtrN #-}
2087{-# INLINABLE fromPtrN #-}
2437fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)
2088fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)
@@ -2440,7 +2091,7 @@ fromPtrN len addr = do
2440 -- XXX We can implement a stream copy in a similar way by streaming Word64
2091 -- XXX We can implement a stream copy in a similar way by streaming Word64
2441 -- first and then remaining Word8.
2092 -- first and then remaining Word8.
2442 arr <- new len
2093 arr <- new len
2443− _ <- unsafeAsPtr arr
2094+ _ <- asUnpinnedPtrUnsafe arr
2444 (\ptr -> liftIO $ c_memcpy ptr addr (fromIntegral len))
2095 (\ptr -> liftIO $ c_memcpy ptr addr (fromIntegral len))
2445 return (arr {arrEnd = len})
2096 return (arr {arrEnd = len})
@@ -2456,7 +2107,7 @@ fromByteStr# addr = do
2456 len <- liftIO $ c_strlen (Ptr addr)
2107 len <- liftIO $ c_strlen (Ptr addr)
2457 let lenInt = fromIntegral len
2108 let lenInt = fromIntegral len
2458 arr <- new lenInt
2109 arr <- new lenInt
2459− _ <- unsafeAsPtr arr (\ptr -> liftIO $ c_memcpy ptr (Ptr addr) len)
2110+ _ <- asUnpinnedPtrUnsafe arr (\ptr -> liftIO $ c_memcpy ptr (Ptr addr) len)
2460 return (arr {arrEnd = lenInt})
2111 return (arr {arrEnd = lenInt})
2462-------------------------------------------------------------------------------
2113-------------------------------------------------------------------------------
@@ -2466,18 +2117,17 @@ fromByteStr# addr = do
2466-- XXX Both of these implementations of splicing seem to perform equally well.
2117-- XXX Both of these implementations of splicing seem to perform equally well.
2467-- We need to perform benchmarks over a range of sizes though.
2118-- We need to perform benchmarks over a range of sizes though.
2469−-- | Also see 'fromChunksK'.
2120+{-# INLINE fromArrayStreamRealloced #-}
2470−{-# INLINE fromChunksRealloced #-}
2471−fromChunksRealloced :: forall m a. (MonadIO m, Unbox a)
2121+fromArrayStreamRealloced :: forall m a. (MonadIO m, Unbox a)
2472 => Stream m (MutArray a) -> m (MutArray a)
2122 => Stream m (MutArray a) -> m (MutArray a)
2473−fromChunksRealloced s = do
2123+fromArrayStreamRealloced s = do
2474 res <- D.uncons s
2124 res <- D.uncons s
2475 case res of
2125 case res of
2476 Just (a, strm) -> do
2126 Just (a, strm) -> do
2477 arr <- D.foldlM' spliceExp (pure a) strm
2127 arr <- D.foldlM' spliceExp (pure a) strm
2478 -- Reallocation is exponential so there may be 50% empty space in
2128 -- Reallocation is exponential so there may be 50% empty space in
2479 -- worst case. One more reallocation to reclaim the space.
2129 -- worst case. One more reallocation to reclaim the space.
2480− rightSize arr
2130+ liftIO $ rightSize arr
2481 Nothing -> pure nil
2131 Nothing -> pure nil
2483-------------------------------------------------------------------------------
2133-------------------------------------------------------------------------------
@@ -2491,72 +2141,46 @@ arrayStreamKLength as = K.foldl' (+) 0 (K.map length as)
2491-- | Convert an array stream to an array. Note that this requires peak memory
2141-- | Convert an array stream to an array. Note that this requires peak memory
2492-- that is double the size of the array stream.
2142-- that is double the size of the array stream.
2494−{-# INLINE fromChunkskAs #-}
2144+{-# INLINE fromArrayStreamKAs #-}
2495−fromChunkskAs :: (Unbox a, MonadIO m) =>
2145+fromArrayStreamKAs :: (Unbox a, MonadIO m) =>
2496 PinnedState -> StreamK m (MutArray a) -> m (MutArray a)
2146 PinnedState -> StreamK m (MutArray a) -> m (MutArray a)
2497−fromChunkskAs ps as = do
2147+fromArrayStreamKAs ps as = do
2498 len <- arrayStreamKLength as
2148 len <- arrayStreamKLength as
2499 arr <- newAs ps len
2149 arr <- newAs ps len
2500 -- XXX is StreamK fold faster or StreamD fold?
2150 -- XXX is StreamK fold faster or StreamD fold?
2501 K.foldlM' spliceUnsafe (pure arr) as
2151 K.foldlM' spliceUnsafe (pure arr) as
2502 -- fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as
2152 -- 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
2154-- | Convert an array stream to an array. Note that this requires peak memory
2508-- that is double the size of the array stream.
2155-- 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 #-}
2157{-# INLINE fromArrayStreamK #-}
2519fromArrayStreamK :: (Unbox a, MonadIO m) =>
2158fromArrayStreamK :: (Unbox a, MonadIO m) =>
2520 StreamK m (MutArray a) -> m (MutArray a)
2159 StreamK m (MutArray a) -> m (MutArray a)
2521−fromArrayStreamK = fromChunksK
2160+fromArrayStreamK = fromArrayStreamKAs Unpinned
2523{-# INLINE fromStreamDAs #-}
2162{-# INLINE fromStreamDAs #-}
2524fromStreamDAs ::
2163fromStreamDAs ::
2525 (MonadIO m, Unbox a) => PinnedState -> D.Stream m a -> m (MutArray a)
2164 (MonadIO m, Unbox a) => PinnedState -> D.Stream m a -> m (MutArray a)
2526fromStreamDAs ps m =
2165fromStreamDAs ps m =
2527− arrayStreamKFromStreamDAs Unpinned m >>= fromChunkskAs ps
2166+ arrayStreamKFromStreamDAs Unpinned m >>= fromArrayStreamKAs 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
2168-- 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
2169-- due to GC overhead because we need to buffer the arrays before we flatten
2545-- all the arrays.
2170-- all the arrays.
2547−-- XXX Compare if this is faster or "fold create".
2172+-- XXX Compare if this is faster or "fold write".
2549-- | We could take the approach of doubling the memory allocation on each
2174-- | 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
2175-- 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
2176-- 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.
2177-- result in an extra copy of the entire data.
2554−-- >>> fromStreamD = StreamD.fold MutArray.create
2179+-- >>> fromStreamD = StreamD.fold MutArray.write
2556{-# INLINE fromStreamD #-}
2181{-# INLINE fromStreamD #-}
2557−{-# DEPRECATED fromStreamD "Please use fromStream instead." #-}
2558fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)
2182fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)
2559−fromStreamD = fromStream
2183+fromStreamD = fromStreamDAs Unpinned
2561-- | Create a 'MutArray' from a list. The list must be of finite size.
2185-- | Create a 'MutArray' from a list. The list must be of finite size.
@@ -2581,10 +2205,6 @@ fromListRev xs = fromListRevN (Prelude.length xs) xs
2581-- Cloning
2205-- Cloning
2582-------------------------------------------------------------------------------
2206-------------------------------------------------------------------------------
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 #-}
2208{-# INLINE cloneAs #-}
2589cloneAs ::
2209cloneAs ::
2590 ( MonadIO m
2210 ( MonadIO m
@@ -2594,7 +2214,7 @@ cloneAs ::
2595 => PinnedState -> MutArray a -> m (MutArray a)
2215 => PinnedState -> MutArray a -> m (MutArray a)
2596cloneAs ps src =
2216cloneAs ps src =
2597− do
2217+ liftIO $ do
2598 let startSrc = arrStart src
2218 let startSrc = arrStart src
2599 srcLen = arrEnd src - startSrc
2219 srcLen = arrEnd src - startSrc
2600 newArrContents <-
2220 newArrContents <-
@@ -2633,16 +2253,17 @@ spliceCopy :: forall m a. MonadIO m =>
2633 Unbox a =>
2253 Unbox a =>
2635 MutArray a -> MutArray a -> m (MutArray a)
2255 MutArray a -> MutArray a -> m (MutArray a)
2636−spliceCopy arr1 arr2 = do
2256+spliceCopy arr1 arr2 = liftIO $ do
2637 let start1 = arrStart arr1
2257 let start1 = arrStart arr1
2638 start2 = arrStart arr2
2258 start2 = arrStart arr2
2639 len1 = arrEnd arr1 - start1
2259 len1 = arrEnd arr1 - start1
2640 len2 = arrEnd arr2 - start2
2260 len2 = arrEnd arr2 - start2
2641− let len = len1 + len2
2261+ let newLen = len1 + len2
2642 newArrContents <-
2262 newArrContents <-
2643 if Unboxed.isPinned (arrContents arr1)
2263 if Unboxed.isPinned (arrContents arr1)
2644− then liftIO $ Unboxed.pinnedNew len
2264+ then Unboxed.pinnedNew newLen
2645− else liftIO $ Unboxed.new len
2265+ else Unboxed.new newLen
2266+ let len = len1 + len2
2646 putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1
2267 putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1
2647 putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2
2268 putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2
2648 return $ MutArray newArrContents 0 len len
2269 return $ MutArray newArrContents 0 len len
@@ -2654,7 +2275,7 @@ spliceCopy arr1 arr2 = do
2654spliceUnsafe :: MonadIO m =>
2275spliceUnsafe :: MonadIO m =>
2655 MutArray a -> MutArray a -> m (MutArray a)
2276 MutArray a -> MutArray a -> m (MutArray a)
2656spliceUnsafe dst src =
2277spliceUnsafe dst src =
2657− do
2278+ liftIO $ do
2658 let startSrc = arrStart src
2279 let startSrc = arrStart src
2659 srcLen = arrEnd src - startSrc
2280 srcLen = arrEnd src - startSrc
2660 endDst = arrEnd dst
2281 endDst = arrEnd dst
@@ -2676,7 +2297,7 @@ spliceWith :: forall m a. (MonadIO m, Unbox a) =>
2676 (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
2297 (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
2677spliceWith sizer dst@(MutArray _ start end bound) src = do
2298spliceWith sizer dst@(MutArray _ start end bound) src = do
2679− let f = appendWith (`sizer` byteLength src) (return dst)
2300+ let f = writeAppendWith (`sizer` byteLength src) (return dst)
2680 in D.fold f (toStreamD src)
2301 in D.fold f (toStreamD src)
2682 assert (end <= bound) (return ())
2303 assert (end <= bound) (return ())
@@ -2692,7 +2313,7 @@ spliceWith sizer dst@(MutArray _ start end bound) src = do
2692 $ "splice: newSize is less than the total size "
2313 $ "splice: newSize is less than the total size "
2693 ++ "of arrays being appended. Please check the "
2314 ++ "of arrays being appended. Please check the "
2694 ++ "sizer function passed."
2315 ++ "sizer function passed."
2695− realloc newSizeInBytes dst
2316+ liftIO $ realloc newSizeInBytes dst
2696 else return dst
2317 else return dst
2697 spliceUnsafe dst1 src
2318 spliceUnsafe dst1 src
@@ -2729,22 +2350,11 @@ spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))
2729-- Splitting
2350-- Splitting
2730-------------------------------------------------------------------------------
2351-------------------------------------------------------------------------------
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
2353-- | Drops the separator byte
2744{-# INLINE breakOn #-}
2354{-# INLINE breakOn #-}
2745breakOn :: MonadIO m
2355breakOn :: MonadIO m
2746 => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
2356 => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
2747−breakOn sep arr@MutArray{..} = unsafeAsPtr arr $ \p -> liftIO $ do
2357+breakOn sep arr@MutArray{..} = asUnpinnedPtrUnsafe arr $ \p -> liftIO $ do
2748 -- XXX We do not need memchr here, we can use a Haskell equivalent.
2358 -- XXX We do not need memchr here, we can use a Haskell equivalent.
2749 -- Need efficient stream based primitives that work on Word64.
2359 -- Need efficient stream based primitives that work on Word64.
2750 loc <- c_memchr p sep (fromIntegral $ byteLength arr)
2360 loc <- c_memchr p sep (fromIntegral $ byteLength arr)
@@ -2767,41 +2377,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
2380-- | Create two slices of an array without copying the original array. The
2793-- specified index @i@ is the first index of the second slice.
2381-- 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)
2383splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)
2797−splitAt i arr =
2384+splitAt i arr@MutArray{..} =
2798 let maxIndex = length arr - 1
2385 let maxIndex = length arr - 1
2799 in if i < 0
2386 in if i < 0
2800 then error "sliceAt: negative array index"
2387 then error "sliceAt: negative array index"
2801 else if i > maxIndex
2388 else if i > maxIndex
2802 then error $ "sliceAt: specified array index " ++ show i
2389 then error $ "sliceAt: specified array index " ++ show i
2803 ++ " is beyond the maximum index " ++ show maxIndex
2390 ++ " is beyond the maximum index " ++ show maxIndex
2804− else unsafeSplitAt i arr
2391+ else let off = i * SIZE_OF(a)
2394+ { arrContents = arrContents
2395+ , arrStart = arrStart
2400+ { arrContents = arrContents
2403+ , arrBound = arrBound
2806-------------------------------------------------------------------------------
2407-------------------------------------------------------------------------------
2807-- Casting
2408-- Casting
@@ -2851,13 +2452,9 @@ cast arr =
2851-- guarantees that unsafe calls will be performed in the calling thread. Making
2452-- guarantees that unsafe calls will be performed in the calling thread. Making
2852-- it safe to pass heap-allocated objects to unsafe functions.
2453-- it safe to pass heap-allocated objects to unsafe functions.
2854−-- XXX Should we just name it asPtr, the unsafety is implicit for any pointer
2455+-- Should we just name it asPtr, the unsafety is implicit for any pointer
2855-- operations. And we are safe from Haskell perspective because we will be
2456-- operations. And we are safe from Haskell perspective because we will be
2856-- pinning the memory.
2457-- 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
2459-- | Use a @MutArray a@ as @Ptr a@. This is useful when we want to pass an
2863-- array as a pointer to some operating system call or to a "safe" FFI call.
2460-- array as a pointer to some operating system call or to a "safe" FFI call.
@@ -2875,21 +2472,16 @@ cast arr =
2876-- /Pre-release/
2473-- /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 #-}
2475{-# INLINE asPtrUnsafe #-}
2886asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2476asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2887−asPtrUnsafe = unsafePinnedAsPtr
2477+asPtrUnsafe arr f =
2478+ Unboxed.asPtrUnsafe
2479+ (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2889−{-# INLINE unsafeAsPtr #-}
2481+{-# INLINE asUnpinnedPtrUnsafe #-}
2890−unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2482+asUnpinnedPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2891−unsafeAsPtr arr f =
2483+asUnpinnedPtrUnsafe arr f =
2892− Unboxed.unsafeAsPtr
2484+ Unboxed.asUnpinnedPtrUnsafe
2893 (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2485 (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2895-------------------------------------------------------------------------------
2487-------------------------------------------------------------------------------
@@ -2907,26 +2499,28 @@ unsafeAsPtr arr f =
2907-- /Pre-release/
2499-- /Pre-release/
2908{-# INLINE byteCmp #-}
2500{-# INLINE byteCmp #-}
2909byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
2501byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
2910−byteCmp arr1 arr2 = do
2502+byteCmp arr1 arr2 =
2911− let marr1 = getMutableByteArray# (arrContents arr1)
2505+ let marr1 = getMutableByteArray# (arrContents arr1)
2912− marr2 = getMutableByteArray# (arrContents arr2)
2506+ marr2 = getMutableByteArray# (arrContents arr2)
2913− !(I# st1#) = arrStart arr1
2507+ !(I# st1#) = arrStart arr1
2914− !(I# st2#) = arrStart arr2
2508+ !(I# st2#) = arrStart arr2
2915− !(I# len#) = byteLength arr1
2509+ !(I# len#) = byteLength arr1
2916− case compare (byteLength arr1) (byteLength arr2) of
2510+ case compare (byteLength arr1) (byteLength arr2) of
2917− EQ -> do
2511+ EQ -> do
2918− r <- liftIO $ IO $ \s# ->
2512+ r <- liftIO $ IO $ \s# ->
2919− let res =
2513+ let res =
2921− (compareByteArrays#
2515+ (compareByteArrays#
2922− (unsafeCoerce# marr1)
2516+ (unsafeCoerce# marr1)
2924− (unsafeCoerce# marr2)
2518+ (unsafeCoerce# marr2)
2927− in (# s#, res #)
2521+ in (# s#, res #)
2928− return $ compare r 0
2522+ return $ compare r 0
2929− x -> return x
2523+ x -> return x
2931{-# INLINE cmp #-}
2525{-# INLINE cmp #-}
2932{-# DEPRECATED cmp "Please use byteCmp instead." #-}
2526{-# DEPRECATED cmp "Please use byteCmp instead." #-}
@@ -2943,309 +2537,7 @@ byteEq :: MonadIO m => MutArray a -> MutArray a -> m Bool
2943byteEq arr1 arr2 = fmap (EQ ==) $ byteCmp arr1 arr2
2537byteEq arr1 arr2 = fmap (EQ ==) $ byteCmp arr1 arr2
2945-------------------------------------------------------------------------------
2539-------------------------------------------------------------------------------
2946−-- Compact
2540+-- 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-------------------------------------------------------------------------------
2541-------------------------------------------------------------------------------
3251-- | Strip elements which match with predicate from both ends.
2543-- | Strip elements which match with predicate from both ends.