@@ -98,14 +98,14 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type
9898 -- ** To streams
9999 , ReadUState(..)
100100 , read
101− , readRev_
101+ , readRevWith
102102 , readRev
103103
104104 -- ** To containers
105− , toStreamD_
106− , toStreamDRev_
107− , toStreamK_
108− , toStreamKRev_
105+ , toStreamDWith
106+ , toStreamDRevWith
107+ , toStreamKWith
108+ , toStreamKRevWith
109109 , toStreamD
110110 , toStreamDRev
111111 , toStreamK
@@ -113,6 +113,7 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type
113113 , toList
114114
115115 -- experimental
116+ , producerWith
116117 , producer
117118
118119 -- ** Random reads
@@ -203,6 +204,10 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type
203204 )
204205where
205206
207+-- Notes:
208+-- When we use a purely lazy Monad like Identity, we need to force ordering of
209+-- some actions for correctness.
210+
206211#include "inline.hs"
207212#include "ArrayMacros.h"
208213#include "MachDeps.h"
@@ -1516,24 +1521,36 @@ data ReadUState a = ReadUState
15161521toReadUState :: Array a -> ReadUState a
15171522toReadUState (Array contents start end _) = ReadUState contents end start
15181523
1519−-- | Resumable unfold of an array.
1520−--
1521−{-# INLINE_NORMAL producer #-}
1522−producer :: forall m a. (MonadIO m, Storable a) => Producer m (Array a) a
1523−producer = Producer step (return . toReadUState) extract
1524+{-# INLINE_NORMAL producerWith #-}
1525+producerWith ::
1526+ forall m a. (Monad m, Storable a)
1527+ => (forall b. IO b -> m b) -> Producer m (Array a) a
1528+producerWith liftio = Producer step (return . toReadUState) extract
15241529 where
15251530
15261531 {-# INLINE_LATE step #-}
15271532 step (ReadUState contents end cur)
1528− | assert (cur <= end) (cur == end) = do
1529− liftIO $ touch contents
1533+ | assert (cur <= end) (cur == end) = liftio $ do
1534+ -- We bind it strictly here as we don't want this to be optimized
1535+ -- out in a purely lazy monad like Identity.
1536+ !_ <- touch contents
15301537 return D.Stop
15311538 step (ReadUState contents end cur) = do
1532− !x <- liftIO $ peek cur
1539+ -- When we use a purely lazy Monad like Identity, we need to force a
1540+ -- few actions for correctness and execution order sanity. We want
1541+ -- the peek to occur right here and not lazily at some later point
1542+ -- because we want the peek to be ordered with respect to the touch.
1543+ !x <- liftio $ peek cur
15331544 return $ D.Yield x (ReadUState contents end (PTR_NEXT(cur,a)))
15341545
15351546 extract (ReadUState contents end cur) = return $ Array contents cur end end
15361547
1548+-- | Resumable unfold of an array.
1549+--
1550+{-# INLINE_NORMAL producer #-}
1551+producer :: forall m a. (MonadIO m, Storable a) => Producer m (Array a) a
1552+producer = producerWith liftIO
1553+
15371554-- | Unfold an array into a stream.
15381555--
15391556-- @since 0.7.0
@@ -1541,11 +1558,11 @@ producer = Producer step (return . toReadUState) extract
15411558read :: forall m a. (MonadIO m, Storable a) => Unfold m (Array a) a
15421559read = Producer.simplify producer
15431560
1544−{-# INLINE_NORMAL readRev_ #-}
1545−readRev_ ::
1561+{-# INLINE_NORMAL readRevWith #-}
1562+readRevWith ::
15461563 forall m a. (Monad m, Storable a)
15471564 => (forall b. IO b -> m b) -> Unfold m (Array a) a
1548−readRev_ liftio = Unfold step inject
1565+readRevWith liftio = Unfold step inject
15491566 where
15501567
15511568 inject (Array contents start end _) =
@@ -1553,16 +1570,11 @@ readRev_ liftio = Unfold step inject
15531570 in return $ ReadUState contents start p
15541571
15551572 {-# INLINE_LATE step #-}
1556− step (ReadUState contents start p) | p < start = do
1557− -- Is the following replicated properly?
1558− -- let x = unsafeInlineIO $ touch contents
1559− -- in x `seq` return D.Stop
1560− liftio $ touch contents
1573+ step (ReadUState contents start p) | p < start = liftio $ do
1574+ !_ <- touch contents
15611575 return D.Stop
1562− -- unit <- liftio $ touch contents
1563− -- unit `seq` return D.Stop
15641576 step (ReadUState contents start p) = do
1565− x <- liftio $ peek p
1577+ !x <- liftio $ peek p
15661578 return $ D.Yield x (ReadUState contents start (PTR_PREV(p,a)))
15671579
15681580-- | Unfold an array into a stream in reverse order.
@@ -1570,7 +1582,7 @@ readRev_ liftio = Unfold step inject
15701582-- /Pre-release/
15711583{-# INLINE_NORMAL readRev #-}
15721584readRev :: forall m a. (MonadIO m, Storable a) => Unfold m (Array a) a
1573−readRev = readRev_ liftIO
1585+readRev = readRevWith liftIO
15741586
15751587-------------------------------------------------------------------------------
15761588-- to Lists and streams
@@ -1616,11 +1628,11 @@ toList Array{..} = liftIO $ go arrStart
16161628 touch arrContents
16171629 (:) x <$> go (PTR_NEXT(p,a))
16181630
1619−{-# INLINE_NORMAL toStreamD_ #-}
1620−toStreamD_ ::
1631+{-# INLINE_NORMAL toStreamDWith #-}
1632+toStreamDWith ::
16211633 forall m a. (Monad m, Storable a)
16221634 => (forall b. IO b -> m b) -> Array a -> D.Stream m a
1623−toStreamD_ liftio Array{..} = D.Stream step arrStart
1635+toStreamDWith liftio Array{..} = D.Stream step arrStart
16241636
16251637 where
16261638
@@ -1638,13 +1650,13 @@ toStreamD_ liftio Array{..} = D.Stream step arrStart
16381650-- We can try this if the unfold has any performance issues.
16391651{-# INLINE_NORMAL toStreamD #-}
16401652toStreamD :: forall m a. (MonadIO m, Storable a) => Array a -> D.Stream m a
1641−toStreamD arr = toStreamD_ liftIO arr
1653+toStreamD = toStreamDWith liftIO
16421654
1643−{-# INLINE toStreamK_ #-}
1644−toStreamK_ ::
1655+{-# INLINE toStreamKWith #-}
1656+toStreamKWith ::
16451657 forall m a. (Monad m, Storable a)
16461658 => (forall b. IO b -> m b) -> Array a -> K.Stream m a
1647−toStreamK_ liftio Array{..} = go arrStart
1659+toStreamKWith liftio Array{..} = go arrStart
16481660
16491661 where
16501662
@@ -1658,13 +1670,13 @@ toStreamK_ liftio Array{..} = go arrStart
16581670
16591671{-# INLINE toStreamK #-}
16601672toStreamK :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a
1661−toStreamK arr = toStreamK_ liftIO arr
1673+toStreamK = toStreamKWith liftIO
16621674
1663−{-# INLINE_NORMAL toStreamDRev_ #-}
1664−toStreamDRev_ ::
1675+{-# INLINE_NORMAL toStreamDRevWith #-}
1676+toStreamDRevWith ::
16651677 forall m a. (Monad m, Storable a)
16661678 => (forall b. IO b -> m b) -> Array a -> D.Stream m a
1667−toStreamDRev_ liftio Array{..} =
1679+toStreamDRevWith liftio Array{..} =
16681680 let p = PTR_PREV(aEnd,a)
16691681 in D.Stream step p
16701682
@@ -1684,13 +1696,13 @@ toStreamDRev_ liftio Array{..} =
16841696-- We can try this if the unfold has any perf issues.
16851697{-# INLINE_NORMAL toStreamDRev #-}
16861698toStreamDRev :: forall m a. (MonadIO m, Storable a) => Array a -> D.Stream m a
1687−toStreamDRev arr = toStreamDRev_ liftIO arr
1699+toStreamDRev = toStreamDRevWith liftIO
16881700
1689−{-# INLINE toStreamKRev_ #-}
1690−toStreamKRev_ ::
1701+{-# INLINE toStreamKRevWith #-}
1702+toStreamKRevWith ::
16911703 forall m a. (Monad m, Storable a)
16921704 => (forall b. IO b -> m b) -> Array a -> K.Stream m a
1693−toStreamKRev_ liftio Array {..} =
1705+toStreamKRevWith liftio Array {..} =
16941706 let p = PTR_PREV(aEnd,a)
16951707 in go p
16961708
@@ -1706,7 +1718,7 @@ toStreamKRev_ liftio Array {..} =
17061718
17071719{-# INLINE toStreamKRev #-}
17081720toStreamKRev :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a
1709−toStreamKRev arr = toStreamKRev_ liftIO arr
1721+toStreamKRev = toStreamKRevWith liftIO
17101722
17111723-------------------------------------------------------------------------------
17121724-- Folding