@@ -176,6 +176,13 @@ memcmp p1 p2 len = do
176176 r <- c_memcmp p1 p2 (fromIntegral len)
177177 return $ r == 0
178178
179+{-# INLINE unsafeWithForeignPtrM #-}
180+unsafeWithForeignPtrM :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b
181+unsafeWithForeignPtrM fo f = do
182+ r <- f (unsafeForeignPtrToPtr fo)
183+ liftIO $ touchForeignPtr fo
184+ return r
185+
179186-------------------------------------------------------------------------------
180187-- Array Data Type
181188-------------------------------------------------------------------------------
@@ -213,8 +220,8 @@ mutableArray = Array
213220
214221-- | allocate a new array using the provided allocator function.
215222{-# INLINE newArrayAlignedAllocWith #-}
216−newArrayAlignedAllocWith :: forall a. Storable a
217− => (Int -> Int -> IO (ForeignPtr a)) -> Int -> Int -> IO (Array a)
223+newArrayAlignedAllocWith :: forall m a. (MonadIO m, Storable a)
224+ => (Int -> Int -> m (ForeignPtr a)) -> Int -> Int -> m (Array a)
218225newArrayAlignedAllocWith alloc alignSize count = do
219226 let size = count * sizeOf (undefined :: a)
220227 fptr <- alloc size alignSize
@@ -230,13 +237,23 @@ newArrayAlignedAllocWith alloc alignSize count = do
230237-- This could be useful in allocate once global data structures. Use carefully
231238-- as incorrect use can lead to memory leak.
232239{-# INLINE newArrayAlignedUnmanaged #-}
233−newArrayAlignedUnmanaged :: forall a. Storable a => Int -> Int -> IO (Array a)
240+newArrayAlignedUnmanaged :: (MonadIO m, Storable a) => Int -> Int -> m (Array a)
234241newArrayAlignedUnmanaged =
235− newArrayAlignedAllocWith Malloc.mallocForeignPtrAlignedUnmanagedBytes
242+ newArrayAlignedAllocWith mallocForeignPtrAlignedUnmanagedBytes
243+
244+ where
245+
246+ mallocForeignPtrAlignedUnmanagedBytes size alignSize =
247+ liftIO $ Malloc.mallocForeignPtrAlignedUnmanagedBytes size alignSize
236248
237249{-# INLINE newArrayAligned #-}
238−newArrayAligned :: forall a. Storable a => Int -> Int -> IO (Array a)
239−newArrayAligned = newArrayAlignedAllocWith Malloc.mallocForeignPtrAlignedBytes
250+newArrayAligned :: (MonadIO m, Storable a) => Int -> Int -> m (Array a)
251+newArrayAligned = newArrayAlignedAllocWith mallocForeignPtrAlignedBytes
252+
253+ where
254+
255+ mallocForeignPtrAlignedBytes size alignSize =
256+ liftIO $ Malloc.mallocForeignPtrAlignedBytes size alignSize
240257
241258-- XXX can unaligned allocation be more efficient when alignment is not needed?
242259--
@@ -246,52 +263,54 @@ newArrayAligned = newArrayAlignedAllocWith Malloc.mallocForeignPtrAlignedBytes
246263-- Note that this is internal routine, the reference to this array cannot be
247264-- given out until the array has been written to and frozen.
248265{-# INLINE newArray #-}
249−newArray :: forall a. Storable a => Int -> IO (Array a)
266+newArray :: forall m a. (MonadIO m, Storable a) => Int -> m (Array a)
250267newArray = newArrayAligned (alignment (undefined :: a))
251268
252269-- | Allocate an Array of the given size and run an IO action passing the array
253270-- start pointer.
254271{-# INLINE unsafeWithNewArray #-}
255−unsafeWithNewArray :: forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Array a)
272+unsafeWithNewArray ::
273+ (MonadIO m, Storable a) => Int -> (Ptr a -> m ()) -> m (Array a)
256274unsafeWithNewArray count f = do
257275 arr <- newArray count
258− unsafeWithForeignPtr (aStart arr) $ \p -> f p >> return arr
276+ unsafeWithForeignPtrM (aStart arr) $ \p -> f p >> return arr
259277
260278-------------------------------------------------------------------------------
261279-- Mutation
262280-------------------------------------------------------------------------------
263281
264282{-# INLINE unsafeWriteIndex #-}
265−unsafeWriteIndex :: forall a. Storable a => Array a -> Int -> a -> IO ()
283+unsafeWriteIndex :: forall m a. (MonadIO m, Storable a)
284+ => Array a -> Int -> a -> m ()
266285unsafeWriteIndex Array {..} i x =
267− unsafeWithForeignPtr aStart
286+ unsafeWithForeignPtrM aStart
268287 $ \begin -> do
269− poke (begin `plusPtr` (i * sizeOf (undefined :: a))) x
288+ liftIO $ poke (begin `plusPtr` (i * sizeOf (undefined :: a))) x
270289
271290-- Internal routine for when the array is being created. Appends one item at
272291-- the end of the array. Useful when sequentially writing a stream to the
273292-- array.
274293{-# INLINE unsafeSnoc #-}
275−unsafeSnoc :: forall a. Storable a => Array a -> a -> IO (Array a)
276−unsafeSnoc arr@Array {..} x = do
294+unsafeSnoc :: forall m a. (MonadIO m, Storable a) => Array a -> a -> m (Array a)
295+unsafeSnoc arr@Array {..} x = liftIO $ do
277296 when (aEnd == aBound) $ error "BUG: unsafeSnoc: writing beyond array bounds"
278297 poke aEnd x
279298 touchForeignPtr aStart
280299 return $ arr {aEnd = aEnd `plusPtr` sizeOf (undefined :: a)}
281300
282301{-# INLINE snoc #-}
283−snoc :: forall a. Storable a => Array a -> a -> IO (Array a)
302+snoc :: forall m a. (MonadIO m, Storable a) => Array a -> a -> m (Array a)
284303snoc arr@Array {..} x =
285304 if aEnd == aBound
286305 then do
287306 let oldStart = unsafeForeignPtrToPtr aStart
288307 size = aEnd `minusPtr` oldStart
289308 newSize = size + sizeOf (undefined :: a)
290− newPtr <-
309+ newPtr <- liftIO $
291310 Malloc.mallocForeignPtrAlignedBytes
292311 newSize
293312 (alignment (undefined :: a))
294− unsafeWithForeignPtr newPtr $ \pNew -> do
313+ unsafeWithForeignPtrM newPtr $ \pNew -> liftIO $ do
295314 memcpy (castPtr pNew) (castPtr oldStart) size
296315 poke (pNew `plusPtr` size) x
297316 touchForeignPtr aStart
@@ -301,7 +320,7 @@ snoc arr@Array {..} x =
301320 , aEnd = pNew `plusPtr` (size + sizeOf (undefined :: a))
302321 , aBound = pNew `plusPtr` newSize
303322 }
304− else do
323+ else liftIO $ do
305324 poke aEnd x
306325 touchForeignPtr aStart
307326 return $ arr {aEnd = aEnd `plusPtr` sizeOf (undefined :: a)}
@@ -313,13 +332,13 @@ snoc arr@Array {..} x =
313332-- | Reallocate the array to the specified size in bytes. If the size is less
314333-- than the original array the array gets truncated.
315334{-# NOINLINE reallocAligned #-}
316−reallocAligned :: Int -> Int -> Array a -> IO (Array a)
335+reallocAligned :: MonadIO m => Int -> Int -> Array a -> m (Array a)
317336reallocAligned alignSize newSize Array{..} = do
318337 assert (aEnd <= aBound) (return ())
319338 let oldStart = unsafeForeignPtrToPtr aStart
320339 let size = aEnd `minusPtr` oldStart
321− newPtr <- Malloc.mallocForeignPtrAlignedBytes newSize alignSize
322− unsafeWithForeignPtr newPtr $ \pNew -> do
340+ newPtr <- liftIO $ Malloc.mallocForeignPtrAlignedBytes newSize alignSize
341+ unsafeWithForeignPtrM newPtr $ \pNew -> liftIO $ do
323342 memcpy (castPtr pNew) (castPtr oldStart) size
324343 touchForeignPtr aStart
325344 return $ Array
@@ -330,11 +349,11 @@ reallocAligned alignSize newSize Array{..} = do
330349
331350-- XXX can unaligned allocation be more efficient when alignment is not needed?
332351{-# INLINABLE realloc #-}
333−realloc :: forall a. Storable a => Int -> Array a -> IO (Array a)
334−realloc = reallocAligned (alignment (undefined :: a))
352+realloc :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m (Array a)
353+realloc i arr = liftIO $ reallocAligned (alignment (undefined :: a)) i arr
335354
336355-- | Remove the free space from an Array.
337−shrinkToFit :: forall a. Storable a => Array a -> IO (Array a)
356+shrinkToFit :: (MonadIO m, Storable a) => Array a -> m (Array a)
338357shrinkToFit arr@Array{..} = do
339358 assert (aEnd <= aBound) (return ())
340359 let start = unsafeForeignPtrToPtr aStart
@@ -354,14 +373,14 @@ shrinkToFit arr@Array{..} = do
354373--
355374-- Unsafe because it does not check the bounds of the array.
356375{-# INLINE_NORMAL unsafeIndex #-}
357−unsafeIndex :: forall a. Storable a => Array a -> Int -> IO a
376+unsafeIndex :: forall m a. (MonadIO m, Storable a) => Array a -> Int -> m a
358377unsafeIndex Array {..} i =
359− unsafeWithForeignPtr aStart $ \p -> do
378+ unsafeWithForeignPtrM aStart $ \p -> do
360379 let elemSize = sizeOf (undefined :: a)
361380 elemOff = p `plusPtr` (elemSize * i)
362381 assert (i >= 0 && elemOff `plusPtr` elemSize <= aEnd)
363382 (return ())
364− peek elemOff
383+ liftIO $ peek elemOff
365384
366385-------------------------------------------------------------------------------
367386-- Size
@@ -741,12 +760,12 @@ foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr
741760
742761{-# INLINE_NORMAL writeNAllocWith #-}
743762writeNAllocWith :: forall m a. (MonadIO m, Storable a)
744− => (Int -> IO (Array a)) -> Int -> Fold m a (Array a)
763+ => (Int -> m (Array a)) -> Int -> Fold m a (Array a)
745764writeNAllocWith alloc n = Fold step initial extract
746765
747766 where
748767
749− initial = FL.Partial <$> liftIO (alloc (max n 0))
768+ initial = FL.Partial <$> alloc (max n 0)
750769 step arr@(Array _ end bound) _ | end == bound = return $ FL.Done arr
751770 step (Array start end bound) x = do
752771 liftIO $ poke end x
@@ -929,7 +948,7 @@ fromStreamDN limit str = do
929948--
930949-- @since 0.7.0
931950{-# INLINABLE fromListN #-}
932−fromListN :: Storable a => Int -> [a] -> IO (Array a)
951+fromListN :: (MonadIO m, Storable a) => Int -> [a] -> m (Array a)
933952fromListN n xs = fromStreamDN n $ D.fromList xs
934953
935954-------------------------------------------------------------------------------
@@ -962,7 +981,7 @@ fromStreamD m = do
962981--
963982-- @since 0.7.0
964983{-# INLINABLE fromList #-}
965−fromList :: Storable a => [a] -> IO (Array a)
984+fromList :: (MonadIO m, Storable a) => [a] -> m (Array a)
966985fromList xs = fromStreamD $ D.fromList xs
967986
968987-------------------------------------------------------------------------------