@@ -31,37 +31,57 @@ module Streamly.Internal.Data.MutArray.Type
31 -- ** Type
31 -- ** Type
32 -- $arrayNotes
32 -- $arrayNotes
33 MutArray (..)
33 MutArray (..)
36+ -- *** Pinned and Unpinned
36 , isPinned
39 , isPinned
38− -- -- * Constructing and Writing
41+ -- ** Casting
43+ , castUnsafe -- XXX unsafeCast
39 -- ** Construction
48 -- ** 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
42− -- *** Uninitialized Arrays
64+ -- *** Slicing
43− , pinnedNew
65+ -- | Get a subarray without copying
44− , pinnedNewBytes
66+ , getSliceUnsafe -- XXX unsafeGetSlice
45− , pinnedNewAligned
67+ , getSlice
46− , new
68+ , splitAt -- XXX should be able to express using getSlice
47− , newArrayWith
69+ , breakOn
49− -- *** From streams
71+ -- *** Stream Folds
50 , ArrayUnsafe (..)
72 , ArrayUnsafe (..)
51− , writeNWithUnsafe
73+ , unsafeCreateOfWith
52− , writeNWith
74+ , unsafeCreateOf
53− , writeNUnsafe
75+ , unsafePinnedCreateOf
54− , pinnedWriteNUnsafe
76+ , pinnedCreateOf
55− , writeN
77+ , createOfWith
56− , pinnedWriteN
78+ , createOf
57− , pinnedWriteNAligned
79+ , revCreateOf
59− , writeWith
81+ , pinnedCreate
60− , write
82+ , createWith
61− , pinnedWrite
83+ , create
66 -- *** From containers
86 -- *** From containers
67 , fromListN
87 , fromListN
@@ -77,11 +97,11 @@ module Streamly.Internal.Data.MutArray.Type
77 , fromByteStr#
97 , fromByteStr#
78 , fromPtrN
98 , fromPtrN
79 , fromChunksK
99 , fromChunksK
80− , fromChunksRealloced
100+ , fromChunksRealloced -- fromSmallChunks
82 -- ** Random writes
102 -- ** Random writes
83 , putIndex
103 , putIndex
84− , putIndexUnsafe
104+ , putIndexUnsafe -- XXX unsafePutIndex
85 , putIndices
105 , putIndices
86 -- , putFromThenTo
106 -- , putFromThenTo
87 -- , putFrom -- start writing at the given position
107 -- , putFrom -- start writing at the given position
@@ -89,77 +109,70 @@ module Streamly.Internal.Data.MutArray.Type
89 -- , putFromTo
109 -- , putFromTo
90 -- , putFromRev
110 -- , putFromRev
91 -- , putUptoRev
111 -- , putUptoRev
92− , modifyIndexUnsafe
112+ , modifyIndexUnsafe -- XXX unsafeModifyIndex
93 , modifyIndex
113 , modifyIndex
94 , modifyIndices
114 , modifyIndices
96 , swapIndices
116 , swapIndices
97 , unsafeSwapIndices
117 , unsafeSwapIndices
99− -- ** Growing and Shrinking
119+ -- ** Reading
100− -- | Arrays grow only at the end, though it is possible to grow on both sides
101− -- and therefore have a cons as well as snoc. But that will require two
102− -- bounds in the array representation.
104− -- *** Appending elements
111− -- *** Appending streams
112− , writeAppendNUnsafe
117− -- ** Eliminating and Reading
121+ -- *** Indexing
119− -- *** To streams
123+ , getIndexUnsafe -- XXX unsafeGetIndex
120− , reader
124+ -- , getFromThenTo
121− , readerRevWith
125+ , getIndexRev -- getRevIndex?
122− , readerRev
126+ , indexReader
124− -- *** To containers
129+ -- *** To Streams
130 , readRev
131 , readRev
131 , toStreamK
134 , toStreamK
132 , toStreamKRev
136 , toStreamKRev
139+ -- *** To Containers
135 -- experimental
143 -- experimental
136 , producerWith
144 , producerWith
137 , producer
145 , producer
139− -- *** Random reads
147+ , reader
140− , getIndex
148+ , readerRevWith
141− , getIndexUnsafe
149+ , readerRev
147− -- ** Memory Management
150− , allocBytesToElemCount
156− -- ** Size
151+ -- ** Size and Capacity
158 , byteLength
154 , byteLength
159 -- , capacity
157 -- , capacity
160 , byteCapacity
158 , byteCapacity
161 , bytesFree
159 , bytesFree
161+ -- *** Capacity Management
164+ , allocBytesToElemCount
165+ , realloc -- this is "resize"
163 -- ** In-place Mutation Algorithms
176 -- ** In-place Mutation Algorithms
165 , reverse
178 , reverse
@@ -170,59 +183,82 @@ module Streamly.Internal.Data.MutArray.Type
170 , mergeBy
183 , mergeBy
173− -- ** Casting
186+ -- ** Growing and Shrinking
174− , cast
187+ -- | Arrays grow only at the end, though it is possible to grow on both
175− , castUnsafe
188+ -- sides and therefore have a cons as well as snoc. But that will require
176− , asBytes
189+ -- both lower and upper bound in the array representation.
178− , asUnpinnedPtrUnsafe
180− -- ** Folding
191+ -- *** Appending elements
181− , foldl'
192+ , snocWith
183− , cmp
194+ , snocLinear
184− , byteCmp
195+ , snocMay
185− , byteEq
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
221+ , peekUnconsUnsafe -- unsafePeekUncons
222+ , peekSkipUnsafe -- unsafePeekSkip
187− -- ** Arrays of arrays
224+ -- Arrays of arrays
188 -- We can add dimensionality parameter to the array type to get
225 -- We can add dimensionality parameter to the array type to get
189 -- multidimensional arrays. Multidimensional arrays would just be a
226 -- multidimensional arrays. Multidimensional arrays would just be a
190 -- convenience wrapper on top of single dimensional arrays.
227 -- convenience wrapper on top of single dimensional arrays.
192− -- | Operations dealing with multiple arrays, streams of arrays or
229+ -- ** Streams of Arrays
193− -- multidimensional array representations.
230+ -- *** Chunk
194−
231+ -- | Group a stream into arrays.
195− -- *** Construct from streams
196 , chunksOf
232 , chunksOf
197 , pinnedChunksOf
233 , pinnedChunksOf
198 , buildChunks
234 , buildChunks
200− -- *** Eliminate to streams
236+ -- *** Split
201− , concatChunks
237+ -- | Split an array into slices.
204− -- *** Construct from arrays
205− -- get chunks without copying
208 -- , getSlicesFromLenN
239 -- , getSlicesFromLenN
209− , splitAt -- XXX should be able to express using getSlice
210 , splitOn
240 , splitOn
211− , breakOn
241+ -- , slicesOf
213− -- ** Cloning arrays
243+ -- *** Concat
214− , clone
244+ -- | Append the arrays in a stream to form a stream of elements.
215− , pinnedClone
245+ , concatWith
217− -- ** Appending arrays
247+ , concat
218− , spliceCopy
248+ , concatRev
220− , splice
250+ -- *** Compact
221− , spliceExp
251+ -- | Append the arrays in a stream to form a stream of larger arrays.
222− , spliceUnsafe
252+ , SpliceState (..)
223− -- , putSlice
253+ , pCompactLE
224− -- , appendSlice
254+ , pPinnedCompactLE
225− -- , appendSliceFrom
255+ , compactLeAs
227 -- ** Utilities
263 -- ** Utilities
228 , roundUpToPower2
264 , roundUpToPower2
@@ -231,12 +267,37 @@ module Streamly.Internal.Data.MutArray.Type
231 , c_memchr
267 , c_memchr
233 -- * Deprecated
269 -- * Deprecated
234 , writeChunks
271 , writeChunks
235 , flattenArrays
272 , flattenArrays
236 , flattenArraysRev
273 , flattenArraysRev
237 , fromArrayStreamK
274 , fromArrayStreamK
238 , fromStreamDN
275 , fromStreamDN
239 , fromStreamD
276 , fromStreamD
286+ , writeAppendNUnsafe
293+ , pinnedWriteNUnsafe
296+ , pinnedWriteNAligned -- XXX not required
@@ -247,6 +308,7 @@ where
248import Control.Monad (when, void)
309import Control.Monad (when, void)
249import Control.Monad.IO.Class (MonadIO(..))
310import Control.Monad.IO.Class (MonadIO(..))
311+import Data.Bifunctor (first)
250import Data.Bits (shiftR, (.|.), (.&.))
312import Data.Bits (shiftR, (.|.), (.&.))
251import Data.Functor.Identity (Identity(..))
313import Data.Functor.Identity (Identity(..))
252import Data.Proxy (Proxy(..))
314import Data.Proxy (Proxy(..))
@@ -273,13 +335,17 @@ import GHC.Ptr (Ptr(..))
273import Streamly.Internal.Data.Fold.Type (Fold(..))
335import Streamly.Internal.Data.Fold.Type (Fold(..))
274import Streamly.Internal.Data.Producer.Type (Producer (..))
336import Streamly.Internal.Data.Producer.Type (Producer (..))
275import Streamly.Internal.Data.Stream.Type (Stream)
337import Streamly.Internal.Data.Stream.Type (Stream)
338+import Streamly.Internal.Data.Parser.Type (Parser (..))
276import Streamly.Internal.Data.StreamK.Type (StreamK)
339import Streamly.Internal.Data.StreamK.Type (StreamK)
277import Streamly.Internal.Data.SVar.Type (adaptState, defState)
340import Streamly.Internal.Data.SVar.Type (adaptState, defState)
341+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
278import Streamly.Internal.Data.Unfold.Type (Unfold(..))
342import Streamly.Internal.Data.Unfold.Type (Unfold(..))
279import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)
343import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)
281import qualified Streamly.Internal.Data.Fold.Type as FL
345import qualified Streamly.Internal.Data.Fold.Type as FL
282import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed
346import 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
283import qualified Streamly.Internal.Data.Producer as Producer
349import qualified Streamly.Internal.Data.Producer as Producer
284import qualified Streamly.Internal.Data.Stream.Type as D
350import qualified Streamly.Internal.Data.Stream.Type as D
285import qualified Streamly.Internal.Data.Stream.Lift as D
351import qualified Streamly.Internal.Data.Stream.Lift as D
@@ -287,7 +353,7 @@ import qualified Streamly.Internal.Data.StreamK.Type as K
287import qualified Prelude
353import qualified Prelude
289import Prelude hiding
355import Prelude hiding
290− (Foldable(..), read, unlines, splitAt, reverse, truncate)
356+ (Foldable(..), concat, read, unlines, splitAt, reverse, truncate)
292#include "DocTestDataMutArray.hs"
358#include "DocTestDataMutArray.hs"
@@ -413,6 +479,8 @@ isPinned MutArray{..} = Unboxed.isPinned arrContents
413-- we need more than that. See stg_pinnedNewAlignedByteArrayzh and
479-- we need more than that. See stg_pinnedNewAlignedByteArrayzh and
414-- allocatePinned in GHC source.
480-- allocatePinned in GHC source.
482+-- XXX Rename to emptyAlignedWith, alignSize should be first arg.
416-- | @newArrayWith allocator alignment count@ allocates a new array of zero
484-- | @newArrayWith allocator alignment count@ allocates a new array of zero
417-- length and with a capacity to hold @count@ elements, using @allocator
485-- length and with a capacity to hold @count@ elements, using @allocator
418-- size alignment@ as the memory allocator function.
486-- size alignment@ as the memory allocator function.
@@ -436,12 +504,25 @@ newArrayWith alloc alignSize count = do
436 , arrBound = size
504 , arrBound = size
507+-- For arrays "nil" sounds a bit odd. empty is better. The only problem with
508+-- empty is that it is also used by the Alternative type class. But assuming we
509+-- will mostly import the Array module qualified this should be fine.
511+-- | Create an empty array.
517+empty = MutArray Unboxed.empty 0 0 0
519+{-# DEPRECATED nil "Please use empty instead." #-}
440#ifdef DEVBUILD
521#ifdef DEVBUILD
441 Unbox a =>
522 Unbox a =>
443 MutArray a
524 MutArray a
444−nil = MutArray Unboxed.nil 0 0 0
525+nil = empty
446{-# INLINE newBytesAs #-}
527{-# INLINE newBytesAs #-}
447newBytesAs :: MonadIO m =>
528newBytesAs :: MonadIO m =>
@@ -458,12 +539,13 @@ newBytesAs ps bytes = do
458 , arrBound = bytes
539 , arrBound = bytes
461−-- | Allocates a pinned empty array that can hold 'count' items. The memory of
542+-- | Allocates a pinned empty array that with a reserved capacity of bytes.
462−-- the array is uninitialized and the allocation is aligned as per the
543+-- The memory of the array is uninitialized and the allocation is aligned as
463−-- 'Unboxed' instance of the type.
544+-- per the 'Unboxed' instance of the type.
465-- /Pre-release/
546-- /Pre-release/
466{-# INLINE pinnedNewBytes #-}
547{-# INLINE pinnedNewBytes #-}
548+{-# DEPRECATED pinnedNewBytes "Please use pinnedEmptyOf with appropriate calculation" #-}
467pinnedNewBytes :: MonadIO m =>
549pinnedNewBytes :: MonadIO m =>
468#ifdef DEVBUILD
550#ifdef DEVBUILD
469 Unbox a =>
551 Unbox a =>
@@ -488,21 +570,31 @@ newAs ps =
488 (error "new: alignment is not used in unpinned arrays.")
570 (error "new: alignment is not used in unpinned arrays.")
490-- XXX can unaligned allocation be more efficient when alignment is not needed?
572-- XXX can unaligned allocation be more efficient when alignment is not needed?
492−-- | Allocates an empty pinned array that can hold 'count' items. The memory of
574+-- | Allocates a pinned array of zero length but growable to the specified
493−-- the array is uninitialized and the allocation is aligned as per the 'Unboxed'
575+-- capacity without reallocation.
494−-- instance of the type.
576+{-# INLINE pinnedEmptyOf #-}
495−--
577+pinnedEmptyOf :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
578+pinnedEmptyOf = newAs Pinned
580+-- XXX Deprecate in major
581+-- {-# DEPRECATED pinnedNew "Please use pinnedEmptyOf instead." #-}
496{-# INLINE pinnedNew #-}
582{-# INLINE pinnedNew #-}
497pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
583pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
498−pinnedNew = newAs Pinned
584+pinnedNew = pinnedEmptyOf
500−-- | Allocates an empty unpinned array that can hold 'count' items. The memory
586+-- | Allocates an unpinned array of zero length but growable to the specified
501−-- of the array is uninitialized.
587+-- capacity without reallocation.
589+{-# INLINE emptyOf #-}
590+emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
591+emptyOf = newAs Unpinned
593+-- XXX Deprecate in major
594+-- {-# DEPRECATED new "Please use emptyOf instead." #-}
503{-# INLINE new #-}
595{-# INLINE new #-}
504new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
596new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
505−new = newAs Unpinned
597+new = emptyOf
507-------------------------------------------------------------------------------
599-------------------------------------------------------------------------------
508-- Random writes
600-- Random writes
@@ -550,7 +642,7 @@ putIndices arr = FL.foldlM' step (return ())
553− step () (i, x) = liftIO (putIndex i arr x)
645+ step () (i, x) = putIndex i arr x
555-- | Modify a given index of an array using a modifier function.
647-- | Modify a given index of an array using a modifier function.
@@ -746,22 +838,19 @@ arrayChunkBytes = 1024
746roundDownTo :: Int -> Int -> Int
838roundDownTo :: Int -> Int -> Int
747roundDownTo elemSize size = size - (size `mod` elemSize)
839roundDownTo elemSize size = size - (size `mod` elemSize)
749−-- XXX See if resizing can be implemented by reading the old array as a stream
750−-- and then using writeN to the new array.
752-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.
841-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.
753-- Since this is not inlined Unboxed consrraint leads to dictionary passing
842-- Since this is not inlined Unboxed consrraint leads to dictionary passing
754-- which complicates some inspection tests.
843-- which complicates some inspection tests.
756−{-# NOINLINE reallocExplicit #-}
845+{-# NOINLINE reallocExplicitAs #-}
757−reallocExplicit :: Int -> Int -> MutArray a -> IO (MutArray a)
846+reallocExplicitAs :: PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
758−reallocExplicit elemSize newCapacityInBytes MutArray{..} = do
847+reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do
759 assertM(arrEnd <= arrBound)
848 assertM(arrEnd <= arrBound)
761 -- Allocate new array
850 -- Allocate new array
762 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
851 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
763 contents <-
852 contents <-
764− if Unboxed.isPinned arrContents
853+ if ps == Pinned
765 then Unboxed.pinnedNew newCapMaxInBytes
854 then Unboxed.pinnedNew newCapMaxInBytes
766 else Unboxed.new newCapMaxInBytes
855 else Unboxed.new newCapMaxInBytes
767 let !(MutByteArray mbarrFrom#) = arrContents
856 let !(MutByteArray mbarrFrom#) = arrContents
@@ -786,6 +875,10 @@ reallocExplicit elemSize newCapacityInBytes MutArray{..} = do
786 , arrBound = newCapInBytes
875 , arrBound = newCapInBytes
878+-- XXX Should these be called reallocBytes etc?
879+-- XXX We may also need reallocAs to allocate as pinned/unpinned explicitly. In
880+-- fact clone/pinnedClone can be implemented using reallocAs.
789-- | @realloc newCapacity array@ reallocates the array to the specified
882-- | @realloc newCapacity array@ reallocates the array to the specified
790-- capacity in bytes.
883-- capacity in bytes.
@@ -797,7 +890,12 @@ reallocExplicit elemSize newCapacityInBytes MutArray{..} = do
797-- If the original array is pinned, the newly allocated array is also pinned.
890-- If the original array is pinned, the newly allocated array is also pinned.
798{-# INLINABLE realloc #-}
891{-# INLINABLE realloc #-}
799realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)
892realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)
800−realloc bytes arr = liftIO $ reallocExplicit (SIZE_OF(a)) bytes arr
898+ in liftIO $ reallocExplicitAs ps (SIZE_OF(a)) bytes arr
802-- | @reallocWith label capSizer minIncrBytes array@. The label is used
900-- | @reallocWith label capSizer minIncrBytes array@. The label is used
803-- in error messages and the capSizer is used to determine the capacity of the
901-- in error messages and the capSizer is used to determine the capacity of the
@@ -820,14 +918,14 @@ reallocWith label capSizer minIncrBytes arr = do
822 badSize newSize =
920 badSize newSize =
823− concat
921+ Prelude.concat
825 , ": new array size (in bytes) is less than required size "
923 , ": new array size (in bytes) is less than required size "
826 , show newSize
924 , show newSize
827 , ". Please check the sizing function passed."
925 , ". Please check the sizing function passed."
830−-- | @resize newCapacity array@ changes the total capacity of the array so that
928+-- | @grow newCapacity array@ changes the total capacity of the array so that
831-- it is enough to hold the specified number of elements. Nothing is done if
929-- it is enough to hold the specified number of elements. Nothing is done if
832-- the specified capacity is less than the length of the array.
930-- the specified capacity is less than the length of the array.
@@ -835,34 +933,46 @@ reallocWith label capSizer minIncrBytes arr = do
835-- the block size (4K).
933-- the block size (4K).
837-- /Pre-release/
935-- /Pre-release/
838−{-# INLINE resize #-}
936+{-# INLINE grow #-}
839−resize :: forall m a. (MonadIO m, Unbox a) =>
937+grow :: forall m a. (MonadIO m, Unbox a) =>
840 Int -> MutArray a -> m (MutArray a)
938 Int -> MutArray a -> m (MutArray a)
841−resize nElems arr@MutArray{..} = do
939+grow nElems arr@MutArray{..} = do
842 let req = SIZE_OF(a) * nElems
940 let req = SIZE_OF(a) * nElems
843− len = arrEnd - arrStart
941+ cap = arrBound - arrStart
844− if req < len
942+ if req < cap
845 then return arr
943 then return arr
846 else realloc req arr
944 else realloc req arr
946+{-# DEPRECATED resize "Please use grow instead." #-}
947+{-# INLINE resize #-}
948+resize :: forall m a. (MonadIO m, Unbox a) =>
949+ Int -> MutArray a -> m (MutArray a)
848−-- | Like 'resize' but if the byte capacity is more than 'largeObjectThreshold'
952+-- | Like 'grow' but if the requested byte capacity is more than
849−-- then it is rounded up to the closest power of 2.
953+-- 'largeObjectThreshold' then it is rounded up to the closest power of 2.
851-- /Pre-release/
955-- /Pre-release/
852−{-# INLINE resizeExp #-}
956+{-# INLINE growExp #-}
853−resizeExp :: forall m a. (MonadIO m, Unbox a) =>
957+growExp :: forall m a. (MonadIO m, Unbox a) =>
854 Int -> MutArray a -> m (MutArray a)
958 Int -> MutArray a -> m (MutArray a)
855−resizeExp nElems arr@MutArray{..} = do
959+growExp nElems arr@MutArray{..} = do
856 let req = roundUpLargeArray (SIZE_OF(a) * nElems)
960 let req = roundUpLargeArray (SIZE_OF(a) * nElems)
858 if req > largeObjectThreshold
962 if req > largeObjectThreshold
859 then roundUpToPower2 req
963 then roundUpToPower2 req
861− len = arrEnd - arrStart
965+ cap = arrBound - arrStart
862− if req1 < len
966+ if req1 < cap
863 then return arr
967 then return arr
864 else realloc req1 arr
968 else realloc req1 arr
970+{-# DEPRECATED resizeExp "Please use growExp instead." #-}
971+{-# INLINE resizeExp #-}
972+resizeExp :: forall m a. (MonadIO m, Unbox a) =>
973+ Int -> MutArray a -> m (MutArray a)
866-- | Resize the allocated memory to drop any reserved free space at the end of
976-- | Resize the allocated memory to drop any reserved free space at the end of
867-- the array and reallocate it to reduce wastage.
977-- the array and reallocate it to reduce wastage.
@@ -927,7 +1037,7 @@ snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr
927{-# INLINE snocMay #-}
1037{-# INLINE snocMay #-}
928snocMay :: forall m a. (MonadIO m, Unbox a) =>
1038snocMay :: forall m a. (MonadIO m, Unbox a) =>
929 MutArray a -> a -> m (Maybe (MutArray a))
1039 MutArray a -> a -> m (Maybe (MutArray a))
930−snocMay arr@MutArray{..} x = liftIO $ do
1040+snocMay arr@MutArray{..} x = do
931 let newEnd = INDEX_NEXT(arrEnd,a)
1041 let newEnd = INDEX_NEXT(arrEnd,a)
932 if newEnd <= arrBound
1042 if newEnd <= arrBound
933 then Just <$> snocNewEnd newEnd arr x
1043 then Just <$> snocNewEnd newEnd arr x
@@ -941,7 +1051,7 @@ snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>
942 -> m (MutArray a)
1052 -> m (MutArray a)
943snocWithRealloc sizer arr x = do
1053snocWithRealloc sizer arr x = do
944− arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr
1054+ arr1 <- reallocWith "snocWith" sizer (SIZE_OF(a)) arr
945 snocUnsafe arr1 x
1055 snocUnsafe arr1 x
947-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of
1057-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of
@@ -963,7 +1073,7 @@ snocWith :: forall m a. (MonadIO m, Unbox a) =>
963 -> MutArray a
1073 -> MutArray a
965 -> m (MutArray a)
1075 -> m (MutArray a)
966−snocWith allocSize arr x = liftIO $ do
1076+snocWith allocSize arr x = do
967 let newEnd = INDEX_NEXT(arrEnd arr,a)
1077 let newEnd = INDEX_NEXT(arrEnd arr,a)
968 if newEnd <= arrBound arr
1078 if newEnd <= arrBound arr
969 then snocNewEnd newEnd arr x
1079 then snocNewEnd newEnd arr x
@@ -1007,6 +1117,126 @@ snoc = snocWith f
1007 then oldSize * 2
1117 then oldSize * 2
1008 else roundUpToPower2 oldSize * 2
1118 else roundUpToPower2 oldSize * 2
1120+-------------------------------------------------------------------------------
1121+-- Serialization/Deserialization
1122+-------------------------------------------------------------------------------
1124+{-# INLINE pokeNewEnd #-}
1125+pokeNewEnd :: (MonadIO m, Unbox a) =>
1126+ Int -> MutArray Word8 -> a -> m (MutArray Word8)
1127+pokeNewEnd newEnd arr@MutArray{..} x = liftIO $ do
1128+ assert (newEnd <= arrBound) (return ())
1129+ liftIO $ pokeAt arrEnd arrContents x
1130+ return $ arr {arrEnd = newEnd}
1132+-- | Really really unsafe, unboxes a Haskell type and appends the resulting
1133+-- bytes to the byte array, may cause silent data corruption or if you are
1134+-- lucky a segfault if the array does not have enough space to append the
1138+{-# INLINE pokeAppendUnsafe #-}
1139+pokeAppendUnsafe :: forall m a. (MonadIO m, Unbox a) =>
1140+ MutArray Word8 -> a -> m (MutArray Word8)
1141+pokeAppendUnsafe arr@MutArray{..} = pokeNewEnd (arrEnd + SIZE_OF(a)) arr
1143+-- | Skip the specified number of bytes in the array. The data in the skipped
1144+-- region remains uninitialzed.
1145+{-# INLINE pokeSkipUnsafe #-}
1146+pokeSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8
1147+pokeSkipUnsafe n arr@MutArray{..} = do
1148+ let newEnd = arrEnd + n
1149+ in assert (newEnd <= arrBound) (arr {arrEnd = newEnd})
1151+-- | Like 'pokeAppend' but does not grow the array when pre-allocated array
1152+-- capacity becomes full.
1155+{-# INLINE pokeAppendMay #-}
1156+pokeAppendMay :: forall m a. (MonadIO m, Unbox a) =>
1157+ MutArray Word8 -> a -> m (Maybe (MutArray Word8))
1158+pokeAppendMay arr@MutArray{..} x = liftIO $ do
1159+ let newEnd = arrEnd + SIZE_OF(a)
1160+ if newEnd <= arrBound
1161+ then Just <$> pokeNewEnd newEnd arr x
1162+ else return Nothing
1164+{-# NOINLINE pokeWithRealloc #-}
1165+pokeWithRealloc :: forall m a. (MonadIO m, Unbox a) =>
1169+ -> m (MutArray Word8)
1170+pokeWithRealloc sizer arr x = do
1171+ arr1 <- liftIO $ reallocWith "pokeWithRealloc" sizer (SIZE_OF(a)) arr
1172+ pokeAppendUnsafe arr1 x
1174+{-# INLINE pokeAppendWith #-}
1175+pokeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
1179+ -> m (MutArray Word8)
1180+pokeAppendWith allocSize arr x = liftIO $ do
1181+ let newEnd = arrEnd arr + SIZE_OF(a)
1182+ if newEnd <= arrBound arr
1183+ then pokeNewEnd newEnd arr x
1184+ else pokeWithRealloc allocSize arr x
1186+-- | Unbox a Haskell type and append the resulting bytes to a mutable byte
1187+-- array. The array is grown exponentially when more space is needed.
1191+-- >>> pokeAppend arr x = MutArray.castUnsafe <$> MutArray.snoc (MutArray.castUnsafe arr) x
1193+{-# INLINE pokeAppend #-}
1194+pokeAppend :: forall m a. (MonadIO m, Unbox a) =>
1195+ MutArray Word8 -> a -> m (MutArray Word8)
1196+pokeAppend = pokeAppendWith f
1201+ if isPower2 oldSize
1203+ else roundUpToPower2 oldSize * 2
1205+-- | Really really unsafe, create a Haskell value from an unboxed byte array,
1206+-- does not check if the array is big enough, may return garbage or if you are
1207+-- lucky may cause a segfault.
1210+{-# INLINE peekUnconsUnsafe #-}
1211+peekUnconsUnsafe :: forall m a. (MonadIO m, Unbox a) =>
1212+ MutArray Word8 -> m (a, MutArray Word8)
1213+peekUnconsUnsafe MutArray{..} = do
1214+ let start1 = arrStart + SIZE_OF(a)
1215+ assert (start1 <= arrEnd) (return ())
1217+ r <- peekAt arrStart arrContents
1218+ return (r, MutArray arrContents start1 arrEnd arrBound)
1220+-- | Discard the specified number of bytes in the array.
1221+{-# INLINE peekSkipUnsafe #-}
1222+peekSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8
1223+peekSkipUnsafe n MutArray{..} =
1224+ let start1 = arrStart + n
1225+ in assert (start1 <= arrEnd) (MutArray arrContents start1 arrEnd arrBound)
1227+-- | Create a Haskell value from its unboxed representation from the head of a
1228+-- byte array, return the value and the remaining array.
1229+{-# INLINE peekUncons #-}
1230+peekUncons :: forall m a. (MonadIO m, Unbox a) =>
1231+ MutArray Word8 -> m (Maybe a, MutArray Word8)
1232+peekUncons arr@MutArray{..} = do
1233+ let start1 = arrStart + SIZE_OF(a)
1235+ then return (Nothing, arr)
1237+ r <- peekAt arrStart arrContents
1238+ return (Just r, MutArray arrContents start1 arrEnd arrBound)
1010-------------------------------------------------------------------------------
1240-------------------------------------------------------------------------------
1011-- Random reads
1241-- Random reads
1012-------------------------------------------------------------------------------
1242-------------------------------------------------------------------------------
@@ -1049,10 +1279,10 @@ getIndexRev i MutArray{..} = do
1049data GetIndicesState contents start end st =
1279data GetIndicesState contents start end st =
1050 GetIndicesState contents start end st
1280 GetIndicesState contents start end st
1052−{-# INLINE getIndicesWith #-}
1282+{-# INLINE indexReaderWith #-}
1053−getIndicesWith :: (Monad m, Unbox a) =>
1283+indexReaderWith :: (Monad m, Unbox a) =>
1054 (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a
1284 (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a
1055−getIndicesWith liftio (D.Stream stepi sti) = Unfold step inject
1285+indexReaderWith liftio (D.Stream stepi sti) = Unfold step inject
@@ -1071,14 +1301,26 @@ getIndicesWith liftio (D.Stream stepi sti) = Unfold step inject
1071 D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)
1301 D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)
1072 D.Stop -> return D.Stop
1302 D.Stop -> return D.Stop
1304+{-# DEPRECATED getIndicesWith "Please use indexReaderWith instead." #-}
1305+{-# INLINE getIndicesWith #-}
1306+getIndicesWith :: (Monad m, Unbox a) =>
1307+ (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a
1308+getIndicesWith = indexReaderWith
1074-- | Given an unfold that generates array indices, read the elements on those
1310-- | Given an unfold that generates array indices, read the elements on those
1075-- indices from the supplied MutArray. An error is thrown if an index is out of
1311-- indices from the supplied MutArray. An error is thrown if an index is out of
1076-- bounds.
1312-- bounds.
1078-- /Pre-release/
1314-- /Pre-release/
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." #-}
1079{-# INLINE getIndices #-}
1321{-# INLINE getIndices #-}
1080getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
1322getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
1081−getIndices = getIndicesWith liftIO
1323+getIndices = indexReader
1083-------------------------------------------------------------------------------
1325-------------------------------------------------------------------------------
1084-- Subarrays
1326-- Subarrays
@@ -1373,7 +1615,7 @@ chunksOfAs ps n (D.Stream step state) =
1374-- Same as the following but may be more efficient:
1616-- Same as the following but may be more efficient:
1376−-- >>> chunksOf n = Stream.foldMany (MutArray.writeN n)
1618+-- >>> chunksOf n = Stream.foldMany (MutArray.createOf n)
1378-- /Pre-release/
1620-- /Pre-release/
1379{-# INLINE_NORMAL chunksOf #-}
1621{-# INLINE_NORMAL chunksOf #-}
@@ -1382,14 +1624,14 @@ chunksOf :: forall m a. (MonadIO m, Unbox a)
1382-- XXX the idiomatic implementation leads to large regression in the D.reverse'
1624-- XXX the idiomatic implementation leads to large regression in the D.reverse'
1383-- benchmark. It seems it has difficulty producing optimized code when
1625-- benchmark. It seems it has difficulty producing optimized code when
1384-- converting to StreamK. Investigate GHC optimizations.
1626-- converting to StreamK. Investigate GHC optimizations.
1385−-- chunksOf n = D.foldMany (writeN n)
1627+-- chunksOf n = D.foldMany (createOf n)
1386chunksOf = chunksOfAs Unpinned
1628chunksOf = chunksOfAs Unpinned
1388-- | Like 'chunksOf' but creates pinned arrays.
1630-- | Like 'chunksOf' but creates pinned arrays.
1389{-# INLINE_NORMAL pinnedChunksOf #-}
1631{-# INLINE_NORMAL pinnedChunksOf #-}
1390pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)
1632pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)
1391 => Int -> D.Stream m a -> D.Stream m (MutArray a)
1633 => Int -> D.Stream m a -> D.Stream m (MutArray a)
1392−-- pinnedChunksOf n = D.foldMany (pinnedWriteN n)
1634+-- pinnedChunksOf n = D.foldMany (pinnedCreateOf n)
1393pinnedChunksOf = chunksOfAs Pinned
1635pinnedChunksOf = chunksOfAs Pinned
1395-- | When we are buffering a stream of unknown size into an array we do not
1637-- | When we are buffering a stream of unknown size into an array we do not
@@ -1422,16 +1664,10 @@ data FlattenState s contents a =
1422 OuterLoop s
1664 OuterLoop s
1423 | InnerLoop s contents !Int !Int
1665 | InnerLoop s contents !Int !Int
1425−-- | Use the "reader" unfold instead.
1427−-- @concatChunks = unfoldMany reader@
1429−-- We can try this if there are any fusion issues in the unfold.
1431−{-# INLINE_NORMAL concatChunks #-}
1667+{-# INLINE_NORMAL concatWith #-}
1432−concatChunks :: forall m a. (MonadIO m, Unbox a)
1668+concatWith :: forall m a. (Monad m, Unbox a)
1433− => D.Stream m (MutArray a) -> D.Stream m a
1669+ => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a
1434−concatChunks (D.Stream step state) = D.Stream step' (OuterLoop state)
1670+concatWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
@@ -1448,24 +1684,30 @@ concatChunks (D.Stream step state) = D.Stream step' (OuterLoop state)
1448 return $ D.Skip $ OuterLoop st
1684 return $ D.Skip $ OuterLoop st
1450 step' _ (InnerLoop st contents p end) = do
1686 step' _ (InnerLoop st contents p end) = do
1451− x <- liftIO $ peekAt p contents
1687+ x <- liftio $ peekAt p contents
1452 return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)
1688 return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)
1454−{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}
1455−flattenArrays :: forall m a. (MonadIO m, Unbox a)
1456− => D.Stream m (MutArray a) -> D.Stream m a
1457−flattenArrays = concatChunks
1459−-- | Use the "readerRev" unfold instead.
1690+-- | Use the "reader" unfold instead.
1461−-- @concatChunks = unfoldMany readerRev@
1692+-- @concat = unfoldMany reader@
1463-- We can try this if there are any fusion issues in the unfold.
1694-- We can try this if there are any fusion issues in the unfold.
1465−{-# INLINE_NORMAL concatChunksRev #-}
1696+{-# INLINE_NORMAL concat #-}
1697+concat :: forall m a. (MonadIO m, Unbox a)
1698+ => D.Stream m (MutArray a) -> D.Stream m a
1699+concat = concatWith liftIO
1701+{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}
1702+{-# INLINE flattenArrays #-}
1466−concatChunksRev :: forall m a. (MonadIO m, Unbox a)
1703+flattenArrays :: forall m a. (MonadIO m, Unbox a)
1467 => D.Stream m (MutArray a) -> D.Stream m a
1704 => D.Stream m (MutArray a) -> D.Stream m a
1705+flattenArrays = concat
1707+{-# INLINE_NORMAL concatRevWith #-}
1708+concatRevWith :: forall m a. (Monad m, Unbox a)
1709+ => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a
1468−concatChunksRev (D.Stream step state) = D.Stream step' (OuterLoop state)
1710+concatRevWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
@@ -1483,14 +1725,26 @@ concatChunksRev (D.Stream step state) = D.Stream step' (OuterLoop state)
1483 return $ D.Skip $ OuterLoop st
1725 return $ D.Skip $ OuterLoop st
1485 step' _ (InnerLoop st contents p start) = do
1727 step' _ (InnerLoop st contents p start) = do
1486− x <- liftIO $ peekAt p contents
1728+ x <- liftio $ peekAt p contents
1487 let cur = INDEX_PREV(p,a)
1729 let cur = INDEX_PREV(p,a)
1488 return $ D.Yield x (InnerLoop st contents cur start)
1730 return $ D.Yield x (InnerLoop st contents cur start)
1732+-- | Use the "readerRev" unfold instead.
1734+-- @concat = unfoldMany readerRev@
1736+-- We can try this if there are any fusion issues in the unfold.
1738+{-# INLINE_NORMAL concatRev #-}
1739+concatRev :: forall m a. (MonadIO m, Unbox a)
1740+ => D.Stream m (MutArray a) -> D.Stream m a
1741+concatRev = concatRevWith liftIO
1490{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}
1743{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}
1744+{-# INLINE flattenArraysRev #-}
1491flattenArraysRev :: forall m a. (MonadIO m, Unbox a)
1745flattenArraysRev :: forall m a. (MonadIO m, Unbox a)
1492 => D.Stream m (MutArray a) -> D.Stream m a
1746 => D.Stream m (MutArray a) -> D.Stream m a
1493−flattenArraysRev = concatChunksRev
1747+flattenArraysRev = concatRev
1495-------------------------------------------------------------------------------
1749-------------------------------------------------------------------------------
1496-- Unfolds
1750-- Unfolds
@@ -1719,7 +1973,7 @@ foldr f z arr = D.foldr f z $ read arr
1720-- XXX Keep the bound intact to not lose any free space? Perf impact?
1974-- XXX Keep the bound intact to not lose any free space? Perf impact?
1722−-- | @writeAppendNUnsafe n arr@ appends up to @n@ input items to the supplied
1976+-- | @unsafeAppendN n arr@ appends up to @n@ input items to the supplied
1723-- array.
1977-- array.
1725-- Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory
1979-- Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory
@@ -1728,13 +1982,12 @@ foldr f z arr = D.foldr f z $ read arr
1728-- Any free space left in the array after appending @n@ elements is lost.
1982-- Any free space left in the array after appending @n@ elements is lost.
1730-- /Internal/
1984-- /Internal/
1731−{-# INLINE_NORMAL writeAppendNUnsafe #-}
1985+{-# INLINE_NORMAL unsafeAppendN #-}
1732−writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>
1986+unsafeAppendN :: forall m a. (MonadIO m, Unbox a) =>
1734 -> m (MutArray a)
1988 -> m (MutArray a)
1735 -> Fold m a (MutArray a)
1989 -> Fold m a (MutArray a)
1736−writeAppendNUnsafe n action =
1737− fmap fromArrayUnsafe $ FL.foldlM' step initial
1990+unsafeAppendN n action = fmap fromArrayUnsafe $ FL.foldlM' step initial
@@ -1747,7 +2000,7 @@ writeAppendNUnsafe n action =
1747 -- otherwise we lose that space.
2000 -- otherwise we lose that space.
1749 if free < needed
2002 if free < needed
1750− then noinline reallocWith "writeAppendNUnsafeWith" (+ needed) needed arr
2003+ then noinline reallocWith "unsafeAppendN" (+ needed) needed arr
1751 else return arr
2004 else return arr
1752 return $ toArrayUnsafe arr1
2005 return $ toArrayUnsafe arr1
@@ -1755,30 +2008,51 @@ writeAppendNUnsafe n action =
1755 liftIO $ pokeAt end contents x
2008 liftIO $ pokeAt end contents x
1756 return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
2009 return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
2011+{-# DEPRECATED writeAppendNUnsafe "Please use unsafeAppendN instead." #-}
2012+{-# INLINE writeAppendNUnsafe #-}
2013+writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>
2016+ -> Fold m a (MutArray a)
2017+writeAppendNUnsafe = unsafeAppendN
1758-- | Append @n@ elements to an existing array. Any free space left in the array
2019-- | Append @n@ elements to an existing array. Any free space left in the array
1759-- after appending @n@ elements is lost.
2020-- after appending @n@ elements is lost.
1761−-- >>> writeAppendN n initial = Fold.take n (MutArray.writeAppendNUnsafe n initial)
2022+-- >>> appendN n initial = Fold.take n (MutArray.unsafeAppendN n initial)
1763−{-# INLINE_NORMAL writeAppendN #-}
2024+{-# INLINE_NORMAL appendN #-}
2025+appendN :: forall m a. (MonadIO m, Unbox a) =>
2026+ Int -> m (MutArray a) -> Fold m a (MutArray a)
2027+appendN n initial = FL.take n (unsafeAppendN n initial)
2029+-- XXX Deprecate in major
2030+-- {-# DEPRECATED writeAppendN "Please use appendN instead." #-}
2031+{-# INLINE writeAppendN #-}
1764writeAppendN :: forall m a. (MonadIO m, Unbox a) =>
2032writeAppendN :: forall m a. (MonadIO m, Unbox a) =>
1765 Int -> m (MutArray a) -> Fold m a (MutArray a)
2033 Int -> m (MutArray a) -> Fold m a (MutArray a)
1766−writeAppendN n initial = FL.take n (writeAppendNUnsafe n initial)
2034+writeAppendN = appendN
1768−-- | @writeAppendWith realloc action@ mutates the array generated by @action@ to
2036+-- | @appendWith realloc action@ mutates the array generated by @action@ to
1769-- append the input stream. If there is no reserved space available in the
2037-- append the input stream. If there is no reserved space available in the
1770-- array it is reallocated to a size in bytes determined by @realloc oldSize@,
2038-- array it is reallocated to a size in bytes determined by @realloc oldSize@,
1771-- where @oldSize@ is the current size of the array in bytes.
2039-- where @oldSize@ is the current size of the array in bytes.
1773-- Note that the returned array may be a mutated version of original array.
2041-- Note that the returned array may be a mutated version of original array.
1775−-- >>> writeAppendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)
2043+-- >>> appendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)
1777-- /Pre-release/
2045-- /Pre-release/
2046+{-# INLINE appendWith #-}
2047+appendWith :: forall m a. (MonadIO m, Unbox a) =>
2048+ (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
2049+appendWith sizer = FL.foldlM' (snocWith sizer)
2051+{-# DEPRECATED writeAppendWith "Please use appendWith instead." #-}
1778{-# INLINE writeAppendWith #-}
2052{-# INLINE writeAppendWith #-}
1779writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
2053writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
1780 (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
2054 (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
1781−writeAppendWith sizer = FL.foldlM' (snocWith sizer)
2055+writeAppendWith = appendWith
1783-- | @append action@ mutates the array generated by @action@ to append the
2057-- | @append action@ mutates the array generated by @action@ to append the
1784-- input stream. If there is no reserved space available in the array it is
2058-- input stream. If there is no reserved space available in the array it is
@@ -1786,26 +2060,33 @@ writeAppendWith sizer = FL.foldlM' (snocWith sizer)
1787-- Note that the returned array may be a mutated version of original array.
2061-- Note that the returned array may be a mutated version of original array.
1789−-- >>> writeAppend = MutArray.writeAppendWith (* 2)
2063+-- >>> append = MutArray.appendWith (* 2)
2065+{-# INLINE append #-}
2066+append :: forall m a. (MonadIO m, Unbox a) =>
2067+ m (MutArray a) -> Fold m a (MutArray a)
2068+append = appendWith (* 2)
2070+-- XXX Deprecate in major
2071+-- {-# DEPRECATED writeAppend "Please use append instead." #-}
1791{-# INLINE writeAppend #-}
2072{-# INLINE writeAppend #-}
1792writeAppend :: forall m a. (MonadIO m, Unbox a) =>
2073writeAppend :: forall m a. (MonadIO m, Unbox a) =>
1793 m (MutArray a) -> Fold m a (MutArray a)
2074 m (MutArray a) -> Fold m a (MutArray a)
1794−writeAppend = writeAppendWith (* 2)
2075+writeAppend = append
1796-- XXX We can carry bound as well in the state to make sure we do not lose the
2077-- XXX We can carry bound as well in the state to make sure we do not lose the
1797-- remaining capacity. Need to check perf impact.
2078-- remaining capacity. Need to check perf impact.
1799−-- | Like 'writeNUnsafe' but takes a new array allocator @alloc size@ function
2080+-- | Like 'unsafeCreateOf' but takes a new array allocator @alloc size@
1800−-- as argument.
2081+-- function as argument.
1802−-- >>> writeNWithUnsafe alloc n = MutArray.writeAppendNUnsafe (alloc n) n
2083+-- >>> unsafeCreateOfWith alloc n = MutArray.unsafeAppendN (alloc n) n
1804-- /Pre-release/
2085-- /Pre-release/
1805−{-# INLINE_NORMAL writeNWithUnsafe #-}
2086+{-# INLINE_NORMAL unsafeCreateOfWith #-}
1806−writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)
2087+unsafeCreateOfWith :: forall m a. (MonadIO m, Unbox a)
1807 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2088 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1808−writeNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
2089+unsafeCreateOfWith alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
@@ -1816,40 +2097,64 @@ writeNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
1817 $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
2098 $ ArrayUnsafe contents start (INDEX_NEXT(end,a))
2100+{-# DEPRECATED writeNWithUnsafe "Please use unsafeCreateOfWith instead." #-}
2101+{-# INLINE writeNWithUnsafe #-}
2102+writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)
2103+ => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2104+writeNWithUnsafe = unsafeCreateOfWith
1819{-# INLINE_NORMAL writeNUnsafeAs #-}
2106{-# INLINE_NORMAL writeNUnsafeAs #-}
1820writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)
2107writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)
1821 => PinnedState -> Int -> Fold m a (MutArray a)
2108 => PinnedState -> Int -> Fold m a (MutArray a)
1822−writeNUnsafeAs ps = writeNWithUnsafe (newAs ps)
2109+writeNUnsafeAs ps = unsafeCreateOfWith (newAs ps)
1824−-- | Like 'writeN' but does not check the array bounds when writing. The fold
2111+-- | Like 'createOf' but does not check the array bounds when writing. The fold
1825-- driver must not call the step function more than 'n' times otherwise it will
2112-- driver must not call the step function more than 'n' times otherwise it will
1826-- corrupt the memory and crash. This function exists mainly because any
2113-- corrupt the memory and crash. This function exists mainly because any
1827-- conditional in the step function blocks fusion causing 10x performance
2114-- conditional in the step function blocks fusion causing 10x performance
1828-- slowdown.
2115-- slowdown.
1830−-- >>> writeNUnsafe = MutArray.writeNWithUnsafe MutArray.new
2117+-- >>> unsafeCreateOf = MutArray.unsafeCreateOfWith MutArray.emptyOf
2119+{-# INLINE_NORMAL unsafeCreateOf #-}
2120+unsafeCreateOf :: forall m a. (MonadIO m, Unbox a)
2121+ => Int -> Fold m a (MutArray a)
2122+unsafeCreateOf = writeNUnsafeAs Unpinned
2124+{-# DEPRECATED writeNUnsafe "Please use unsafeCreateOf instead." #-}
1832−{-# INLINE_NORMAL writeNUnsafe #-}
2125+{-# INLINE writeNUnsafe #-}
1833writeNUnsafe :: forall m a. (MonadIO m, Unbox a)
2126writeNUnsafe :: forall m a. (MonadIO m, Unbox a)
1834 => Int -> Fold m a (MutArray a)
2127 => Int -> Fold m a (MutArray a)
1835−writeNUnsafe = writeNUnsafeAs Unpinned
2128+writeNUnsafe = unsafeCreateOf
2130+-- | Like 'unsafeCreateOf' but creates a pinned array.
2131+{-# INLINE_NORMAL unsafePinnedCreateOf #-}
2132+unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a)
2133+ => Int -> Fold m a (MutArray a)
2134+unsafePinnedCreateOf = writeNUnsafeAs Pinned
1837−-- | Like 'writeNUnsafe' but creates a pinned array.
2136+{-# DEPRECATED pinnedWriteNUnsafe "Please use unsafePinnedCreateOf instead." #-}
1838−{-# INLINE_NORMAL pinnedWriteNUnsafe #-}
2137+{-# INLINE pinnedWriteNUnsafe #-}
1839pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)
2138pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)
1840 => Int -> Fold m a (MutArray a)
2139 => Int -> Fold m a (MutArray a)
1841−pinnedWriteNUnsafe = writeNUnsafeAs Pinned
2140+pinnedWriteNUnsafe = unsafePinnedCreateOf
1843−-- | @writeNWith alloc n@ folds a maximum of @n@ elements into an array
2142+-- | @createOfWith alloc n@ folds a maximum of @n@ elements into an array
1844-- allocated using the @alloc@ function.
2143-- allocated using the @alloc@ function.
1846−-- >>> writeNWith alloc n = Fold.take n (MutArray.writeNWithUnsafe alloc n)
2145+-- >>> createOfWith alloc n = Fold.take n (MutArray.unsafeCreateOfWith alloc n)
1847−-- >>> writeNWith alloc n = MutArray.writeAppendN (alloc n) n
2146+-- >>> createOfWith alloc n = MutArray.appendN (alloc n) n
1849−{-# INLINE_NORMAL writeNWith #-}
2148+{-# INLINE_NORMAL createOfWith #-}
2149+createOfWith :: forall m a. (MonadIO m, Unbox a)
2150+ => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2151+createOfWith alloc n = FL.take n (unsafeCreateOfWith alloc n)
2153+-- {-# DEPRECATED writeNWith "Please use createOfWith instead." #-}
2154+{-# INLINE writeNWith #-}
1850writeNWith :: forall m a. (MonadIO m, Unbox a)
2155writeNWith :: forall m a. (MonadIO m, Unbox a)
1851 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2156 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1852−writeNWith alloc n = FL.take n (writeNWithUnsafe alloc n)
2157+writeNWith = createOfWith
1854{-# INLINE_NORMAL writeNAs #-}
2159{-# INLINE_NORMAL writeNAs #-}
1855writeNAs ::
2160writeNAs ::
@@ -1857,28 +2162,42 @@ writeNAs ::
1857 => PinnedState
2162 => PinnedState
1859 -> Fold m a (MutArray a)
2164 -> Fold m a (MutArray a)
1860−writeNAs ps = writeNWith (newAs ps)
2165+writeNAs ps = createOfWith (newAs ps)
1862−-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an
2167+-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an
1863-- 'MutArray'.
2168-- 'MutArray'.
1865−-- >>> writeN = MutArray.writeNWith MutArray.new
2170+-- >>> createOf = MutArray.createOfWith MutArray.new
1866−-- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)
2171+-- >>> createOf n = Fold.take n (MutArray.unsafeCreateOf n)
1867−-- >>> writeN n = MutArray.writeAppendN n (MutArray.new n)
2172+-- >>> createOf n = MutArray.appendN n (MutArray.emptyOf n)
1869−{-# INLINE_NORMAL writeN #-}
2174+{-# INLINE_NORMAL createOf #-}
2175+createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2176+createOf = writeNAs Unpinned
2178+-- XXX Deprecate in major
2179+-- {-# DEPRECATED writeN "Please use createOf instead." #-}
2180+{-# INLINE writeN #-}
1870writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2181writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
1871−writeN = writeNAs Unpinned
2182+writeN = createOf
2184+-- | Like 'createOf' but creates a pinned array.
2185+{-# INLINE_NORMAL pinnedCreateOf #-}
2187+ forall m a. (MonadIO m, Unbox a)
2189+ -> Fold m a (MutArray a)
2190+pinnedCreateOf = writeNAs Pinned
1873−-- | Like 'writeN' but creates a pinned array.
2192+{-# DEPRECATED pinnedWriteN "Please use pinnedCreateOf instead." #-}
1874−{-# INLINE_NORMAL pinnedWriteN #-}
2193+{-# INLINE pinnedWriteN #-}
1875pinnedWriteN ::
2194pinnedWriteN ::
1876 forall m a. (MonadIO m, Unbox a)
2195 forall m a. (MonadIO m, Unbox a)
1878 -> Fold m a (MutArray a)
2197 -> Fold m a (MutArray a)
1879−pinnedWriteN = writeNAs Pinned
2198+pinnedWriteN = pinnedCreateOf
1881−-- | Like writeNWithUnsafe but writes the array in reverse order.
2200+-- | Like unsafeCreateOfWith but writes the array in reverse order.
1883-- /Internal/
2202-- /Internal/
1884{-# INLINE_NORMAL writeRevNWithUnsafe #-}
2203{-# INLINE_NORMAL writeRevNWithUnsafe #-}
@@ -1899,7 +2218,7 @@ writeRevNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial
1900 $ ArrayUnsafe contents ptr end
2219 $ ArrayUnsafe contents ptr end
1902−-- | Like writeNWith but writes the array in reverse order.
2221+-- | Like createOfWith but writes the array in reverse order.
1904-- /Internal/
2223-- /Internal/
1905{-# INLINE_NORMAL writeRevNWith #-}
2224{-# INLINE_NORMAL writeRevNWith #-}
@@ -1907,31 +2226,36 @@ writeRevNWith :: forall m a. (MonadIO m, Unbox a)
1907 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
2226 => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
1908writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)
2227writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)
1910−-- | Like writeN but writes the array in reverse order.
2229+-- | Like 'createOf' but writes the array in reverse order.
1912-- /Pre-release/
2231-- /Pre-release/
1913−{-# INLINE_NORMAL writeRevN #-}
2232+{-# INLINE_NORMAL revCreateOf #-}
2233+revCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2234+revCreateOf = writeRevNWith new
2236+{-# DEPRECATED writeRevN "Please use revCreateOf instead." #-}
2237+{-# INLINE writeRevN #-}
1914writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
2238writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
1915−writeRevN = writeRevNWith new
2239+writeRevN = revCreateOf
1917-- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the
2241-- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the
1918-- input stream to a 'MutArray' aligned to the given size.
2242-- input stream to a 'MutArray' aligned to the given size.
1920−-- >>> pinnedWriteNAligned align = MutArray.writeNWith (MutArray.pinnedNewAligned align)
2244+-- >>> pinnedWriteNAligned align = MutArray.createOfWith (MutArray.pinnedNewAligned align)
1921−-- >>> pinnedWriteNAligned align n = MutArray.writeAppendN n (MutArray.pinnedNewAligned align n)
2245+-- >>> pinnedWriteNAligned align n = MutArray.appendN n (MutArray.pinnedNewAligned align n)
1923-- /Pre-release/
2247-- /Pre-release/
1925{-# INLINE_NORMAL pinnedWriteNAligned #-}
2249{-# INLINE_NORMAL pinnedWriteNAligned #-}
1926pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)
2250pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)
1927 => Int -> Int -> Fold m a (MutArray a)
2251 => Int -> Int -> Fold m a (MutArray a)
1928−pinnedWriteNAligned align = writeNWith (pinnedNewAligned align)
2252+pinnedWriteNAligned align = createOfWith (pinnedNewAligned align)
1930-- XXX Buffer to a list instead?
2254-- XXX Buffer to a list instead?
1932-- | Buffer a stream into a stream of arrays.
2256-- | Buffer a stream into a stream of arrays.
1934−-- >>> buildChunks n = Fold.many (MutArray.writeN n) Fold.toStreamK
2258+-- >>> buildChunks n = Fold.many (MutArray.createOf n) Fold.toStreamK
1936-- Breaking an array into an array stream can be useful to consume a large
2260-- Breaking an array into an array stream can be useful to consume a large
1937-- array sequentially such that memory of the array is released incrementatlly.
2261-- array sequentially such that memory of the array is released incrementatlly.
@@ -1943,9 +2267,10 @@ pinnedWriteNAligned align = writeNWith (pinnedNewAligned align)
1943{-# INLINE_NORMAL buildChunks #-}
2267{-# INLINE_NORMAL buildChunks #-}
1944buildChunks :: (MonadIO m, Unbox a) =>
2268buildChunks :: (MonadIO m, Unbox a) =>
1945 Int -> Fold m a (StreamK n (MutArray a))
2269 Int -> Fold m a (StreamK n (MutArray a))
1946−buildChunks n = FL.many (writeN n) FL.toStreamK
2270+buildChunks n = FL.many (createOf n) FL.toStreamK
1948{-# DEPRECATED writeChunks "Please use buildChunks instead." #-}
2272{-# DEPRECATED writeChunks "Please use buildChunks instead." #-}
2273+{-# INLINE writeChunks #-}
1949writeChunks :: (MonadIO m, Unbox a) =>
2274writeChunks :: (MonadIO m, Unbox a) =>
1950 Int -> Fold m a (StreamK n (MutArray a))
2275 Int -> Fold m a (StreamK n (MutArray a))
1951writeChunks = buildChunks
2276writeChunks = buildChunks
@@ -1953,29 +2278,29 @@ writeChunks = buildChunks
1953{-# INLINE_NORMAL writeWithAs #-}
2278{-# INLINE_NORMAL writeWithAs #-}
1954writeWithAs :: forall m a. (MonadIO m, Unbox a)
2279writeWithAs :: forall m a. (MonadIO m, Unbox a)
1955 => PinnedState -> Int -> Fold m a (MutArray a)
2280 => PinnedState -> Int -> Fold m a (MutArray a)
1956−-- writeWithAs ps n = FL.rmapM rightSize $ writeAppendWith (* 2) (newAs ps n)
2281+-- writeWithAs ps n = FL.rmapM rightSize $ appendWith (* 2) (newAs ps n)
1957writeWithAs ps elemCount =
2282writeWithAs ps elemCount =
1958 FL.rmapM extract $ FL.foldlM' step initial
2283 FL.rmapM extract $ FL.foldlM' step initial
1962 initial = do
2287 initial = do
1963− when (elemCount < 0) $ error "writeWith: elemCount is negative"
2288+ when (elemCount < 0) $ error "createWith: elemCount is negative"
1964− liftIO $ newAs ps elemCount
2289+ newAs ps elemCount
1966 step arr@(MutArray _ start end bound) x
2291 step arr@(MutArray _ start end bound) x
1967 | INDEX_NEXT(end,a) > bound = do
2292 | INDEX_NEXT(end,a) > bound = do
1968 let oldSize = end - start
2293 let oldSize = end - start
1969 newSize = max (oldSize * 2) 1
2294 newSize = max (oldSize * 2) 1
1970− arr1 <- liftIO $ reallocExplicit (SIZE_OF(a)) newSize arr
2295+ arr1 <- liftIO $ reallocExplicitAs ps (SIZE_OF(a)) newSize arr
1971 snocUnsafe arr1 x
2296 snocUnsafe arr1 x
1972 step arr x = snocUnsafe arr x
2297 step arr x = snocUnsafe arr x
1974 extract = liftIO . rightSize
2299 extract = liftIO . rightSize
1976−-- XXX Compare writeWith with fromStreamD which uses an array of streams
2301+-- XXX Compare createWith with fromStreamD which uses an array of streams
1977-- implementation. We can write this using buildChunks above if that is faster.
2302-- implementation. We can write this using buildChunks above if that is faster.
1978−-- If writeWith is faster then we should use that to implement
2303+-- If createWith is faster then we should use that to implement
1979-- fromStreamD.
2304-- fromStreamD.
1981-- XXX The realloc based implementation needs to make one extra copy if we use
2306-- XXX The realloc based implementation needs to make one extra copy if we use
@@ -1990,39 +2315,56 @@ writeWithAs ps elemCount =
1990-- XXX check if GHC's memory allocator is efficient enough. We can try the C
2315-- XXX check if GHC's memory allocator is efficient enough. We can try the C
1991-- malloc to compare against.
2316-- malloc to compare against.
1993−-- | @writeWith minCount@ folds the whole input to a single array. The array
2318+-- | @createWith minCount@ folds the whole input to a single array. The array
1994-- starts at a size big enough to hold minCount elements, the size is doubled
2319-- starts at a size big enough to hold minCount elements, the size is doubled
1995-- every time the array needs to be grown.
2320-- every time the array needs to be grown.
1997-- /Caution! Do not use this on infinite streams./
2322-- /Caution! Do not use this on infinite streams./
1999−-- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.new n)
2324+-- >>> f n = MutArray.appendWith (* 2) (MutArray.emptyOf n)
2000−-- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)
2325+-- >>> createWith n = Fold.rmapM MutArray.rightSize (f n)
2001−-- >>> writeWith n = Fold.rmapM MutArray.fromChunksK (MutArray.buildChunks n)
2326+-- >>> createWith n = Fold.rmapM MutArray.fromChunksK (MutArray.buildChunks n)
2003-- /Pre-release/
2328-- /Pre-release/
2004−{-# INLINE_NORMAL writeWith #-}
2329+{-# INLINE_NORMAL createWith #-}
2330+createWith :: forall m a. (MonadIO m, Unbox a)
2331+ => Int -> Fold m a (MutArray a)
2332+-- createWith n = FL.rmapM rightSize $ appendWith (* 2) (emptyOf n)
2333+createWith = writeWithAs Unpinned
2335+{-# DEPRECATED writeWith "Please use createWith instead." #-}
2336+{-# INLINE writeWith #-}
2005writeWith :: forall m a. (MonadIO m, Unbox a)
2337writeWith :: forall m a. (MonadIO m, Unbox a)
2006 => Int -> Fold m a (MutArray a)
2338 => Int -> Fold m a (MutArray a)
2007−-- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (new n)
2339+writeWith = createWith
2008−writeWith = writeWithAs Unpinned
2010-- | Fold the whole input to a single array.
2341-- | Fold the whole input to a single array.
2012−-- Same as 'writeWith' using an initial array size of 'arrayChunkBytes' bytes
2343+-- Same as 'createWith' using an initial array size of 'arrayChunkBytes' bytes
2013-- rounded up to the element size.
2344-- rounded up to the element size.
2015-- /Caution! Do not use this on infinite streams./
2346-- /Caution! Do not use this on infinite streams./
2348+{-# INLINE create #-}
2349+create :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2350+create = createWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
2352+-- XXX Deprecate in major
2353+-- {-# DEPRECATED write "Please use create instead." #-}
2017{-# INLINE write #-}
2354{-# INLINE write #-}
2018write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2355write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2019−write = writeWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
2356+write = create
2021−-- | Like 'write' but creates a pinned array.
2358+-- | Like 'create' but creates a pinned array.
2359+{-# INLINE pinnedCreate #-}
2360+pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2362+ writeWithAs Pinned (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
2364+{-# DEPRECATED pinnedWrite "Please use pinnedCreate instead." #-}
2022{-# INLINE pinnedWrite #-}
2365{-# INLINE pinnedWrite #-}
2023pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2366pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
2024−pinnedWrite =
2367+pinnedWrite = pinnedCreate
2025− writeWithAs Pinned (allocBytesToElemCount (undefined :: a) arrayChunkBytes)
2027-------------------------------------------------------------------------------
2369-------------------------------------------------------------------------------
2028-- construct from streams, known size
2370-- construct from streams, known size
@@ -2032,7 +2374,7 @@ pinnedWrite =
2032fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)
2374fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)
2033 => PinnedState -> Int -> D.Stream m a -> m (MutArray a)
2375 => PinnedState -> Int -> D.Stream m a -> m (MutArray a)
2034fromStreamDNAs ps limit str = do
2376fromStreamDNAs ps limit str = do
2035− (arr :: MutArray a) <- liftIO $ newAs ps limit
2377+ (arr :: MutArray a) <- newAs ps limit
2036 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str
2378 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str
2037 return $ arr {arrEnd = end}
2379 return $ arr {arrEnd = end}
@@ -2042,17 +2384,18 @@ fromStreamDNAs ps limit str = do
2042 liftIO $ pokeAt ptr arrContents x
2384 liftIO $ pokeAt ptr arrContents x
2043 return $ INDEX_NEXT(ptr,a)
2385 return $ INDEX_NEXT(ptr,a)
2045−-- | Use the 'writeN' fold instead.
2387+-- | Use the 'createOf' fold instead.
2047−-- >>> fromStreamN n = Stream.fold (MutArray.writeN n)
2389+-- >>> fromStreamN n = Stream.fold (MutArray.createOf n)
2049{-# INLINE_NORMAL fromStreamN #-}
2391{-# INLINE_NORMAL fromStreamN #-}
2050fromStreamN :: forall m a. (MonadIO m, Unbox a)
2392fromStreamN :: forall m a. (MonadIO m, Unbox a)
2051 => Int -> D.Stream m a -> m (MutArray a)
2393 => Int -> D.Stream m a -> m (MutArray a)
2052−-- fromStreamDN n = D.fold (writeN n)
2394+-- fromStreamDN n = D.fold (createOf n)
2053fromStreamN = fromStreamDNAs Unpinned
2395fromStreamN = fromStreamDNAs Unpinned
2055{-# DEPRECATED fromStreamDN "Please use fromStreamN instead." #-}
2397{-# DEPRECATED fromStreamDN "Please use fromStreamN instead." #-}
2398+{-# INLINE fromStreamDN #-}
2056fromStreamDN :: forall m a. (MonadIO m, Unbox a)
2399fromStreamDN :: forall m a. (MonadIO m, Unbox a)
2057 => Int -> D.Stream m a -> m (MutArray a)
2400 => Int -> D.Stream m a -> m (MutArray a)
2058fromStreamDN = fromStreamN
2401fromStreamDN = fromStreamN
@@ -2075,20 +2418,20 @@ pinnedFromListN n xs = fromStreamDNAs Pinned n $ D.fromList xs
2075-- /Pre-release/
2418-- /Pre-release/
2076{-# INLINE fromListRevN #-}
2419{-# INLINE fromListRevN #-}
2077fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
2420fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
2078−fromListRevN n xs = D.fold (writeRevN n) $ D.fromList xs
2421+fromListRevN n xs = D.fold (revCreateOf n) $ D.fromList xs
2080-- | Convert a pure stream in Identity monad to a mutable array.
2423-- | Convert a pure stream in Identity monad to a mutable array.
2081{-# INLINABLE fromPureStreamN #-}
2424{-# INLINABLE fromPureStreamN #-}
2082fromPureStreamN :: (MonadIO m, Unbox a) =>
2425fromPureStreamN :: (MonadIO m, Unbox a) =>
2083 Int -> Stream Identity a -> m (MutArray a)
2426 Int -> Stream Identity a -> m (MutArray a)
2084fromPureStreamN n xs =
2427fromPureStreamN n xs =
2085− liftIO $ D.fold (writeN n) $ D.morphInner (return . runIdentity) xs
2428+ D.fold (createOf n) $ D.morphInner (return . runIdentity) xs
2087-- | Convert a pure stream in Identity monad to a mutable array.
2430-- | Convert a pure stream in Identity monad to a mutable array.
2088{-# INLINABLE fromPureStream #-}
2431{-# INLINABLE fromPureStream #-}
2089fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)
2432fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)
2090fromPureStream xs =
2433fromPureStream xs =
2091− liftIO $ D.fold write $ D.morphInner (return . runIdentity) xs
2434+ D.fold create $ D.morphInner (return . runIdentity) xs
2093{-# INLINABLE fromPtrN #-}
2436{-# INLINABLE fromPtrN #-}
2094fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)
2437fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)
@@ -2097,7 +2440,7 @@ fromPtrN len addr = do
2097 -- XXX We can implement a stream copy in a similar way by streaming Word64
2440 -- XXX We can implement a stream copy in a similar way by streaming Word64
2098 -- first and then remaining Word8.
2441 -- first and then remaining Word8.
2099 arr <- new len
2442 arr <- new len
2100− _ <- asUnpinnedPtrUnsafe arr
2443+ _ <- unsafeAsPtr arr
2101 (\ptr -> liftIO $ c_memcpy ptr addr (fromIntegral len))
2444 (\ptr -> liftIO $ c_memcpy ptr addr (fromIntegral len))
2102 return (arr {arrEnd = len})
2445 return (arr {arrEnd = len})
@@ -2113,7 +2456,7 @@ fromByteStr# addr = do
2113 len <- liftIO $ c_strlen (Ptr addr)
2456 len <- liftIO $ c_strlen (Ptr addr)
2114 let lenInt = fromIntegral len
2457 let lenInt = fromIntegral len
2115 arr <- new lenInt
2458 arr <- new lenInt
2116− _ <- asUnpinnedPtrUnsafe arr (\ptr -> liftIO $ c_memcpy ptr (Ptr addr) len)
2459+ _ <- unsafeAsPtr arr (\ptr -> liftIO $ c_memcpy ptr (Ptr addr) len)
2117 return (arr {arrEnd = lenInt})
2460 return (arr {arrEnd = lenInt})
2119-------------------------------------------------------------------------------
2462-------------------------------------------------------------------------------
@@ -2134,7 +2477,7 @@ fromChunksRealloced s = do
2134 arr <- D.foldlM' spliceExp (pure a) strm
2477 arr <- D.foldlM' spliceExp (pure a) strm
2135 -- Reallocation is exponential so there may be 50% empty space in
2478 -- Reallocation is exponential so there may be 50% empty space in
2136 -- worst case. One more reallocation to reclaim the space.
2479 -- worst case. One more reallocation to reclaim the space.
2137− liftIO $ rightSize arr
2480+ rightSize arr
2138 Nothing -> pure nil
2481 Nothing -> pure nil
2140-------------------------------------------------------------------------------
2483-------------------------------------------------------------------------------
@@ -2172,6 +2515,7 @@ fromChunksK :: (Unbox a, MonadIO m) =>
2172fromChunksK = fromChunkskAs Unpinned
2515fromChunksK = fromChunkskAs Unpinned
2174{-# DEPRECATED fromArrayStreamK "Please use fromChunksK instead." #-}
2517{-# DEPRECATED fromArrayStreamK "Please use fromChunksK instead." #-}
2518+{-# INLINE fromArrayStreamK #-}
2175fromArrayStreamK :: (Unbox a, MonadIO m) =>
2519fromArrayStreamK :: (Unbox a, MonadIO m) =>
2176 StreamK m (MutArray a) -> m (MutArray a)
2520 StreamK m (MutArray a) -> m (MutArray a)
2177fromArrayStreamK = fromChunksK
2521fromArrayStreamK = fromChunksK
@@ -2183,7 +2527,7 @@ fromStreamDAs ps m =
2183 arrayStreamKFromStreamDAs Unpinned m >>= fromChunkskAs ps
2527 arrayStreamKFromStreamDAs Unpinned m >>= fromChunkskAs ps
2185-- | Create an 'Array' from a stream. This is useful when we want to create a
2529-- | Create an 'Array' from a stream. This is useful when we want to create a
2186−-- single array from a stream of unknown size. 'writeN' is at least twice
2530+-- single array from a stream of unknown size. 'createOf' is at least twice
2187-- as efficient when the size is already known.
2531-- as efficient when the size is already known.
2189-- Note that if the input stream is too large memory allocation for the array
2533-- Note that if the input stream is too large memory allocation for the array
@@ -2195,19 +2539,19 @@ fromStreamDAs ps m =
2195fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)
2539fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)
2196fromStream = fromStreamDAs Unpinned
2540fromStream = fromStreamDAs Unpinned
2198−-- fromStream (Stream m) = P.fold write m
2542+-- fromStream (Stream m) = P.fold create m
2199-- CAUTION: a very large number (millions) of arrays can degrade performance
2543-- CAUTION: a very large number (millions) of arrays can degrade performance
2200-- due to GC overhead because we need to buffer the arrays before we flatten
2544-- due to GC overhead because we need to buffer the arrays before we flatten
2201-- all the arrays.
2545-- all the arrays.
2203−-- XXX Compare if this is faster or "fold write".
2547+-- XXX Compare if this is faster or "fold create".
2205-- | We could take the approach of doubling the memory allocation on each
2549-- | We could take the approach of doubling the memory allocation on each
2206-- overflow. This would result in more or less the same amount of copying as in
2550-- overflow. This would result in more or less the same amount of copying as in
2207-- the chunking approach. However, if we have to shrink in the end then it may
2551-- the chunking approach. However, if we have to shrink in the end then it may
2208-- result in an extra copy of the entire data.
2552-- result in an extra copy of the entire data.
2210−-- >>> fromStreamD = StreamD.fold MutArray.write
2554+-- >>> fromStreamD = StreamD.fold MutArray.create
2212{-# INLINE fromStreamD #-}
2556{-# INLINE fromStreamD #-}
2213{-# DEPRECATED fromStreamD "Please use fromStream instead." #-}
2557{-# DEPRECATED fromStreamD "Please use fromStream instead." #-}
@@ -2237,6 +2581,10 @@ fromListRev xs = fromListRevN (Prelude.length xs) xs
2237-- Cloning
2581-- Cloning
2238-------------------------------------------------------------------------------
2582-------------------------------------------------------------------------------
2584+-- Arrays are aligned on 64-bit boundaries. The fastest way to copy an array is
2585+-- to unsafeCast it to Word64, read it, write it to Word64 array and unsafeCast
2586+-- it again. We can use SIMD read/write as well.
2240{-# INLINE cloneAs #-}
2588{-# INLINE cloneAs #-}
2241cloneAs ::
2589cloneAs ::
2242 ( MonadIO m
2590 ( MonadIO m
@@ -2246,7 +2594,7 @@ cloneAs ::
2247 => PinnedState -> MutArray a -> m (MutArray a)
2595 => PinnedState -> MutArray a -> m (MutArray a)
2248cloneAs ps src =
2596cloneAs ps src =
2249− liftIO $ do
2597+ do
2250 let startSrc = arrStart src
2598 let startSrc = arrStart src
2251 srcLen = arrEnd src - startSrc
2599 srcLen = arrEnd src - startSrc
2252 newArrContents <-
2600 newArrContents <-
@@ -2285,17 +2633,16 @@ spliceCopy :: forall m a. MonadIO m =>
2285 Unbox a =>
2633 Unbox a =>
2287 MutArray a -> MutArray a -> m (MutArray a)
2635 MutArray a -> MutArray a -> m (MutArray a)
2288−spliceCopy arr1 arr2 = liftIO $ do
2636+spliceCopy arr1 arr2 = do
2289 let start1 = arrStart arr1
2637 let start1 = arrStart arr1
2290 start2 = arrStart arr2
2638 start2 = arrStart arr2
2291 len1 = arrEnd arr1 - start1
2639 len1 = arrEnd arr1 - start1
2292 len2 = arrEnd arr2 - start2
2640 len2 = arrEnd arr2 - start2
2293− let newLen = len1 + len2
2641+ let len = len1 + len2
2294 newArrContents <-
2642 newArrContents <-
2295 if Unboxed.isPinned (arrContents arr1)
2643 if Unboxed.isPinned (arrContents arr1)
2296− then Unboxed.pinnedNew newLen
2644+ then liftIO $ Unboxed.pinnedNew len
2297− else Unboxed.new newLen
2645+ else liftIO $ Unboxed.new len
2298− let len = len1 + len2
2299 putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1
2646 putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1
2300 putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2
2647 putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2
2301 return $ MutArray newArrContents 0 len len
2648 return $ MutArray newArrContents 0 len len
@@ -2307,7 +2654,7 @@ spliceCopy arr1 arr2 = liftIO $ do
2307spliceUnsafe :: MonadIO m =>
2654spliceUnsafe :: MonadIO m =>
2308 MutArray a -> MutArray a -> m (MutArray a)
2655 MutArray a -> MutArray a -> m (MutArray a)
2309spliceUnsafe dst src =
2656spliceUnsafe dst src =
2310− liftIO $ do
2657+ do
2311 let startSrc = arrStart src
2658 let startSrc = arrStart src
2312 srcLen = arrEnd src - startSrc
2659 srcLen = arrEnd src - startSrc
2313 endDst = arrEnd dst
2660 endDst = arrEnd dst
@@ -2329,7 +2676,7 @@ spliceWith :: forall m a. (MonadIO m, Unbox a) =>
2329 (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
2676 (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
2330spliceWith sizer dst@(MutArray _ start end bound) src = do
2677spliceWith sizer dst@(MutArray _ start end bound) src = do
2332− let f = writeAppendWith (`sizer` byteLength src) (return dst)
2679+ let f = appendWith (`sizer` byteLength src) (return dst)
2333 in D.fold f (toStreamD src)
2680 in D.fold f (toStreamD src)
2335 assert (end <= bound) (return ())
2682 assert (end <= bound) (return ())
@@ -2345,7 +2692,7 @@ spliceWith sizer dst@(MutArray _ start end bound) src = do
2345 $ "splice: newSize is less than the total size "
2692 $ "splice: newSize is less than the total size "
2346 ++ "of arrays being appended. Please check the "
2693 ++ "of arrays being appended. Please check the "
2347 ++ "sizer function passed."
2694 ++ "sizer function passed."
2348− liftIO $ realloc newSizeInBytes dst
2695+ realloc newSizeInBytes dst
2349 else return dst
2696 else return dst
2350 spliceUnsafe dst1 src
2697 spliceUnsafe dst1 src
@@ -2397,7 +2744,7 @@ splitOn predicate arr =
2397{-# INLINE breakOn #-}
2744{-# INLINE breakOn #-}
2398breakOn :: MonadIO m
2745breakOn :: MonadIO m
2399 => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
2746 => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
2400−breakOn sep arr@MutArray{..} = asUnpinnedPtrUnsafe arr $ \p -> liftIO $ do
2747+breakOn sep arr@MutArray{..} = unsafeAsPtr arr $ \p -> liftIO $ do
2401 -- XXX We do not need memchr here, we can use a Haskell equivalent.
2748 -- XXX We do not need memchr here, we can use a Haskell equivalent.
2402 -- Need efficient stream based primitives that work on Word64.
2749 -- Need efficient stream based primitives that work on Word64.
2403 loc <- c_memchr p sep (fromIntegral $ byteLength arr)
2750 loc <- c_memchr p sep (fromIntegral $ byteLength arr)
@@ -2420,33 +2767,41 @@ breakOn sep arr@MutArray{..} = asUnpinnedPtrUnsafe 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
2423-- | Create two slices of an array without copying the original array. The
2792-- | Create two slices of an array without copying the original array. The
2424-- specified index @i@ is the first index of the second slice.
2793-- specified index @i@ is the first index of the second slice.
2426{-# INLINE splitAt #-}
2795{-# INLINE splitAt #-}
2427splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)
2796splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)
2428−splitAt i arr@MutArray{..} =
2797+splitAt i arr =
2429 let maxIndex = length arr - 1
2798 let maxIndex = length arr - 1
2430 in if i < 0
2799 in if i < 0
2431 then error "sliceAt: negative array index"
2800 then error "sliceAt: negative array index"
2432 else if i > maxIndex
2801 else if i > maxIndex
2433 then error $ "sliceAt: specified array index " ++ show i
2802 then error $ "sliceAt: specified array index " ++ show i
2434 ++ " is beyond the maximum index " ++ show maxIndex
2803 ++ " is beyond the maximum index " ++ show maxIndex
2435− else let off = i * SIZE_OF(a)
2804+ else unsafeSplitAt i arr
2438− { arrContents = arrContents
2439− , arrStart = arrStart
2444− { arrContents = arrContents
2447− , arrBound = arrBound
2451-------------------------------------------------------------------------------
2806-------------------------------------------------------------------------------
2452-- Casting
2807-- Casting
@@ -2496,9 +2851,13 @@ cast arr =
2496-- guarantees that unsafe calls will be performed in the calling thread. Making
2851-- guarantees that unsafe calls will be performed in the calling thread. Making
2497-- it safe to pass heap-allocated objects to unsafe functions.
2852-- it safe to pass heap-allocated objects to unsafe functions.
2499−-- Should we just name it asPtr, the unsafety is implicit for any pointer
2854+-- XXX Should we just name it asPtr, the unsafety is implicit for any pointer
2500-- operations. And we are safe from Haskell perspective because we will be
2855-- operations. And we are safe from Haskell perspective because we will be
2501-- pinning the memory.
2856-- pinning the memory.
2858+-- XXX we cannot pass the length of the ptr here as in some cases it may not be
2859+-- available e.g. a null terminated C string. However, we can create another
2860+-- flavor of the API e.g. asPtrN.
2503-- | Use a @MutArray a@ as @Ptr a@. This is useful when we want to pass an
2862-- | Use a @MutArray a@ as @Ptr a@. This is useful when we want to pass an
2504-- array as a pointer to some operating system call or to a "safe" FFI call.
2863-- array as a pointer to some operating system call or to a "safe" FFI call.
@@ -2516,16 +2875,21 @@ cast arr =
2517-- /Pre-release/
2876-- /Pre-release/
2878+{-# INLINE unsafePinnedAsPtr #-}
2879+unsafePinnedAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2880+unsafePinnedAsPtr arr f =
2881+ Unboxed.unsafePinnedAsPtr
2882+ (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2884+{-# DEPRECATED asPtrUnsafe "Please use unsafePinnedAsPtr instead." #-}
2519{-# INLINE asPtrUnsafe #-}
2885{-# INLINE asPtrUnsafe #-}
2520asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2886asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2521−asPtrUnsafe arr f =
2887+asPtrUnsafe = unsafePinnedAsPtr
2522− Unboxed.asPtrUnsafe
2523− (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2525−{-# INLINE asUnpinnedPtrUnsafe #-}
2889+{-# INLINE unsafeAsPtr #-}
2526−asUnpinnedPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2890+unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2527−asUnpinnedPtrUnsafe arr f =
2891+unsafeAsPtr arr f =
2528− Unboxed.asUnpinnedPtrUnsafe
2892+ Unboxed.unsafeAsPtr
2529 (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2893 (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2531-------------------------------------------------------------------------------
2895-------------------------------------------------------------------------------
@@ -2543,28 +2907,26 @@ asUnpinnedPtrUnsafe arr f =
2543-- /Pre-release/
2907-- /Pre-release/
2544{-# INLINE byteCmp #-}
2908{-# INLINE byteCmp #-}
2545byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
2909byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
2546−byteCmp arr1 arr2 =
2910+byteCmp arr1 arr2 = do
2549− let marr1 = getMutableByteArray# (arrContents arr1)
2911+ let marr1 = getMutableByteArray# (arrContents arr1)
2550− marr2 = getMutableByteArray# (arrContents arr2)
2912+ marr2 = getMutableByteArray# (arrContents arr2)
2551− !(I# st1#) = arrStart arr1
2913+ !(I# st1#) = arrStart arr1
2552− !(I# st2#) = arrStart arr2
2914+ !(I# st2#) = arrStart arr2
2553− !(I# len#) = byteLength arr1
2915+ !(I# len#) = byteLength arr1
2554− case compare (byteLength arr1) (byteLength arr2) of
2916+ case compare (byteLength arr1) (byteLength arr2) of
2555− EQ -> do
2917+ EQ -> do
2556− r <- liftIO $ IO $ \s# ->
2918+ r <- liftIO $ IO $ \s# ->
2557− let res =
2919+ let res =
2559− (compareByteArrays#
2921+ (compareByteArrays#
2560− (unsafeCoerce# marr1)
2922+ (unsafeCoerce# marr1)
2562− (unsafeCoerce# marr2)
2924+ (unsafeCoerce# marr2)
2565− in (# s#, res #)
2927+ in (# s#, res #)
2566− return $ compare r 0
2928+ return $ compare r 0
2567− x -> return x
2929+ x -> return x
2569{-# INLINE cmp #-}
2931{-# INLINE cmp #-}
2570{-# DEPRECATED cmp "Please use byteCmp instead." #-}
2932{-# DEPRECATED cmp "Please use byteCmp instead." #-}
@@ -2581,7 +2943,309 @@ byteEq :: MonadIO m => MutArray a -> MutArray a -> m Bool
2581byteEq arr1 arr2 = fmap (EQ ==) $ byteCmp arr1 arr2
2943byteEq arr1 arr2 = fmap (EQ ==) $ byteCmp arr1 arr2
2583-------------------------------------------------------------------------------
2945-------------------------------------------------------------------------------
2584−-- NFData
2946+-- Compact
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
2585-------------------------------------------------------------------------------
3249-------------------------------------------------------------------------------
2587-- | Strip elements which match with predicate from both ends.
3251-- | Strip elements which match with predicate from both ends.