@@ -94,13 +94,6 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type
9494 , appendWith
9595 , append
9696
97− -- ** Truncation
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.
100− , truncateWith
101− , truncate
102− , truncateExp
103−
10497 -- * Eliminating and Reading
10598
10699 -- ** To streams
@@ -826,27 +819,29 @@ snocMay arr@Array{..} x = liftIO $ do
826819 then Just <$> snocNewEnd newEnd arr x
827820 else return Nothing
828821
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.
829825reallocWith :: forall m a. (MonadIO m , Storable a) =>
830826 String
831827 -> (Int -> Int)
832828 -> Int
833829 -> Array a
834830 -> m (Array a)
835−reallocWith label sizer reqSize arr = do
831+reallocWith label capSizer minIncr arr = do
836832 let oldSize = aEnd arr `minusPtr` arrStart arr
837− newSize = sizer oldSize
838− safeSize = max newSize (oldSize + reqSize)
839− rounded = roundUpLargeArray safeSize
840− assert (newSize >= oldSize + reqSize || error badSize) (return ())
841− assert (rounded >= safeSize) (return ())
842− realloc rounded arr
833+ newCap = capSizer oldSize
834+ newSize = oldSize + minIncr
835+ safeCap = max newCap newSize
836+ assert (newCap >= newSize || error (badSize newSize)) (return ())
837+ realloc safeCap arr
843838
844839 where
845840
846− badSize = concat
841+ badSize newSize = concat
847842 [ label
848843 , ": new array size is less than required size "
849− , show reqSize
844+ , show newSize
850845 , ". Please check the sizing function passed."
851846 ]
852847
@@ -924,57 +919,88 @@ snoc = snocWith (* 2)
924919-- Resizing
925920-------------------------------------------------------------------------------
926921
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)
925+
927926-- XXX See if resizing can be implemented by reading the old array as a stream
928927-- and then using writeN to the new array.
929928--
930−-- | Reallocate the array to the specified size in bytes. If the size is less
931−-- than the original array the array gets truncated.
932929{-# NOINLINE reallocAligned #-}
933930reallocAligned :: Int -> Int -> Int -> Array a -> IO (Array a)
934−reallocAligned elemSize alignSize newSize Array{..} = do
931+reallocAligned elemSize alignSize newCapacity Array{..} = do
935932 assert (aEnd <= aBound) (return ())
933+
934+ -- Allocate new array
935+ let newCapMax = roundUpLargeArray newCapacity
936+ (contents, pNew) <- newAlignedArrayContents newCapMax alignSize
937+
938+ -- Copy old data
936939 let oldStart = arrStart
937940 oldSize = aEnd `minusPtr` oldStart
941+ newCap = roundDownTo elemSize newCapMax
942+ newLen = min oldSize newCap
938943 assert (oldSize `mod` elemSize == 0) (return ())
939− (contents, pNew) <- newAlignedArrayContents newSize alignSize
940− let size = min oldSize newSize
941− assert (size >= 0) (return ())
942− assert (size `mod` elemSize == 0) (return ())
943− memcpy (castPtr pNew) (castPtr oldStart) size
944+ assert (newLen >= 0) (return ())
945+ assert (newLen `mod` elemSize == 0) (return ())
946+ memcpy (castPtr pNew) (castPtr oldStart) newLen
944947 touch arrContents
948+
945949 return $ Array
946950 { arrStart = pNew
947951 , arrContents = contents
948− , aEnd = pNew `plusPtr` (size - (size `mod` elemSize))
949− , aBound = pNew `plusPtr` newSize
952+ , aEnd = pNew `plusPtr` newLen
953+ , aBound = pNew `plusPtr` newCap
950954 }
951955
956+-- | @realloc newCapacity array@ reallocates the array to the specified
957+-- capacity in bytes.
958+--
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).
963+--
952964{-# INLINABLE realloc #-}
953965realloc :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m (Array a)
954−realloc i arr =
955− liftIO $ reallocAligned (SIZE_OF(a)) (alignment (undefined :: a)) i arr
966+realloc n arr =
967+ liftIO $ reallocAligned (SIZE_OF(a)) (alignment (undefined :: a)) n arr
956968
957−-- | Change the reserved memory of the array so that it is enough to hold the
958−-- specified number of elements. Nothing is done if the specified capacity is
959−-- less than the length of the array.
969+-- | @resize newCapacity array@ changes the total capacity of the array so that
970+-- it is enough to hold the specified number of elements. Nothing is done if
971+-- the specified capacity is less than the length of the array.
960972--
961973-- If the capacity is more than 'largeObjectThreshold' then it is rounded up to
962974-- the block size (4K).
963975--
964−-- /Unimplemented/
976+-- /Pre-release/
965977{-# INLINE resize #-}
966−resize :: -- (MonadIO m, Storable a) =>
978+resize :: forall m a. (MonadIO m, Storable a) =>
967979 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
983+ if req < len
984+ then return arr
985+ else realloc req arr
969986
970987-- | Like 'resize' but if the capacity is more than 'largeObjectThreshold' then
971988-- it is rounded up to the closest power of 2.
972989--
973−-- /Unimplemented/
990+-- /Pre-release/
974991{-# INLINE resizeExp #-}
975−resizeExp :: -- (MonadIO m, Storable a) =>
992+resizeExp :: forall m a. (MonadIO m, Storable a) =>
976993 Int -> Array a -> m (Array a)
977−resizeExp = undefined
994+resizeExp n arr@Array{..} = do
995+ let req = roundUpLargeArray (SIZE_OF(a) * n)
996+ req1 =
997+ if req > largeObjectThreshold
998+ then roundUpToPower2 req
999+ else req
1000+ len = aEnd `minusPtr` arrStart
1001+ if req1 < len
1002+ then return arr
1003+ else realloc req1 arr
9781004
9791005-- | Resize the allocated memory to drop any reserved free space at the end of
9801006-- the array and reallocate it to reduce wastage.
@@ -1000,40 +1026,6 @@ rightSize arr@Array{..} = do
10001026 then realloc target arr
10011027 else return arr
10021028
1003−-------------------------------------------------------------------------------
1004−-- Reducing the length
1005−-------------------------------------------------------------------------------
1006−
1007−-- XXX Either slice the array or stream it and write it out to a new array?
1008−--
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.
1011−--
1012−-- /Unimplemented/
1013−{-# INLINE truncateWith #-}
1014−truncateWith :: -- (MonadIO m, Storable a) =>
1015− Int -> (Int -> Int) -> Array a -> m (Array a)
1016−truncateWith = undefined
1017−
1018−-- | Drop the last n elements of the array to reduce the length by n.
1019−--
1020−-- The capacity is rounded to 1K or 4K if the length is more than the GHC large
1021−-- block threshold.
1022−--
1023−-- /Unimplemented/
1024−{-# INLINE truncate #-}
1025−truncate :: -- (MonadIO m, Storable a) =>
1026− Int -> Array a -> m (Array a)
1027−truncate = undefined
1028−
1029−-- | Like 'truncate' but the capacity is rounded to the closest power of 2.
1030−--
1031−-- /Unimplemented/
1032−{-# INLINE truncateExp #-}
1033−truncateExp :: -- (MonadIO m, Storable a) =>
1034− Int -> Array a -> m (Array a)
1035−truncateExp = undefined
1036−
10371029-------------------------------------------------------------------------------
10381030-- Random reads
10391031-------------------------------------------------------------------------------