@@ -94,13 +94,6 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type
94 , appendWith
94 , appendWith
98− -- These are not the same as slicing the array at the beginning, they may
99− -- reduce the length as well as the capacity of the array.
104 -- * Eliminating and Reading
97 -- * Eliminating and Reading
106 -- ** To streams
99 -- ** To streams
@@ -826,27 +819,29 @@ snocMay arr@Array{..} x = liftIO $ do
826 then Just <$> snocNewEnd newEnd arr x
819 then Just <$> snocNewEnd newEnd arr x
827 else return Nothing
820 else return Nothing
822+-- | @reallocWith label capSizer minIncrement array@. The label is used
823+-- in error messages and the capSizer is used to determine the capacity of the
824+-- new array in bytes given the current byte length of the array.
829reallocWith :: forall m a. (MonadIO m , Storable a) =>
825reallocWith :: forall m a. (MonadIO m , Storable a) =>
831 -> (Int -> Int)
827 -> (Int -> Int)
833 -> Array a
829 -> Array a
834 -> m (Array a)
830 -> m (Array a)
835−reallocWith label sizer reqSize arr = do
831+reallocWith label capSizer minIncr arr = do
836 let oldSize = aEnd arr `minusPtr` arrStart arr
832 let oldSize = aEnd arr `minusPtr` arrStart arr
837− newSize = sizer oldSize
833+ newCap = capSizer oldSize
838− safeSize = max newSize (oldSize + reqSize)
834+ newSize = oldSize + minIncr
839− rounded = roundUpLargeArray safeSize
835+ safeCap = max newCap newSize
840− assert (newSize >= oldSize + reqSize || error badSize) (return ())
836+ assert (newCap >= newSize || error (badSize newSize)) (return ())
841− assert (rounded >= safeSize) (return ())
842− realloc rounded arr
837+ realloc safeCap arr
846− badSize = concat
841+ badSize newSize = concat
848 , ": new array size is less than required size "
843 , ": new array size is less than required size "
849− , show reqSize
844+ , show newSize
850 , ". Please check the sizing function passed."
845 , ". Please check the sizing function passed."
@@ -924,57 +919,88 @@ snoc = snocWith (* 2)
924-- Resizing
919-- Resizing
925-------------------------------------------------------------------------------
920-------------------------------------------------------------------------------
922+-- | Round the second argument down to multiples of the first argument.
923+roundDownTo :: Int -> Int -> Int
924+roundDownTo elemSize size = size - (size `mod` elemSize)
927-- XXX See if resizing can be implemented by reading the old array as a stream
926-- XXX See if resizing can be implemented by reading the old array as a stream
928-- and then using writeN to the new array.
927-- and then using writeN to the new array.
930−-- | Reallocate the array to the specified size in bytes. If the size is less
931−-- than the original array the array gets truncated.
932{-# NOINLINE reallocAligned #-}
929{-# NOINLINE reallocAligned #-}
933reallocAligned :: Int -> Int -> Int -> Array a -> IO (Array a)
930reallocAligned :: Int -> Int -> Int -> Array a -> IO (Array a)
934−reallocAligned elemSize alignSize newSize Array{..} = do
931+reallocAligned elemSize alignSize newCapacity Array{..} = do
935 assert (aEnd <= aBound) (return ())
932 assert (aEnd <= aBound) (return ())
934+ -- Allocate new array
935+ let newCapMax = roundUpLargeArray newCapacity
936+ (contents, pNew) <- newAlignedArrayContents newCapMax alignSize
936 let oldStart = arrStart
939 let oldStart = arrStart
937 oldSize = aEnd `minusPtr` oldStart
940 oldSize = aEnd `minusPtr` oldStart
941+ newCap = roundDownTo elemSize newCapMax
942+ newLen = min oldSize newCap
938 assert (oldSize `mod` elemSize == 0) (return ())
943 assert (oldSize `mod` elemSize == 0) (return ())
939− (contents, pNew) <- newAlignedArrayContents newSize alignSize
940− let size = min oldSize newSize
941− assert (size >= 0) (return ())
944+ assert (newLen >= 0) (return ())
942− assert (size `mod` elemSize == 0) (return ())
945+ assert (newLen `mod` elemSize == 0) (return ())
943− memcpy (castPtr pNew) (castPtr oldStart) size
946+ memcpy (castPtr pNew) (castPtr oldStart) newLen
944 touch arrContents
947 touch arrContents
945 return $ Array
949 return $ Array
946 { arrStart = pNew
950 { arrStart = pNew
947 , arrContents = contents
951 , arrContents = contents
948− , aEnd = pNew `plusPtr` (size - (size `mod` elemSize))
952+ , aEnd = pNew `plusPtr` newLen
949− , aBound = pNew `plusPtr` newSize
953+ , aBound = pNew `plusPtr` newCap
956+-- | @realloc newCapacity array@ reallocates the array to the specified
957+-- capacity in bytes.
959+-- If the new size is less than the original array the array gets truncated.
960+-- If the new size is not a multiple of array element size then it is rounded
961+-- down to multiples of array size. If the new size is more than
962+-- 'largeObjectThreshold' then it is rounded up to the block size (4K).
952{-# INLINABLE realloc #-}
964{-# INLINABLE realloc #-}
953realloc :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m (Array a)
965realloc :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m (Array a)
954−realloc i arr =
966+realloc n arr =
955− liftIO $ reallocAligned (SIZE_OF(a)) (alignment (undefined :: a)) i arr
967+ liftIO $ reallocAligned (SIZE_OF(a)) (alignment (undefined :: a)) n arr
957−-- | Change the reserved memory of the array so that it is enough to hold the
969+-- | @resize newCapacity array@ changes the total capacity of the array so that
958−-- specified number of elements. Nothing is done if the specified capacity is
970+-- it is enough to hold the specified number of elements. Nothing is done if
959−-- less than the length of the array.
971+-- the specified capacity is less than the length of the array.
961-- If the capacity is more than 'largeObjectThreshold' then it is rounded up to
973-- If the capacity is more than 'largeObjectThreshold' then it is rounded up to
962-- the block size (4K).
974-- the block size (4K).
964−-- /Unimplemented/
976+-- /Pre-release/
965{-# INLINE resize #-}
977{-# INLINE resize #-}
966−resize :: -- (MonadIO m, Storable a) =>
978+resize :: forall m a. (MonadIO m, Storable a) =>
967 Int -> Array a -> m (Array a)
979 Int -> Array a -> m (Array a)
968−resize = undefined
980+resize n arr@Array{..} = do
981+ let req = SIZE_OF(a) * n
982+ len = aEnd `minusPtr` arrStart
985+ else realloc req arr
970-- | Like 'resize' but if the capacity is more than 'largeObjectThreshold' then
987-- | Like 'resize' but if the capacity is more than 'largeObjectThreshold' then
971-- it is rounded up to the closest power of 2.
988-- it is rounded up to the closest power of 2.
973−-- /Unimplemented/
990+-- /Pre-release/
974{-# INLINE resizeExp #-}
991{-# INLINE resizeExp #-}
975−resizeExp :: -- (MonadIO m, Storable a) =>
992+resizeExp :: forall m a. (MonadIO m, Storable a) =>
976 Int -> Array a -> m (Array a)
993 Int -> Array a -> m (Array a)
977−resizeExp = undefined
994+resizeExp n arr@Array{..} = do
995+ let req = roundUpLargeArray (SIZE_OF(a) * n)
997+ if req > largeObjectThreshold
998+ then roundUpToPower2 req
1000+ len = aEnd `minusPtr` arrStart
1003+ else realloc req1 arr
979-- | Resize the allocated memory to drop any reserved free space at the end of
1005-- | Resize the allocated memory to drop any reserved free space at the end of
980-- the array and reallocate it to reduce wastage.
1006-- the array and reallocate it to reduce wastage.
@@ -1000,40 +1026,6 @@ rightSize arr@Array{..} = do
1000 then realloc target arr
1026 then realloc target arr
1001 else return arr
1027 else return arr
1003−-------------------------------------------------------------------------------
1004−-- Reducing the length
1005−-------------------------------------------------------------------------------
1007−-- XXX Either slice the array or stream it and write it out to a new array?
1009−-- | Drop the last n elements of the array to reduce the length by n. The
1010−-- capacity is reallocated using the user supplied function.
1013−{-# INLINE truncateWith #-}
1014−truncateWith :: -- (MonadIO m, Storable a) =>
1015− Int -> (Int -> Int) -> Array a -> m (Array a)
1016−truncateWith = undefined
1018−-- | Drop the last n elements of the array to reduce the length by n.
1020−-- The capacity is rounded to 1K or 4K if the length is more than the GHC large
1024−{-# INLINE truncate #-}
1025−truncate :: -- (MonadIO m, Storable a) =>
1026− Int -> Array a -> m (Array a)
1027−truncate = undefined
1029−-- | Like 'truncate' but the capacity is rounded to the closest power of 2.
1032−{-# INLINE truncateExp #-}
1033−truncateExp :: -- (MonadIO m, Storable a) =>
1034− Int -> Array a -> m (Array a)
1035−truncateExp = undefined
1037-------------------------------------------------------------------------------
1029-------------------------------------------------------------------------------
1038-- Random reads
1030-- Random reads
1039-------------------------------------------------------------------------------
1031-------------------------------------------------------------------------------