@@ -103,7 +103,7 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type
103103 -- * Eliminating and Reading
104104
105105 -- ** To streams
106− , ReadUState
106+ , ReadUState(..)
107107 , read
108108 , readRev
109109
@@ -212,7 +212,6 @@ import Control.DeepSeq (NFData(..))
212212import Control.Monad (when, void)
213213import Control.Monad.IO.Class (MonadIO(..))
214214import Data.Bits ((.&.))
215−import Data.Functor.Identity (Identity(runIdentity))
216215#if __GLASGOW_HASKELL__ < 808
217216import Data.Semigroup (Semigroup(..))
218217#endif
@@ -225,7 +224,7 @@ import Foreign.Marshal.Alloc (mallocBytes)
225224import Foreign.Ptr (plusPtr, minusPtr, castPtr, nullPtr)
226225import Foreign.Storable (Storable(..))
227226import GHC.Base
228− ( build, touch#, IO(..), byteArrayContents#
227+ ( touch#, IO(..), byteArrayContents#
229228 , Int(..), newAlignedPinnedByteArray#
230229 )
231230#ifndef USE_FOREIGN_PTR
@@ -248,8 +247,7 @@ import Streamly.Internal.Data.Fold.Type (Fold(..))
248247import Streamly.Internal.Data.Producer.Type (Producer (..))
249248import Streamly.Internal.Data.SVar.Type (adaptState)
250249import Streamly.Internal.Data.Unfold.Type (Unfold(..))
251−import Streamly.Internal.System.IO
252− (defaultChunkSize, arrayPayloadSize, unsafeInlineIO)
250+import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)
253251import System.IO.Unsafe (unsafePerformIO)
254252
255253#ifdef DEVBUILD
@@ -1371,24 +1369,18 @@ toReadUState (Array contents start end _) = ReadUState contents end start
13711369-- | Resumable unfold of an array.
13721370--
13731371{-# INLINE_NORMAL producer #-}
1374−producer :: forall m a. (Monad m, Storable a) => Producer m (Array a) a
1372+producer :: forall m a. (MonadIO m, Storable a) => Producer m (Array a) a
13751373producer = Producer step (return . toReadUState) extract
13761374 where
13771375
13781376 {-# INLINE_LATE step #-}
13791377 step (ReadUState contents end cur)
1380− | assert (cur <= end) (cur == end) =
1381− let x = unsafeInlineIO $ touch contents
1382− in x `seq` return D.Stop
1378+ | assert (cur <= end) (cur == end) = do
1379+ liftIO $ touch contents
1380+ return D.Stop
13831381 step (ReadUState contents end cur) = do
1384− -- unsafeInlineIO allows us to run this in Identity monad for pure
1385− -- toList/foldr case which makes them much faster due to not
1386− -- accumulating the list and fusing better with the pure consumers.
1387− --
1388− -- This should be safe as the array contents are guaranteed to be
1389− -- evaluated/written to before we peek at them.
1390− let !x = unsafeInlineIO $ peek cur
1391− cur1 = cur `plusPtr` sizeOf (undefined :: a)
1382+ !x <- liftIO $ peek cur
1383+ let cur1 = cur `plusPtr` sizeOf (undefined :: a)
13921384 return $ D.Yield x (ReadUState contents end cur1)
13931385
13941386 extract (ReadUState contents end cur) = return $ Array contents cur end end
@@ -1397,14 +1389,14 @@ producer = Producer step (return . toReadUState) extract
13971389--
13981390-- @since 0.7.0
13991391{-# INLINE_NORMAL read #-}
1400−read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a
1392+read :: forall m a. (MonadIO m, Storable a) => Unfold m (Array a) a
14011393read = Producer.simplify producer
14021394
14031395-- | Unfold an array into a stream in reverse order.
14041396--
14051397-- /Pre-release/
14061398{-# INLINE_NORMAL readRev #-}
1407−readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a
1399+readRev :: forall m a. (MonadIO m, Storable a) => Unfold m (Array a) a
14081400readRev = Unfold step inject
14091401 where
14101402
@@ -1413,17 +1405,11 @@ readRev = Unfold step inject
14131405 in return $ ReadUState contents start p
14141406
14151407 {-# INLINE_LATE step #-}
1416− step (ReadUState contents start p) | p < start =
1417− let x = unsafeInlineIO $ touch contents
1418− in x `seq` return D.Stop
1408+ step (ReadUState contents start p) | p < start = do
1409+ liftIO $ touch contents
1410+ return D.Stop
14191411 step (ReadUState contents start p) = do
1420− -- unsafeInlineIO allows us to run this in Identity monad for pure
1421− -- toList/foldr case which makes them much faster due to not
1422− -- accumulating the list and fusing better with the pure consumers.
1423− --
1424− -- This should be safe as the array contents are guaranteed to be
1425− -- evaluated/written to before we peek at them.
1426− let !x = unsafeInlineIO $ peek p
1412+ x <- liftIO $ peek p
14271413 let cur = p `plusPtr` negate (sizeOf (undefined :: a))
14281414 return $ D.Yield x (ReadUState contents start cur)
14291415
@@ -1431,6 +1417,7 @@ readRev = Unfold step inject
14311417-- to Lists and streams
14321418-------------------------------------------------------------------------------
14331419
1420+{-
14341421-- Use foldr/build fusion to fuse with list consumers
14351422-- This can be useful when using the IsList instance
14361423{-# INLINE_LATE toListFB #-}
@@ -1452,14 +1439,23 @@ toListFB c n Array{..} = go arrStart
14521439 touch arrContents
14531440 return r
14541441 in c x (go (p `plusPtr` sizeOf (undefined :: a)))
1442+-}
14551443
1456−-- XXX Should be monadic
1444+-- XXX Monadic foldr/build fusion?
1445+-- Reference: https://www.researchgate.net/publication/220676509_Monadic_augment_and_generalised_short_cut_fusion
14571446-- | Convert an 'Array' into a list.
14581447--
14591448-- @since 0.7.0
14601449{-# INLINE toList #-}
1461−toList :: Storable a => Array a -> [a]
1462−toList s = build (\c n -> toListFB c n s)
1450+toList :: forall m a. (MonadIO m, Storable a) => Array a -> m [a]
1451+toList Array{..} = liftIO $ go arrStart
1452+ where
1453+
1454+ go p | assert (p <= aEnd) (p == aEnd) = return []
1455+ go p = do
1456+ x <- peek p
1457+ touch arrContents
1458+ (:) x <$> go (p `plusPtr` sizeOf (undefined :: a))
14631459
14641460-- | Use the 'read' unfold instead.
14651461--
@@ -1467,48 +1463,31 @@ toList s = build (\c n -> toListFB c n s)
14671463--
14681464-- We can try this if the unfold has any performance issues.
14691465{-# INLINE_NORMAL toStreamD #-}
1470−toStreamD :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a
1471−toStreamD Array{..} =
1472− let p = arrStart
1473− in D.Stream step p
1466+toStreamD :: forall m a. (MonadIO m, Storable a) => Array a -> D.Stream m a
1467+toStreamD Array{..} = D.Stream step arrStart
14741468
14751469 where
14761470
14771471 {-# INLINE_LATE step #-}
14781472 step _ p | assert (p <= aEnd) (p == aEnd) = return D.Stop
1479− step _ p = do
1480− -- unsafeInlineIO allows us to run this in Identity monad for pure
1481− -- toList/foldr case which makes them much faster due to not
1482− -- accumulating the list and fusing better with the pure consumers.
1483− --
1484− -- This should be safe as the array contents are guaranteed to be
1485− -- evaluated/written to before we peek at them.
1486− --
1487− -- XXX This may not be safe for mutable arrays.
1488− --
1489− let !x = unsafeInlineIO $ do
1490− r <- peek p
1491− touch arrContents
1492− return r
1493− return $ D.Yield x (p `plusPtr` sizeOf (undefined :: a))
1473+ step _ p = liftIO $ do
1474+ r <- peek p
1475+ touch arrContents
1476+ return $ D.Yield r (p `plusPtr` sizeOf (undefined :: a))
14941477
14951478{-# INLINE toStreamK #-}
1496−toStreamK :: forall m a. Storable a => Array a -> K.Stream m a
1497−toStreamK Array{..} =
1498− let p = arrStart
1499− in go p
1479+toStreamK :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a
1480+toStreamK Array{..} = go arrStart
15001481
15011482 where
15021483
15031484 go p | assert (p <= aEnd) (p == aEnd) = K.nil
15041485 | otherwise =
1505− -- See Note in toStreamD.
1506− -- XXX May not be safe for mutable arrays.
1507− let !x = unsafeInlineIO $ do
1508− r <- peek p
1509− touch arrContents
1510− return r
1511− in x `K.cons` go (p `plusPtr` sizeOf (undefined :: a))
1486+ let elemM = do
1487+ r <- peek p
1488+ touch arrContents
1489+ return r
1490+ in liftIO elemM `K.consM` go (p `plusPtr` sizeOf (undefined :: a))
15121491
15131492-- | Use the 'readRev' unfold instead.
15141493--
@@ -1516,7 +1495,7 @@ toStreamK Array{..} =
15161495--
15171496-- We can try this if the unfold has any perf issues.
15181497{-# INLINE_NORMAL toStreamDRev #-}
1519−toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a
1498+toStreamDRev :: forall m a. (MonadIO m, Storable a) => Array a -> D.Stream m a
15201499toStreamDRev Array{..} =
15211500 let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))
15221501 in D.Stream step p
@@ -1525,17 +1504,13 @@ toStreamDRev Array{..} =
15251504
15261505 {-# INLINE_LATE step #-}
15271506 step _ p | p < arrStart = return D.Stop
1528− step _ p = do
1529− -- See comments in toStreamD for why we use unsafeInlineIO
1530− -- XXX
1531− let !x = unsafeInlineIO $ do
1532− r <- peek p
1533− touch arrContents
1534− return r
1535− return $ D.Yield x (p `plusPtr` negate (sizeOf (undefined :: a)))
1507+ step _ p = liftIO $ do
1508+ r <- peek p
1509+ touch arrContents
1510+ return $ D.Yield r (p `plusPtr` negate (sizeOf (undefined :: a)))
15361511
15371512{-# INLINE toStreamKRev #-}
1538−toStreamKRev :: forall m a. Storable a => Array a -> K.Stream m a
1513+toStreamKRev :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a
15391514toStreamKRev Array {..} =
15401515 let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))
15411516 in go p
@@ -1544,12 +1519,11 @@ toStreamKRev Array {..} =
15441519
15451520 go p | p < arrStart = K.nil
15461521 | otherwise =
1547− -- XXX
1548− let !x = unsafeInlineIO $ do
1549− r <- peek p
1550− touch arrContents
1551− return r
1552− in x `K.cons` go (p `plusPtr` negate (sizeOf (undefined :: a)))
1522+ let elemM = do
1523+ r <- peek p
1524+ touch arrContents
1525+ return r
1526+ in liftIO elemM `K.consM` go (p `plusPtr` negate (sizeOf (undefined :: a)))
15531527
15541528-------------------------------------------------------------------------------
15551529-- Folding
@@ -1560,15 +1534,13 @@ toStreamKRev Array {..} =
15601534--
15611535-- | Strict left fold of an array.
15621536{-# INLINE_NORMAL foldl' #-}
1563−foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b
1564−-- XXX Should be monadic
1565−foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr
1537+foldl' :: (MonadIO m, Storable a) => (b -> a -> b) -> b -> Array a -> m b
1538+foldl' f z arr = D.foldl' f z $ toStreamD arr
15661539
15671540-- | Right fold of an array.
15681541{-# INLINE_NORMAL foldr #-}
1569−-- XXX Should be monadic
1570−foldr :: Storable a => (a -> b -> b) -> b -> Array a -> b
1571−foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr
1542+foldr :: (MonadIO m, Storable a) => (a -> b -> b) -> b -> Array a -> m b
1543+foldr f z arr = D.foldr f z $ toStreamD arr
15721544
15731545-------------------------------------------------------------------------------
15741546-- Folds