@@ -42,8 +42,8 @@ module Streamly.Internal.Data.MutArray.Type
43 , castUnsafe -- XXX unsafeCast
43 , castUnsafe -- XXX unsafeCast
45− , asPtrUnsafe -- XXX rename to unsafePinnedAsPtr?
45+ , unsafePinnedAsPtr
46− , asUnpinnedPtrUnsafe -- XXX rename to unsafeAsPtr
46+ , unsafeAsPtr
48 -- ** Construction
48 -- ** Construction
@@ -97,7 +97,7 @@ module Streamly.Internal.Data.MutArray.Type
97 , fromByteStr#
97 , fromByteStr#
98 , fromPtrN
98 , fromPtrN
99 , fromChunksK
99 , fromChunksK
100− , fromChunksRealloced
100+ , fromChunksRealloced -- fromSmallChunks
102 -- ** Random writes
102 -- ** Random writes
103 , putIndex
103 , putIndex
@@ -214,12 +214,12 @@ module Streamly.Internal.Data.MutArray.Type
214 -- ** Serialization using Unbox
214 -- ** Serialization using Unbox
215 , pokeAppend
215 , pokeAppend
216 , pokeAppendMay
216 , pokeAppendMay
217− , pokeSkipUnsafe
217+ , pokeSkipUnsafe -- unsafePokeSkip
219 -- ** Deserialization using Unbox
219 -- ** Deserialization using Unbox
220 , peekUncons
220 , peekUncons
221− , peekUnconsUnsafe
221+ , peekUnconsUnsafe -- unsafePeekUncons
222− , peekSkipUnsafe
222+ , peekSkipUnsafe -- unsafePeekSkip
224 -- Arrays of arrays
224 -- Arrays of arrays
225 -- We can add dimensionality parameter to the array type to get
225 -- We can add dimensionality parameter to the array type to get
@@ -242,6 +242,8 @@ module Streamly.Internal.Data.MutArray.Type
243 -- *** Concat
243 -- *** Concat
244 -- | Append the arrays in a stream to form a stream of elements.
244 -- | Append the arrays in a stream to form a stream of elements.
246 , concatRev
248 , concatRev
@@ -249,9 +251,12 @@ module Streamly.Internal.Data.MutArray.Type
249 -- | Append the arrays in a stream to form a stream of larger arrays.
251 -- | Append the arrays in a stream to form a stream of larger arrays.
250 , SpliceState (..)
252 , SpliceState (..)
251 , pCompactLE
253 , pCompactLE
252− , rCompactLE
254+ , pPinnedCompactLE
253 , fCompactGE
256 , fCompactGE
254 , lCompactGE
258 , lCompactGE
255 , compactGE
260 , compactGE
256 , compactEQ
261 , compactEQ
@@ -262,6 +267,7 @@ module Streamly.Internal.Data.MutArray.Type
262 , c_memchr
267 , c_memchr
264 -- * Deprecated
269 -- * Deprecated
265 , writeChunks
271 , writeChunks
266 , flattenArrays
272 , flattenArrays
267 , flattenArraysRev
273 , flattenArraysRev
@@ -836,15 +842,15 @@ roundDownTo elemSize size = size - (size `mod` elemSize)
836-- Since this is not inlined Unboxed consrraint leads to dictionary passing
842-- Since this is not inlined Unboxed consrraint leads to dictionary passing
837-- which complicates some inspection tests.
843-- which complicates some inspection tests.
839−{-# NOINLINE reallocExplicit #-}
845+{-# NOINLINE reallocExplicitAs #-}
840−reallocExplicit :: Int -> Int -> MutArray a -> IO (MutArray a)
846+reallocExplicitAs :: PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
841−reallocExplicit elemSize newCapacityInBytes MutArray{..} = do
847+reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do
842 assertM(arrEnd <= arrBound)
848 assertM(arrEnd <= arrBound)
844 -- Allocate new array
850 -- Allocate new array
845 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
851 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
846 contents <-
852 contents <-
847− if Unboxed.isPinned arrContents
853+ if ps == Pinned
848 then Unboxed.pinnedNew newCapMaxInBytes
854 then Unboxed.pinnedNew newCapMaxInBytes
849 else Unboxed.new newCapMaxInBytes
855 else Unboxed.new newCapMaxInBytes
850 let !(MutByteArray mbarrFrom#) = arrContents
856 let !(MutByteArray mbarrFrom#) = arrContents
@@ -884,7 +890,12 @@ reallocExplicit elemSize newCapacityInBytes MutArray{..} = do
884-- 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.
885{-# INLINABLE realloc #-}
891{-# INLINABLE realloc #-}
886realloc :: 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)
887−realloc bytes arr = liftIO $ reallocExplicit (SIZE_OF(a)) bytes arr
898+ in liftIO $ reallocExplicitAs ps (SIZE_OF(a)) bytes arr
889-- | @reallocWith label capSizer minIncrBytes array@. The label is used
900-- | @reallocWith label capSizer minIncrBytes array@. The label is used
890-- 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
@@ -1653,16 +1664,10 @@ data FlattenState s contents a =
1653 OuterLoop s
1664 OuterLoop s
1654 | InnerLoop s contents !Int !Int
1665 | InnerLoop s contents !Int !Int
1656−-- | Use the "reader" unfold instead.
1658−-- @concat = unfoldMany reader@
1660−-- We can try this if there are any fusion issues in the unfold.
1662−{-# INLINE_NORMAL concat #-}
1667+{-# INLINE_NORMAL concatWith #-}
1663−concat :: forall m a. (MonadIO m, Unbox a)
1668+concatWith :: forall m a. (Monad m, Unbox a)
1664− => 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
1665−concat (D.Stream step state) = D.Stream step' (OuterLoop state)
1670+concatWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
@@ -1679,25 +1684,30 @@ concat (D.Stream step state) = D.Stream step' (OuterLoop state)
1679 return $ D.Skip $ OuterLoop st
1684 return $ D.Skip $ OuterLoop st
1681 step' _ (InnerLoop st contents p end) = do
1686 step' _ (InnerLoop st contents p end) = do
1682− x <- liftIO $ peekAt p contents
1687+ x <- liftio $ peekAt p contents
1683 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)
1690+-- | Use the "reader" unfold instead.
1692+-- @concat = unfoldMany reader@
1694+-- We can try this if there are any fusion issues in the unfold.
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
1685{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}
1701{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}
1686{-# INLINE flattenArrays #-}
1702{-# INLINE flattenArrays #-}
1687flattenArrays :: forall m a. (MonadIO m, Unbox a)
1703flattenArrays :: forall m a. (MonadIO m, Unbox a)
1688 => D.Stream m (MutArray a) -> D.Stream m a
1704 => D.Stream m (MutArray a) -> D.Stream m a
1689flattenArrays = concat
1705flattenArrays = concat
1691−-- | Use the "readerRev" unfold instead.
1693−-- @concat = unfoldMany readerRev@
1695−-- We can try this if there are any fusion issues in the unfold.
1697−{-# INLINE_NORMAL concatRev #-}
1707+{-# INLINE_NORMAL concatRevWith #-}
1698−concatRev :: forall m a. (MonadIO m, Unbox a)
1708+concatRevWith :: forall m a. (Monad m, Unbox a)
1699− => D.Stream m (MutArray a) -> D.Stream m a
1709+ => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a
1700−concatRev (D.Stream step state) = D.Stream step' (OuterLoop state)
1710+concatRevWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)
@@ -1715,10 +1725,21 @@ concatRev (D.Stream step state) = D.Stream step' (OuterLoop state)
1715 return $ D.Skip $ OuterLoop st
1725 return $ D.Skip $ OuterLoop st
1717 step' _ (InnerLoop st contents p start) = do
1727 step' _ (InnerLoop st contents p start) = do
1718− x <- liftIO $ peekAt p contents
1728+ x <- liftio $ peekAt p contents
1719 let cur = INDEX_PREV(p,a)
1729 let cur = INDEX_PREV(p,a)
1720 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
1722{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}
1743{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}
1723{-# INLINE flattenArraysRev #-}
1744{-# INLINE flattenArraysRev #-}
1724flattenArraysRev :: forall m a. (MonadIO m, Unbox a)
1745flattenArraysRev :: forall m a. (MonadIO m, Unbox a)
@@ -2271,7 +2292,7 @@ writeWithAs ps elemCount =
2271 | INDEX_NEXT(end,a) > bound = do
2292 | INDEX_NEXT(end,a) > bound = do
2272 let oldSize = end - start
2293 let oldSize = end - start
2273 newSize = max (oldSize * 2) 1
2294 newSize = max (oldSize * 2) 1
2274− arr1 <- liftIO $ reallocExplicit (SIZE_OF(a)) newSize arr
2295+ arr1 <- liftIO $ reallocExplicitAs ps (SIZE_OF(a)) newSize arr
2275 snocUnsafe arr1 x
2296 snocUnsafe arr1 x
2276 step arr x = snocUnsafe arr x
2297 step arr x = snocUnsafe arr x
@@ -2419,7 +2440,7 @@ fromPtrN len addr = do
2419 -- 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
2420 -- first and then remaining Word8.
2441 -- first and then remaining Word8.
2421 arr <- new len
2442 arr <- new len
2422− _ <- asUnpinnedPtrUnsafe arr
2443+ _ <- unsafeAsPtr arr
2423 (\ptr -> liftIO $ c_memcpy ptr addr (fromIntegral len))
2444 (\ptr -> liftIO $ c_memcpy ptr addr (fromIntegral len))
2424 return (arr {arrEnd = len})
2445 return (arr {arrEnd = len})
@@ -2435,7 +2456,7 @@ fromByteStr# addr = do
2435 len <- liftIO $ c_strlen (Ptr addr)
2456 len <- liftIO $ c_strlen (Ptr addr)
2436 let lenInt = fromIntegral len
2457 let lenInt = fromIntegral len
2437 arr <- new lenInt
2458 arr <- new lenInt
2438− _ <- asUnpinnedPtrUnsafe arr (\ptr -> liftIO $ c_memcpy ptr (Ptr addr) len)
2459+ _ <- unsafeAsPtr arr (\ptr -> liftIO $ c_memcpy ptr (Ptr addr) len)
2439 return (arr {arrEnd = lenInt})
2460 return (arr {arrEnd = lenInt})
2441-------------------------------------------------------------------------------
2462-------------------------------------------------------------------------------
@@ -2723,7 +2744,7 @@ splitOn predicate arr =
2723{-# INLINE breakOn #-}
2744{-# INLINE breakOn #-}
2724breakOn :: MonadIO m
2745breakOn :: MonadIO m
2725 => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
2746 => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
2726−breakOn sep arr@MutArray{..} = asUnpinnedPtrUnsafe arr $ \p -> liftIO $ do
2747+breakOn sep arr@MutArray{..} = unsafeAsPtr arr $ \p -> liftIO $ do
2727 -- 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.
2728 -- Need efficient stream based primitives that work on Word64.
2749 -- Need efficient stream based primitives that work on Word64.
2729 loc <- c_memchr p sep (fromIntegral $ byteLength arr)
2750 loc <- c_memchr p sep (fromIntegral $ byteLength arr)
@@ -2854,16 +2875,21 @@ cast arr =
2855-- /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." #-}
2857{-# INLINE asPtrUnsafe #-}
2885{-# INLINE asPtrUnsafe #-}
2858asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2886asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2859−asPtrUnsafe arr f =
2887+asPtrUnsafe = unsafePinnedAsPtr
2860− Unboxed.asPtrUnsafe
2861− (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2863−{-# INLINE asUnpinnedPtrUnsafe #-}
2889+{-# INLINE unsafeAsPtr #-}
2864−asUnpinnedPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2890+unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
2865−asUnpinnedPtrUnsafe arr f =
2891+unsafeAsPtr arr f =
2866− Unboxed.asUnpinnedPtrUnsafe
2892+ Unboxed.unsafeAsPtr
2867 (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2893 (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))
2869-------------------------------------------------------------------------------
2895-------------------------------------------------------------------------------
@@ -2925,19 +2951,11 @@ byteEq arr1 arr2 = fmap (EQ ==) $ byteCmp arr1 arr2
2925-- can leave some memory unused. They can split the last array to fit it
2951-- can leave some memory unused. They can split the last array to fit it
2926-- exactly in the space.
2952-- exactly in the space.
2928−-- | Parser @pCompactLE maxElems@ coalesces adjacent arrays in the input stream
2929−-- only if the combined size would be less than or equal to @maxElems@
2930−-- elements. Note that it won't split an array if the original array is already
2931−-- larger than maxElems.
2933−-- @maxElems@ must be greater than 0.
2936−{-# INLINE_NORMAL pCompactLE #-}
2954+{-# INLINE_NORMAL pCompactLeAs #-}
2937−pCompactLE ::
2955+pCompactLeAs ::
2938 forall m a. (MonadIO m, Unbox a)
2956 forall m a. (MonadIO m, Unbox a)
2939− => Int -> Parser (MutArray a) m (MutArray a)
2957+ => PinnedState -> Int -> Parser (MutArray a) m (MutArray a)
2940−pCompactLE maxElems = Parser step initial extract
2958+pCompactLeAs ps maxElems = Parser step initial extract
@@ -2968,7 +2986,8 @@ pCompactLE maxElems = Parser step initial extract
2970 if byteCapacity buf < maxBytes
2988 if byteCapacity buf < maxBytes
2989+ then liftIO $ reallocExplicitAs
2971− then realloc maxBytes buf
2990+ ps (SIZE_OF(a)) maxBytes buf
2972 else return buf
2991 else return buf
2973 buf2 <- spliceUnsafe buf1 arr
2992 buf2 <- spliceUnsafe buf1 arr
2974 return $ Parser.Partial 0 (Just buf2)
2993 return $ Parser.Partial 0 (Just buf2)
@@ -2976,6 +2995,30 @@ pCompactLE maxElems = Parser step initial extract
2976 extract Nothing = return $ Parser.Done 0 nil
2995 extract Nothing = return $ Parser.Done 0 nil
2977 extract (Just buf) = return $ Parser.Done 0 buf
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
2979data SpliceState s arr
3022data SpliceState s arr
2980 = SpliceInitial s
3023 = SpliceInitial s
2981 | SpliceBuffering s arr
3024 | SpliceBuffering s arr
@@ -2987,18 +3030,10 @@ data SpliceState s arr
2987-- immutable array never has additional space so a new array is allocated
3030-- immutable array never has additional space so a new array is allocated
2988-- instead of mutating it.
3031-- instead of mutating it.
2990−-- | Scan @rCompactLE maxElems@ coalesces adjacent arrays in the input stream
2991−-- only if the combined size would be less than or equal to @maxElems@
2992−-- elements. Note that it won't split an array if the original array is already
2993−-- larger than maxElems.
2995−-- @maxElems@ must be greater than 0.
2998−{-# INLINE_NORMAL rCompactLE #-}
3033+{-# INLINE_NORMAL compactLeAs #-}
2999−rCompactLE :: forall m a. (MonadIO m, Unbox a)
3034+compactLeAs :: forall m a. (MonadIO m, Unbox a)
3000− => Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)
3035+ => PinnedState -> Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)
3001−rCompactLE maxElems (D.Stream step state) =
3036+compactLeAs ps maxElems (D.Stream step state) =
3002 D.Stream step' (SpliceInitial state)
3037 D.Stream step' (SpliceInitial state)
@@ -3034,7 +3069,8 @@ rCompactLE maxElems (D.Stream step state) =
3034 D.Skip (SpliceYielding buf (SpliceBuffering s arr))
3069 D.Skip (SpliceYielding buf (SpliceBuffering s arr))
3036 buf1 <- if byteCapacity buf < maxBytes
3071 buf1 <- if byteCapacity buf < maxBytes
3072+ then liftIO $ reallocExplicitAs
3037− then realloc maxBytes buf
3073+ ps (SIZE_OF(a)) maxBytes buf
3038 else return buf
3074 else return buf
3039 buf2 <- spliceUnsafe buf1 arr
3075 buf2 <- spliceUnsafe buf1 arr
3040 return $ D.Skip (SpliceBuffering s buf2)
3076 return $ D.Skip (SpliceBuffering s buf2)
@@ -3045,14 +3081,12 @@ rCompactLE maxElems (D.Stream step state) =
3046 step' _ (SpliceYielding arr next) = return $ D.Yield arr next
3082 step' _ (SpliceYielding arr next) = return $ D.Yield arr next
3048−-- | Fold @fCompactGE minElems@ coalesces adjacent arrays in the input stream
3084+
3049−-- until the size becomes greater than or equal to @minElems@.
3051−{-# INLINE_NORMAL fCompactGE #-}
3085+{-# INLINE_NORMAL fCompactGeAs #-}
3052−fCompactGE ::
3086+fCompactGeAs ::
3053 forall m a. (MonadIO m, Unbox a)
3087 forall m a. (MonadIO m, Unbox a)
3054− => Int -> FL.Fold m (MutArray a) (MutArray a)
3088+ => PinnedState -> Int -> FL.Fold m (MutArray a) (MutArray a)
3055−fCompactGE minElems = Fold step initial extract extract
3089+fCompactGeAs ps minElems = Fold step initial extract extract
@@ -3080,7 +3114,8 @@ fCompactGE minElems = Fold step initial extract extract
3080 let len = byteLength buf + byteLength arr
3114 let len = byteLength buf + byteLength arr
3082 if byteCapacity buf < len
3116 if byteCapacity buf < len
3117+ then liftIO $ reallocExplicitAs
3083− then realloc (max len minBytes) buf
3118+ ps (SIZE_OF(a)) (max minBytes len) buf
3084 else return buf
3119 else return buf
3085 buf2 <- spliceUnsafe buf1 arr
3120 buf2 <- spliceUnsafe buf1 arr
3086 if len >= minBytes
3121 if len >= minBytes
@@ -3090,15 +3125,30 @@ fCompactGE minElems = Fold step initial extract extract
3090 extract Nothing = return nil
3125 extract Nothing = return nil
3091 extract (Just buf) = return buf
3126 extract (Just buf) = return buf
3093−-- | Like 'compactGE' but for transforming folds instead of stream.
3128+-- | Fold @fCompactGE minElems@ coalesces adjacent arrays in the input stream
3094−--
3129+-- until the size becomes greater than or equal to @minElems@.
3095−-- >>> lCompactGE n = Fold.many (MutArray.fCompactGE n)
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
3097−{-# INLINE_NORMAL lCompactGE #-}
3146+{-# INLINE_NORMAL lCompactGeAs #-}
3098−lCompactGE :: forall m a. (MonadIO m, Unbox a)
3147+lCompactGeAs :: forall m a. (MonadIO m, Unbox a)
3099− => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
3148+ => PinnedState -> Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
3100−-- lCompactGE n = Fold.many (fCompactGE n)
3149+-- The fold version turns out to be a little bit slower.
3150+-- lCompactGeAs ps n = FL.many (fCompactGeAs ps n)
3101−lCompactGE minElems (Fold step1 initial1 _ final1) =
3151+lCompactGeAs ps minElems (Fold step1 initial1 _ final1) =
3102 Fold step initial extract final
3152 Fold step initial extract final
@@ -3136,7 +3186,8 @@ lCompactGE minElems (Fold step1 initial1 _ final1) =
3136 step (Tuple' (Just buf) r1) arr = do
3186 step (Tuple' (Just buf) r1) arr = do
3137 let len = byteLength buf + byteLength arr
3187 let len = byteLength buf + byteLength arr
3138 buf1 <- if byteCapacity buf < len
3188 buf1 <- if byteCapacity buf < len
3189+ then liftIO $ reallocExplicitAs
3139− then realloc (max minBytes len) buf
3190+ ps (SIZE_OF(a)) (max minBytes len) buf
3140 else return buf
3191 else return buf
3141 buf2 <- spliceUnsafe buf1 arr
3192 buf2 <- spliceUnsafe buf1 arr
3142 runInner len r1 buf2
3193 runInner len r1 buf2
@@ -3156,6 +3207,23 @@ lCompactGE minElems (Fold step1 initial1 _ final1) =
3156 FL.Partial rr -> final1 rr
3207 FL.Partial rr -> final1 rr
3157 FL.Done _ -> return ()
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
3159-- | @compactGE n stream@ coalesces adjacent arrays in the @stream@ until
3227-- | @compactGE n stream@ coalesces adjacent arrays in the @stream@ until
3160-- the size becomes greater than or equal to @n@.
3228-- the size becomes greater than or equal to @n@.