@@ -581,7 +581,7 @@ putIndices arr = FL.foldlM' step (return ())
581581
582582 where
583583
584− step () (i, x) = liftIO (putIndex i arr x)
584+ step () (i, x) = putIndex i arr x
585585
586586-- | Modify a given index of an array using a modifier function.
587587--
@@ -777,9 +777,6 @@ arrayChunkBytes = 1024
777777roundDownTo :: Int -> Int -> Int
778778roundDownTo elemSize size = size - (size `mod` elemSize)
779779
780−-- XXX See if resizing can be implemented by reading the old array as a stream
781−-- and then using writeN to the new array.
782−--
783780-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.
784781-- Since this is not inlined Unboxed consrraint leads to dictionary passing
785782-- which complicates some inspection tests.
@@ -817,6 +814,10 @@ reallocExplicit elemSize newCapacityInBytes MutArray{..} = do
817814 , arrBound = newCapInBytes
818815 }
819816
817+-- XXX Should these be called reallocBytes etc?
818+-- XXX We may also need reallocAs to allocate as pinned/unpinned explicitly. In
819+-- fact clone/pinnedClone can be implemented using reallocAs.
820+
820821-- | @realloc newCapacity array@ reallocates the array to the specified
821822-- capacity in bytes.
822823--
@@ -858,6 +859,8 @@ reallocWith label capSizer minIncrBytes arr = do
858859 , ". Please check the sizing function passed."
859860 ]
860861
862+-- XXX should be called expand/extend because it never shortens the array.
863+
861864-- | @resize newCapacity array@ changes the total capacity of the array so that
862865-- it is enough to hold the specified number of elements. Nothing is done if
863866-- the specified capacity is less than the length of the array.
@@ -871,13 +874,14 @@ resize :: forall m a. (MonadIO m, Unbox a) =>
871874 Int -> MutArray a -> m (MutArray a)
872875resize nElems arr@MutArray{..} = do
873876 let req = SIZE_OF(a) * nElems
877+ -- XXX Should use arrBound
874878 len = arrEnd - arrStart
875879 if req < len
876880 then return arr
877881 else realloc req arr
878882
879−-- | Like 'resize' but if the byte capacity is more than 'largeObjectThreshold'
880−-- then it is rounded up to the closest power of 2.
883+-- | Like 'resize' but if the requested byte capacity is more than
884+-- 'largeObjectThreshold' then it is rounded up to the closest power of 2.
881885--
882886-- /Pre-release/
883887{-# INLINE resizeExp #-}
@@ -889,6 +893,7 @@ resizeExp nElems arr@MutArray{..} = do
889893 if req > largeObjectThreshold
890894 then roundUpToPower2 req
891895 else req
896+ -- XXX Should use arrBound
892897 len = arrEnd - arrStart
893898 if req1 < len
894899 then return arr
@@ -958,7 +963,7 @@ snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr
958963{-# INLINE snocMay #-}
959964snocMay :: forall m a. (MonadIO m, Unbox a) =>
960965 MutArray a -> a -> m (Maybe (MutArray a))
961−snocMay arr@MutArray{..} x = liftIO $ do
966+snocMay arr@MutArray{..} x = do
962967 let newEnd = INDEX_NEXT(arrEnd,a)
963968 if newEnd <= arrBound
964969 then Just <$> snocNewEnd newEnd arr x
@@ -972,7 +977,7 @@ snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>
972977 -> a
973978 -> m (MutArray a)
974979snocWithRealloc sizer arr x = do
975− arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr
980+ arr1 <- reallocWith "snocWith" sizer (SIZE_OF(a)) arr
976981 snocUnsafe arr1 x
977982
978983-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of
@@ -994,7 +999,7 @@ snocWith :: forall m a. (MonadIO m, Unbox a) =>
994999 -> MutArray a
9951000 -> a
9961001 -> m (MutArray a)
997−snocWith allocSize arr x = liftIO $ do
1002+snocWith allocSize arr x = do
9981003 let newEnd = INDEX_NEXT(arrEnd arr,a)
9991004 if newEnd <= arrBound arr
10001005 then snocNewEnd newEnd arr x
@@ -1114,7 +1119,7 @@ getIndicesWith = indexReaderWith
11141119-- /Pre-release/
11151120{-# INLINE indexReader #-}
11161121indexReader :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
1117−indexReader = getIndicesWith liftIO
1122+indexReader = indexReaderWith liftIO
11181123
11191124-- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold
11201125{-# DEPRECATED getIndices "Please use indexReader instead." #-}
@@ -2002,7 +2007,7 @@ writeWithAs ps elemCount =
20022007
20032008 initial = do
20042009 when (elemCount < 0) $ error "writeWith: elemCount is negative"
2005− liftIO $ newAs ps elemCount
2010+ newAs ps elemCount
20062011
20072012 step arr@(MutArray _ start end bound) x
20082013 | INDEX_NEXT(end,a) > bound = do
@@ -2073,7 +2078,7 @@ pinnedWrite =
20732078fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)
20742079 => PinnedState -> Int -> D.Stream m a -> m (MutArray a)
20752080fromStreamDNAs ps limit str = do
2076− (arr :: MutArray a) <- liftIO $ newAs ps limit
2081+ (arr :: MutArray a) <- newAs ps limit
20772082 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str
20782083 return $ arr {arrEnd = end}
20792084
@@ -2123,13 +2128,13 @@ fromListRevN n xs = D.fold (writeRevN n) $ D.fromList xs
21232128fromPureStreamN :: (MonadIO m, Unbox a) =>
21242129 Int -> Stream Identity a -> m (MutArray a)
21252130fromPureStreamN n xs =
2126− liftIO $ D.fold (writeN n) $ D.morphInner (return . runIdentity) xs
2131+ D.fold (writeN n) $ D.morphInner (return . runIdentity) xs
21272132
21282133-- | Convert a pure stream in Identity monad to a mutable array.
21292134{-# INLINABLE fromPureStream #-}
21302135fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)
21312136fromPureStream xs =
2132− liftIO $ D.fold write $ D.morphInner (return . runIdentity) xs
2137+ D.fold write $ D.morphInner (return . runIdentity) xs
21332138
21342139{-# INLINABLE fromPtrN #-}
21352140fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)
@@ -2175,7 +2180,7 @@ fromChunksRealloced s = do
21752180 arr <- D.foldlM' spliceExp (pure a) strm
21762181 -- Reallocation is exponential so there may be 50% empty space in
21772182 -- worst case. One more reallocation to reclaim the space.
2178− liftIO $ rightSize arr
2183+ rightSize arr
21792184 Nothing -> pure nil
21802185
21812186-------------------------------------------------------------------------------
@@ -2287,7 +2292,7 @@ cloneAs ::
22872292 )
22882293 => PinnedState -> MutArray a -> m (MutArray a)
22892294cloneAs ps src =
2290− liftIO $ do
2295+ do
22912296 let startSrc = arrStart src
22922297 srcLen = arrEnd src - startSrc
22932298 newArrContents <-
@@ -2326,17 +2331,16 @@ spliceCopy :: forall m a. MonadIO m =>
23262331 Unbox a =>
23272332#endif
23282333 MutArray a -> MutArray a -> m (MutArray a)
2329−spliceCopy arr1 arr2 = liftIO $ do
2334+spliceCopy arr1 arr2 = do
23302335 let start1 = arrStart arr1
23312336 start2 = arrStart arr2
23322337 len1 = arrEnd arr1 - start1
23332338 len2 = arrEnd arr2 - start2
2334− let newLen = len1 + len2
2339+ let len = len1 + len2
23352340 newArrContents <-
23362341 if Unboxed.isPinned (arrContents arr1)
2337− then Unboxed.pinnedNew newLen
2338− else Unboxed.new newLen
2339− let len = len1 + len2
2342+ then liftIO $ Unboxed.pinnedNew len
2343+ else liftIO $ Unboxed.new len
23402344 putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1
23412345 putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2
23422346 return $ MutArray newArrContents 0 len len
@@ -2348,7 +2352,7 @@ spliceCopy arr1 arr2 = liftIO $ do
23482352spliceUnsafe :: MonadIO m =>
23492353 MutArray a -> MutArray a -> m (MutArray a)
23502354spliceUnsafe dst src =
2351− liftIO $ do
2355+ do
23522356 let startSrc = arrStart src
23532357 srcLen = arrEnd src - startSrc
23542358 endDst = arrEnd dst
@@ -2386,7 +2390,7 @@ spliceWith sizer dst@(MutArray _ start end bound) src = do
23862390 $ "splice: newSize is less than the total size "
23872391 ++ "of arrays being appended. Please check the "
23882392 ++ "sizer function passed."
2389− liftIO $ realloc newSizeInBytes dst
2393+ realloc newSizeInBytes dst
23902394 else return dst
23912395 spliceUnsafe dst1 src
23922396
@@ -2584,28 +2588,26 @@ asUnpinnedPtrUnsafe arr f =
25842588-- /Pre-release/
25852589{-# INLINE byteCmp #-}
25862590byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
2587−byteCmp arr1 arr2 =
2588− liftIO
2589− $ do
2590− let marr1 = getMutableByteArray# (arrContents arr1)
2591− marr2 = getMutableByteArray# (arrContents arr2)
2592− !(I# st1#) = arrStart arr1
2593− !(I# st2#) = arrStart arr2
2594− !(I# len#) = byteLength arr1
2595− case compare (byteLength arr1) (byteLength arr2) of
2596− EQ -> do
2597− r <- liftIO $ IO $ \s# ->
2598− let res =
2599− I#
2600− (compareByteArrays#
2601− (unsafeCoerce# marr1)
2602− st1#
2603− (unsafeCoerce# marr2)
2604− st2#
2605− len#)
2606− in (# s#, res #)
2607− return $ compare r 0
2608− x -> return x
2591+byteCmp arr1 arr2 = do
2592+ let marr1 = getMutableByteArray# (arrContents arr1)
2593+ marr2 = getMutableByteArray# (arrContents arr2)
2594+ !(I# st1#) = arrStart arr1
2595+ !(I# st2#) = arrStart arr2
2596+ !(I# len#) = byteLength arr1
2597+ case compare (byteLength arr1) (byteLength arr2) of
2598+ EQ -> do
2599+ r <- liftIO $ IO $ \s# ->
2600+ let res =
2601+ I#
2602+ (compareByteArrays#
2603+ (unsafeCoerce# marr1)
2604+ st1#
2605+ (unsafeCoerce# marr2)
2606+ st2#
2607+ len#)
2608+ in (# s#, res #)
2609+ return $ compare r 0
2610+ x -> return x
26092611
26102612{-# INLINE cmp #-}
26112613{-# DEPRECATED cmp "Please use byteCmp instead." #-}