@@ -32,7 +32,7 @@ module Streamly.Memory.Ring
3232 ) where
3333
3434import Control.Exception (assert)
35−import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
35+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, touchForeignPtr)
3636import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
3737import Foreign.Ptr (plusPtr, minusPtr, castPtr)
3838import Foreign.Storable (Storable(..))
@@ -40,6 +40,8 @@ import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)
4040import GHC.Ptr (Ptr(..))
4141import Prelude hiding (length, concat)
4242
43+import Control.Monad.IO.Class (MonadIO(..))
44+
4345import qualified Streamly.Internal.Memory.Array.Types as A
4446
4547-- | A ring buffer is a mutable array of fixed size. Initially the array is
@@ -163,13 +165,21 @@ unsafeFoldRing ptr f z Ring{..} =
163165 x <- peek p
164166 go (f acc x) (p `plusPtr` sizeOf (undefined :: a)) q
165167
168+-- XXX Can we remove MonadIO here?
169+withForeignPtrM :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b
170+withForeignPtrM fp fn = do
171+ r <- fn $ unsafeForeignPtrToPtr fp
172+ liftIO $ touchForeignPtr fp
173+ return r
174+
166175-- | Like unsafeFoldRing but with a monadic step function.
167176{-# INLINE unsafeFoldRingM #-}
168−unsafeFoldRingM :: forall m a b. (Monad m, Storable a)
177+unsafeFoldRingM :: forall m a b. (MonadIO m, Storable a)
169178 => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
170−unsafeFoldRingM ptr f z Ring{..} = go z (unsafeForeignPtrToPtr ringStart) ptr
171− where
172− go !acc !start !end
179+unsafeFoldRingM ptr f z Ring {..} =
180+ withForeignPtrM ringStart $ \x -> go z x ptr
181+ where
182+ go !acc !start !end
173183 | start == end = return acc
174184 | otherwise = do
175185 let !x = A.unsafeInlineIO $ peek start
@@ -181,14 +191,15 @@ unsafeFoldRingM ptr f z Ring{..} = go z (unsafeForeignPtrToPtr ringStart) ptr
181191-- this would fold the ring starting from the oldest item to the newest item in
182192-- the ring.
183193{-# INLINE unsafeFoldRingFullM #-}
184−unsafeFoldRingFullM :: forall m a b. (Monad m, Storable a)
194+unsafeFoldRingFullM :: forall m a b. (MonadIO m, Storable a)
185195 => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
186−unsafeFoldRingFullM rh f z rb@Ring{..} = go z rh
187− where
188− go !acc !start = do
189− let !x = A.unsafeInlineIO $ peek start
190− acc' <- f acc x
191− let ptr = advance rb start
192− if ptr == rh
196+unsafeFoldRingFullM rh f z rb@Ring {..} =
197+ withForeignPtrM ringStart $ \_ -> go z rh
198+ where
199+ go !acc !start = do
200+ let !x = A.unsafeInlineIO $ peek start
201+ acc' <- f acc x
202+ let ptr = advance rb start
203+ if ptr == rh
193204 then return acc'
194205 else go acc' ptr