311f8b0 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Remove all unsafe IO from Array.Foreign.Mut.Type

311f8b0Adithya Kumar5 years ago

src/Streamly/Internal/Data/Array/Foreign.hs+36−16

compare with master

unifiedsplit

@@ -1,5 +1,3 @@

1−{-# LANGUAGE UnboxedTuples #-}

2−

3#include "inline.hs"

1#include "inline.hs"

5-- |

3-- |

@@ -132,13 +130,12 @@ import Prelude hiding (length, null, last, map, (!!), read, concat)

132

130

133import GHC.ForeignPtr (ForeignPtr(..))

131import GHC.ForeignPtr (ForeignPtr(..))

134import GHC.Ptr (Ptr(..))

132import GHC.Ptr (Ptr(..))

135−import GHC.Prim (touch#)

136−import GHC.IO (IO(..))

137

133

138−import Streamly.Internal.Data.Array.Foreign.Mut.Type (arrayToFptrContents)

134+import Streamly.Internal.Data.Array.Foreign.Mut.Type

135+ (ReadUState(..), arrayToFptrContents, touch, fptrToArrayContents)

139import Streamly.Internal.Data.Array.Foreign.Type (Array(..), length)

136import Streamly.Internal.Data.Array.Foreign.Type (Array(..), length)

140import Streamly.Internal.Data.Fold.Type (Fold(..))

137import Streamly.Internal.Data.Fold.Type (Fold(..))

141−import Streamly.Internal.Data.Producer.Type (Producer)

138+import Streamly.Internal.Data.Producer.Type (Producer(..))

142import Streamly.Internal.Data.Stream.Serial (SerialT(..))

139import Streamly.Internal.Data.Stream.Serial (SerialT(..))

143import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))

140import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))

144import Streamly.Internal.Data.Unfold.Type (Unfold(..))

141import Streamly.Internal.Data.Unfold.Type (Unfold(..))

@@ -148,10 +145,11 @@ import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA

148import qualified Streamly.Internal.Data.Array.Foreign.Mut as MA

145import qualified Streamly.Internal.Data.Array.Foreign.Mut as MA

149import qualified Streamly.Internal.Data.Array.Foreign.Type as A

146import qualified Streamly.Internal.Data.Array.Foreign.Type as A

150import qualified Streamly.Internal.Data.Fold as FL

147import qualified Streamly.Internal.Data.Fold as FL

148+import qualified Streamly.Internal.Data.Producer as Producer

149+import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream

151import qualified Streamly.Internal.Data.Stream.Prelude as P

150import qualified Streamly.Internal.Data.Stream.Prelude as P

152import qualified Streamly.Internal.Data.Stream.StreamD as D

151import qualified Streamly.Internal.Data.Stream.StreamD as D

153import qualified Streamly.Internal.Data.Unfold as Unfold

152import qualified Streamly.Internal.Data.Unfold as Unfold

154−import qualified Streamly.Internal.Data.Producer.Type as Producer

155import qualified Streamly.Internal.Ring.Foreign as RB

153import qualified Streamly.Internal.Ring.Foreign as RB

156

154

157-------------------------------------------------------------------------------

155-------------------------------------------------------------------------------

@@ -187,6 +185,32 @@ fromStream (SerialT m) = P.fold A.write m

187-- Elimination

185-- Elimination

188-------------------------------------------------------------------------------

186-------------------------------------------------------------------------------

189

187

188+{-# INLINE_NORMAL producer #-}

189+producer :: forall m a. (Monad m, Storable a) => Producer m (Array a) a

190+producer = Producer step inject extract

191+ where

192+

193+ {-# INLINE inject #-}

194+ inject (Array contents start end) = return $ ReadUState contents end start

195+

196+ {-# INLINE_LATE step #-}

197+ step (ReadUState contents end cur)

198+ | assert (cur <= end) (cur == end) =

199+ let x = unsafeInlineIO $ touch contents

200+ in x `seq` return D.Stop

201+ step (ReadUState contents end cur) = do

202+ -- unsafeInlineIO allows us to run this in Identity monad for pure

203+ -- toList/foldr case which makes them much faster due to not

204+ -- accumulating the list and fusing better with the pure consumers.

205+ --

206+ -- This should be safe as the array contents are guaranteed to be

207+ -- evaluated/written to before we peek at them.

208+ let !x = unsafeInlineIO $ peek cur

209+ cur1 = cur `plusPtr` sizeOf (undefined :: a)

210+ return $ D.Yield x (ReadUState contents end cur1)

211+

212+ extract (ReadUState contents end cur) = return $ Array contents cur end

213+

190-- | Unfold an array into a stream.

214-- | Unfold an array into a stream.

191--

215--

192-- /Since 0.7.0 (Streamly.Memory.Array)/

216-- /Since 0.7.0 (Streamly.Memory.Array)/

@@ -194,11 +218,7 @@ fromStream (SerialT m) = P.fold A.write m

194-- @since 0.8.0

218-- @since 0.8.0

195{-# INLINE_NORMAL read #-}

219{-# INLINE_NORMAL read #-}

196read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a

220read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a

197−read = Unfold.lmap A.unsafeThaw MA.read

221+read = Producer.simplify producer

198−

199−{-# INLINE_NORMAL producer #-}

200−producer :: forall m a. (Monad m, Storable a) => Producer m (Array a) a

201−producer = Producer.translate A.unsafeThaw A.unsafeFreeze MA.producer

202

222

203-- | Unfold an array into a stream, does not check the end of the array, the

223-- | Unfold an array into a stream, does not check the end of the array, the

204-- user is responsible for terminating the stream within the array bounds. For

224-- user is responsible for terminating the stream within the array bounds. For

@@ -229,13 +249,11 @@ unsafeRead = Unfold step inject

229 -- evaluated/written to before we peek at them.

249 -- evaluated/written to before we peek at them.

230 let !x = unsafeInlineIO $ do

250 let !x = unsafeInlineIO $ do

231 r <- peek (Ptr p)

251 r <- peek (Ptr p)

232− touch contents

252+ touch (fptrToArrayContents contents)

233 return r

253 return r

234 let !(Ptr p1) = Ptr p `plusPtr` sizeOf (undefined :: a)

254 let !(Ptr p1) = Ptr p `plusPtr` sizeOf (undefined :: a)

235 return $ D.Yield x (ForeignPtr p1 contents)

255 return $ D.Yield x (ForeignPtr p1 contents)

236

256

237− touch r = IO $ \s -> case touch# r s of s' -> (# s', () #)

238−

239-- |

257-- |

240--

258--

241-- >>> import qualified Streamly.Internal.Data.Array.Foreign.Type as Array

259-- >>> import qualified Streamly.Internal.Data.Array.Foreign.Type as Array

@@ -379,7 +397,9 @@ getSliceUnsafe index len (Array contents start e) =

379splitOn :: (Monad m, Storable a) =>

397splitOn :: (Monad m, Storable a) =>

380 (a -> Bool) -> Array a -> SerialT m (Array a)

398 (a -> Bool) -> Array a -> SerialT m (Array a)

381splitOn predicate arr =

399splitOn predicate arr =

382− fmap A.unsafeFreeze $ MA.splitOn predicate (A.unsafeThaw arr)

400+ IsStream.fromStreamD

401+ $ fmap (\(i, len) -> getSliceUnsafe i len arr)

402+ $ D.sliceOnSuffix predicate (A.toStreamD arr)

383

403

384{-# INLINE genSlicesFromLen #-}

404{-# INLINE genSlicesFromLen #-}

385genSlicesFromLen :: forall m a. (Monad m, Storable a)

405genSlicesFromLen :: forall m a. (Monad m, Storable a)

src/Streamly/Internal/Data/Array/Foreign/Mut.hs+2−1

@@ -40,13 +40,14 @@ import Streamly.Internal.Data.Stream.IsStream.Type (SerialT)

40import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream

41import qualified Streamly.Internal.Data.Unfold as Unfold

42import Streamly.Internal.Data.Unfold.Type (Unfold(..))

43+import Control.Monad.IO.Class (MonadIO(..))

44-- | Split the array into a stream of slices using a predicate. The element

45-- | Split the array into a stream of slices using a predicate. The element

45-- matching the predicate is dropped.

46-- matching the predicate is dropped.

46--

47--

47-- /Pre-release/

48-- /Pre-release/

48{-# INLINE splitOn #-}

49{-# INLINE splitOn #-}

49−splitOn :: (Monad m, Storable a) =>

50+splitOn :: (MonadIO m, Storable a) =>

50 (a -> Bool) -> Array a -> SerialT m (Array a)

51 (a -> Bool) -> Array a -> SerialT m (Array a)

51splitOn predicate arr =

52splitOn predicate arr =

52 IsStream.fromStreamD

53 IsStream.fromStreamD

src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+56−84

@@ -103,7 +103,7 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type

103 -- * Eliminating and Reading

104

105 -- ** To streams

106− , ReadUState

106+ , ReadUState(..)

107 , read

108 , readRev

109

@@ -212,7 +212,6 @@ import Control.DeepSeq (NFData(..))

212import Control.Monad (when, void)

213import Control.Monad.IO.Class (MonadIO(..))

214import Data.Bits ((.&.))

215−import Data.Functor.Identity (Identity(runIdentity))

216#if __GLASGOW_HASKELL__ < 808

215#if __GLASGOW_HASKELL__ < 808

217import Data.Semigroup (Semigroup(..))

216import Data.Semigroup (Semigroup(..))

218#endif

217#endif

@@ -225,7 +224,7 @@ import Foreign.Marshal.Alloc (mallocBytes)

225import Foreign.Ptr (plusPtr, minusPtr, castPtr, nullPtr)

224import Foreign.Ptr (plusPtr, minusPtr, castPtr, nullPtr)

226import Foreign.Storable (Storable(..))

225import Foreign.Storable (Storable(..))

227import GHC.Base

226import GHC.Base

228− ( build, touch#, IO(..), byteArrayContents#

227+ ( touch#, IO(..), byteArrayContents#

229 , Int(..), newAlignedPinnedByteArray#

228 , Int(..), newAlignedPinnedByteArray#

230 )

229 )

231#ifndef USE_FOREIGN_PTR

230#ifndef USE_FOREIGN_PTR

@@ -248,8 +247,7 @@ import Streamly.Internal.Data.Fold.Type (Fold(..))

248import Streamly.Internal.Data.Producer.Type (Producer (..))

247import Streamly.Internal.Data.Producer.Type (Producer (..))

249import Streamly.Internal.Data.SVar.Type (adaptState)

248import Streamly.Internal.Data.SVar.Type (adaptState)

250import Streamly.Internal.Data.Unfold.Type (Unfold(..))

249import Streamly.Internal.Data.Unfold.Type (Unfold(..))

251−import Streamly.Internal.System.IO

250+import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)

252− (defaultChunkSize, arrayPayloadSize, unsafeInlineIO)

253import System.IO.Unsafe (unsafePerformIO)

251import System.IO.Unsafe (unsafePerformIO)

254

252

255#ifdef DEVBUILD

253#ifdef DEVBUILD

@@ -1371,24 +1369,18 @@ toReadUState (Array contents start end _) = ReadUState contents end start

1371-- | Resumable unfold of an array.

1369-- | Resumable unfold of an array.

1372--

1370--

1373{-# INLINE_NORMAL producer #-}

1371{-# 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

1375producer = Producer step (return . toReadUState) extract

1373producer = Producer step (return . toReadUState) extract

1376 where

1374 where

1377

1375

1378 {-# INLINE_LATE step #-}

1376 {-# INLINE_LATE step #-}

1379 step (ReadUState contents end cur)

1377 step (ReadUState contents end cur)

1380− | assert (cur <= end) (cur == end) =

1378+ | assert (cur <= end) (cur == end) = do

1381− let x = unsafeInlineIO $ touch contents

1379+ liftIO $ touch contents

1382− in x `seq` return D.Stop

1380+ return D.Stop

1383 step (ReadUState contents end cur) = do

1381 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

1382+ !x <- liftIO $ peek cur

1391− cur1 = cur `plusPtr` sizeOf (undefined :: a)

1383+ let cur1 = cur `plusPtr` sizeOf (undefined :: a)

1392 return $ D.Yield x (ReadUState contents end cur1)

1384 return $ D.Yield x (ReadUState contents end cur1)

1393

1385

1394 extract (ReadUState contents end cur) = return $ Array contents cur end end

1386 extract (ReadUState contents end cur) = return $ Array contents cur end end

@@ -1397,14 +1389,14 @@ producer = Producer step (return . toReadUState) extract

1397--

1389--

1398-- @since 0.7.0

1390-- @since 0.7.0

1399{-# INLINE_NORMAL read #-}

1391{-# 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

1401read = Producer.simplify producer

1393read = Producer.simplify producer

1402

1394

1403-- | Unfold an array into a stream in reverse order.

1395-- | Unfold an array into a stream in reverse order.

1404--

1396--

1405-- /Pre-release/

1397-- /Pre-release/

1406{-# INLINE_NORMAL readRev #-}

1398{-# 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

1408readRev = Unfold step inject

1400readRev = Unfold step inject

1409 where

1401 where

1410

1402

@@ -1413,17 +1405,11 @@ readRev = Unfold step inject

1413 in return $ ReadUState contents start p

1405 in return $ ReadUState contents start p

1414

1406

1415 {-# INLINE_LATE step #-}

1407 {-# INLINE_LATE step #-}

1416− step (ReadUState contents start p) | p < start =

1408+ step (ReadUState contents start p) | p < start = do

1417− let x = unsafeInlineIO $ touch contents

1409+ liftIO $ touch contents

1418− in x `seq` return D.Stop

1410+ return D.Stop

1419 step (ReadUState contents start p) = do

1411 step (ReadUState contents start p) = do

1420− -- unsafeInlineIO allows us to run this in Identity monad for pure

1412+ x <- liftIO $ peek p

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

1427 let cur = p `plusPtr` negate (sizeOf (undefined :: a))

1413 let cur = p `plusPtr` negate (sizeOf (undefined :: a))

1428 return $ D.Yield x (ReadUState contents start cur)

1414 return $ D.Yield x (ReadUState contents start cur)

1429

1415

@@ -1431,6 +1417,7 @@ readRev = Unfold step inject

1431-- to Lists and streams

1417-- to Lists and streams

1432-------------------------------------------------------------------------------

1418-------------------------------------------------------------------------------

1433

1419

1420+{-

1434-- Use foldr/build fusion to fuse with list consumers

1421-- Use foldr/build fusion to fuse with list consumers

1435-- This can be useful when using the IsList instance

1422-- This can be useful when using the IsList instance

1436{-# INLINE_LATE toListFB #-}

1423{-# INLINE_LATE toListFB #-}

@@ -1452,14 +1439,23 @@ toListFB c n Array{..} = go arrStart

1452 touch arrContents

1439 touch arrContents

1453 return r

1440 return r

1454 in c x (go (p `plusPtr` sizeOf (undefined :: a)))

1441 in c x (go (p `plusPtr` sizeOf (undefined :: a)))

1442+-}

1455

1443

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

1457-- | Convert an 'Array' into a list.

1446-- | Convert an 'Array' into a list.

1458--

1447--

1459-- @since 0.7.0

1448-- @since 0.7.0

1460{-# INLINE toList #-}

1449{-# INLINE toList #-}

1461−toList :: Storable a => Array a -> [a]

1450+toList :: forall m a. (MonadIO m, Storable a) => Array a -> m [a]

1462−toList s = build (\c n -> toListFB c n s)

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))

1463

1459

1464-- | Use the 'read' unfold instead.

1460-- | Use the 'read' unfold instead.

1465--

1461--

@@ -1467,48 +1463,31 @@ toList s = build (\c n -> toListFB c n s)

1467--

1463--

1468-- We can try this if the unfold has any performance issues.

1464-- We can try this if the unfold has any performance issues.

1469{-# INLINE_NORMAL toStreamD #-}

1465{-# INLINE_NORMAL toStreamD #-}

1470−toStreamD :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a

1466+toStreamD :: forall m a. (MonadIO m, Storable a) => Array a -> D.Stream m a

1471−toStreamD Array{..} =

1467+toStreamD Array{..} = D.Stream step arrStart

1472− let p = arrStart

1473− in D.Stream step p

1474

1468

1475 where

1469 where

1476

1470

1477 {-# INLINE_LATE step #-}

1471 {-# INLINE_LATE step #-}

1478 step _ p | assert (p <= aEnd) (p == aEnd) = return D.Stop

1472 step _ p | assert (p <= aEnd) (p == aEnd) = return D.Stop

1479− step _ p = do

1473+ step _ p = liftIO $ 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

1474+ r <- peek p

1491− touch arrContents

1475+ touch arrContents

1492− return r

1493− return $ D.Yield x (p `plusPtr` sizeOf (undefined :: a))

1476+ return $ D.Yield r (p `plusPtr` sizeOf (undefined :: a))

1494

1477

1495{-# INLINE toStreamK #-}

1478{-# INLINE toStreamK #-}

1496−toStreamK :: forall m a. Storable a => Array a -> K.Stream m a

1479+toStreamK :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a

1497−toStreamK Array{..} =

1480+toStreamK Array{..} = go arrStart

1498− let p = arrStart

1499− in go p

1500

1481

1501 where

1482 where

1502

1483

1503 go p | assert (p <= aEnd) (p == aEnd) = K.nil

1484 go p | assert (p <= aEnd) (p == aEnd) = K.nil

1504 | otherwise =

1485 | otherwise =

1505− -- See Note in toStreamD.

1486+ let elemM = do

1506− -- XXX May not be safe for mutable arrays.

1507− let !x = unsafeInlineIO $ do

1508− r <- peek p

1487+ r <- peek p

1509− touch arrContents

1488+ touch arrContents

1510− return r

1489+ return r

1511− in x `K.cons` go (p `plusPtr` sizeOf (undefined :: a))

1490+ in liftIO elemM `K.consM` go (p `plusPtr` sizeOf (undefined :: a))

1512

1491

1513-- | Use the 'readRev' unfold instead.

1492-- | Use the 'readRev' unfold instead.

1514--

1493--

@@ -1516,7 +1495,7 @@ toStreamK Array{..} =

1516--

1495--

1517-- We can try this if the unfold has any perf issues.

1496-- We can try this if the unfold has any perf issues.

1518{-# INLINE_NORMAL toStreamDRev #-}

1497{-# 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

1520toStreamDRev Array{..} =

1499toStreamDRev Array{..} =

1521 let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))

1500 let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))

1522 in D.Stream step p

1501 in D.Stream step p

@@ -1525,17 +1504,13 @@ toStreamDRev Array{..} =

1525

1504

1526 {-# INLINE_LATE step #-}

1505 {-# INLINE_LATE step #-}

1527 step _ p | p < arrStart = return D.Stop

1506 step _ p | p < arrStart = return D.Stop

1528− step _ p = do

1507+ step _ p = liftIO $ do

1529− -- See comments in toStreamD for why we use unsafeInlineIO

1530− -- XXX

1531− let !x = unsafeInlineIO $ do

1532− r <- peek p

1508+ r <- peek p

1533− touch arrContents

1509+ touch arrContents

1534− return r

1535− return $ D.Yield x (p `plusPtr` negate (sizeOf (undefined :: a)))

1510+ return $ D.Yield r (p `plusPtr` negate (sizeOf (undefined :: a)))

1536

1511

1537{-# INLINE toStreamKRev #-}

1512{-# 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

1539toStreamKRev Array {..} =

1514toStreamKRev Array {..} =

1540 let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))

1515 let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))

1541 in go p

1516 in go p

@@ -1544,12 +1519,11 @@ toStreamKRev Array {..} =

1544

1519

1545 go p | p < arrStart = K.nil

1520 go p | p < arrStart = K.nil

1546 | otherwise =

1521 | otherwise =

1547− -- XXX

1522+ let elemM = do

1548− let !x = unsafeInlineIO $ do

1549− r <- peek p

1523+ r <- peek p

1550− touch arrContents

1524+ touch arrContents

1551− return r

1525+ return r

1552− in x `K.cons` go (p `plusPtr` negate (sizeOf (undefined :: a)))

1526+ in liftIO elemM `K.consM` go (p `plusPtr` negate (sizeOf (undefined :: a)))

1553

1527

1554-------------------------------------------------------------------------------

1528-------------------------------------------------------------------------------

1555-- Folding

1529-- Folding

@@ -1560,15 +1534,13 @@ toStreamKRev Array {..} =

1560--

1534--

1561-- | Strict left fold of an array.

1535-- | Strict left fold of an array.

1562{-# INLINE_NORMAL foldl' #-}

1536{-# INLINE_NORMAL foldl' #-}

1563−foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b

1537+foldl' :: (MonadIO m, Storable a) => (b -> a -> b) -> b -> Array a -> m b

1564−-- XXX Should be monadic

1565−foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr

1538+foldl' f z arr = D.foldl' f z $ toStreamD arr

1566

1539

1567-- | Right fold of an array.

1540-- | Right fold of an array.

1568{-# INLINE_NORMAL foldr #-}

1541{-# INLINE_NORMAL foldr #-}

1569−-- XXX Should be monadic

1570−foldr :: Storable a => (a -> b -> b) -> b -> Array a -> b

1542+foldr :: (MonadIO m, Storable a) => (a -> b -> b) -> b -> Array a -> m b

1571−foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr

1543+foldr f z arr = D.foldr f z $ toStreamD arr

1572

1544

1573-------------------------------------------------------------------------------

1545-------------------------------------------------------------------------------

1574-- Folds

1546-- Folds

src/Streamly/Internal/Data/Array/Foreign/Type.hs+109−11

@@ -73,6 +73,7 @@ module Streamly.Internal.Data.Array.Foreign.Type

73 )

74where

76+import Control.Exception (assert)

76import Control.DeepSeq (NFData(..))

77import Control.DeepSeq (NFData(..))

77import Control.Monad.IO.Class (MonadIO(..))

78import Control.Monad.IO.Class (MonadIO(..))

78import Data.Functor.Identity (Identity(..))

79import Data.Functor.Identity (Identity(..))

@@ -81,7 +82,7 @@ import Foreign.C.String (CString)

81import Foreign.C.Types (CSize(..))

82import Foreign.C.Types (CSize(..))

82import Foreign.Ptr (plusPtr, castPtr)

83import Foreign.Ptr (plusPtr, castPtr)

83import Foreign.Storable (Storable(..))

84import Foreign.Storable (Storable(..))

84−import GHC.Base (Addr#, nullAddr#)

85+import GHC.Base (Addr#, nullAddr#, build)

85import GHC.Exts (IsList, IsString(..))

86import GHC.Exts (IsList, IsString(..))

87#ifdef DEVBUILD

88#ifdef DEVBUILD

@@ -89,7 +90,8 @@ import GHC.ForeignPtr (touchForeignPtr, unsafeForeignPtrToPtr)

89#endif

90#endif

90import GHC.IO (unsafePerformIO)

91import GHC.IO (unsafePerformIO)

91import GHC.Ptr (Ptr(..))

92import GHC.Ptr (Ptr(..))

92−import Streamly.Internal.Data.Array.Foreign.Mut.Type (ArrayContents)

93+import Streamly.Internal.Data.Array.Foreign.Mut.Type

94+ (ArrayContents, ReadUState(..), touch)

93import Streamly.Internal.Data.Fold.Type (Fold(..))

95import Streamly.Internal.Data.Fold.Type (Fold(..))

94import Streamly.Internal.Data.Stream.Serial (SerialT(..))

96import Streamly.Internal.Data.Stream.Serial (SerialT(..))

95import Streamly.Internal.Data.Unfold.Type (Unfold(..))

97import Streamly.Internal.Data.Unfold.Type (Unfold(..))

@@ -100,7 +102,6 @@ import Prelude hiding (length, foldr, read, unlines, splitAt)

100import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA

102import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA

101import qualified Streamly.Internal.Data.Stream.StreamD.Type as D

103import qualified Streamly.Internal.Data.Stream.StreamD.Type as D

102import qualified Streamly.Internal.Data.Stream.StreamK.Type as K

104import qualified Streamly.Internal.Data.Stream.StreamK.Type as K

103−import qualified Streamly.Internal.Data.Unfold.Type as Unfold

104import qualified GHC.Exts as Exts

105import qualified GHC.Exts as Exts

105

106

106import Streamly.Internal.System.IO (unsafeInlineIO, defaultChunkSize)

107import Streamly.Internal.System.IO (unsafeInlineIO, defaultChunkSize)

@@ -441,23 +442,99 @@ length arr = MA.length (unsafeThaw arr)

441-- @since 0.8.0

442-- @since 0.8.0

442{-# INLINE_NORMAL readRev #-}

443{-# INLINE_NORMAL readRev #-}

443readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a

444readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a

444−readRev = Unfold.lmap unsafeThaw MA.readRev

445+readRev = Unfold step inject

446+ where

447+

448+ inject (Array contents start end) =

449+ let p = end `plusPtr` negate (sizeOf (undefined :: a))

450+ in return $ ReadUState contents start p

451+

452+ {-# INLINE_LATE step #-}

453+ step (ReadUState contents start p) | p < start =

454+ let x = unsafeInlineIO $ touch contents

455+ in x `seq` return D.Stop

456+ step (ReadUState contents start p) = do

457+ -- unsafeInlineIO allows us to run this in Identity monad for pure

458+ -- toList/foldr case which makes them much faster due to not

459+ -- accumulating the list and fusing better with the pure consumers.

460+ --

461+ -- This should be safe as the array contents are guaranteed to be

462+ -- evaluated/written to before we peek at them.

463+ let !x = unsafeInlineIO $ peek p

464+ let cur = p `plusPtr` negate (sizeOf (undefined :: a))

465+ return $ D.Yield x (ReadUState contents start cur)

466+

445

467

446{-# INLINE_NORMAL toStreamD #-}

468{-# INLINE_NORMAL toStreamD #-}

447toStreamD :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a

469toStreamD :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a

448−toStreamD arr = MA.toStreamD (unsafeThaw arr)

470+toStreamD Array{..} = D.Stream step arrStart

471+

472+ where

473+

474+ {-# INLINE_LATE step #-}

475+ step _ p | assert (p <= aEnd) (p == aEnd) = return D.Stop

476+ step _ p = do

477+ -- unsafeInlineIO allows us to run this in Identity monad for pure

478+ -- toList/foldr case which makes them much faster due to not

479+ -- accumulating the list and fusing better with the pure consumers.

480+ --

481+ -- This should be safe as the array contents are guaranteed to be

482+ -- evaluated/written to before we peek at them.

483+ --

484+ let !x = unsafeInlineIO $ do

485+ r <- peek p

486+ touch arrContents

487+ return r

488+ return $ D.Yield x (p `plusPtr` sizeOf (undefined :: a))

449

489

450{-# INLINE toStreamK #-}

490{-# INLINE toStreamK #-}

451toStreamK :: forall m a. Storable a => Array a -> K.Stream m a

491toStreamK :: forall m a. Storable a => Array a -> K.Stream m a

452−toStreamK arr = MA.toStreamK (unsafeThaw arr)

492+toStreamK Array{..} = go arrStart

493+

494+ where

495+

496+ go p | assert (p <= aEnd) (p == aEnd) = K.nil

497+ | otherwise =

498+ -- See Note in toStreamD.

499+ let !x = unsafeInlineIO $ do

500+ r <- peek p

501+ touch arrContents

502+ return r

503+ in x `K.cons` go (p `plusPtr` sizeOf (undefined :: a))

453

504

454{-# INLINE_NORMAL toStreamDRev #-}

505{-# INLINE_NORMAL toStreamDRev #-}

455toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a

506toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a

456−toStreamDRev arr = MA.toStreamDRev (unsafeThaw arr)

507+toStreamDRev Array{..} =

508+ let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))

509+ in D.Stream step p

510+

511+ where

512+

513+ {-# INLINE_LATE step #-}

514+ step _ p | p < arrStart = return D.Stop

515+ step _ p = do

516+ -- See comments in toStreamD for why we use unsafeInlineIO

517+ let !x = unsafeInlineIO $ do

518+ r <- peek p

519+ touch arrContents

520+ return r

521+ return $ D.Yield x (p `plusPtr` negate (sizeOf (undefined :: a)))

457

522

458{-# INLINE toStreamKRev #-}

523{-# INLINE toStreamKRev #-}

459toStreamKRev :: forall m a. Storable a => Array a -> K.Stream m a

524toStreamKRev :: forall m a. Storable a => Array a -> K.Stream m a

460−toStreamKRev arr = MA.toStreamKRev (unsafeThaw arr)

525+toStreamKRev Array {..} =

526+ let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))

527+ in go p

528+

529+ where

530+

531+ go p | p < arrStart = K.nil

532+ | otherwise =

533+ let !x = unsafeInlineIO $ do

534+ r <- peek p

535+ touch arrContents

536+ return r

537+ in x `K.cons` go (p `plusPtr` negate (sizeOf (undefined :: a)))

461

538

462-- | Convert an 'Array' into a stream.

539-- | Convert an 'Array' into a stream.

463--

540--

@@ -482,11 +559,11 @@ toStreamRev = SerialT . D.toStreamK . toStreamDRev

482

559

483{-# INLINE_NORMAL foldl' #-}

560{-# INLINE_NORMAL foldl' #-}

484foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b

561foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b

485−foldl' f z arr = MA.foldl' f z (unsafeThaw arr)

562+foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr

486

563

487{-# INLINE_NORMAL foldr #-}

564{-# INLINE_NORMAL foldr #-}

488foldr :: Storable a => (a -> b -> b) -> b -> Array a -> b

565foldr :: Storable a => (a -> b -> b) -> b -> Array a -> b

489−foldr f z arr = MA.foldr f z (unsafeThaw arr)

566+foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr

490

567

491-- | Create two slices of an array without copying the original array. The

568-- | Create two slices of an array without copying the original array. The

492-- specified index @i@ is the first index of the second slice.

569-- specified index @i@ is the first index of the second slice.

@@ -497,6 +574,27 @@ splitAt i arr = (unsafeFreeze a, unsafeFreeze b)

497 where

574 where

498 (a, b) = MA.splitAt i (unsafeThaw arr)

575 (a, b) = MA.splitAt i (unsafeThaw arr)

499

576

577+-- Use foldr/build fusion to fuse with list consumers

578+-- This can be useful when using the IsList instance

579+{-# INLINE_LATE toListFB #-}

580+toListFB :: forall a b. Storable a => (a -> b -> b) -> b -> Array a -> b

581+toListFB c n Array{..} = go arrStart

582+ where

583+

584+ go p | assert (p <= aEnd) (p == aEnd) = n

585+ go p =

586+ -- unsafeInlineIO allows us to run this in Identity monad for pure

587+ -- toList/foldr case which makes them much faster due to not

588+ -- accumulating the list and fusing better with the pure consumers.

589+ --

590+ -- This should be safe as the array contents are guaranteed to be

591+ -- evaluated/written to before we peek at them.

592+ let !x = unsafeInlineIO $ do

593+ r <- peek p

594+ touch arrContents

595+ return r

596+ in c x (go (p `plusPtr` sizeOf (undefined :: a)))

597+

500-- | Convert an 'Array' into a list.

598-- | Convert an 'Array' into a list.

501--

599--

502-- /Since 0.7.0 (Streamly.Memory.Array)/

600-- /Since 0.7.0 (Streamly.Memory.Array)/

@@ -504,7 +602,7 @@ splitAt i arr = (unsafeFreeze a, unsafeFreeze b)

504-- @since 0.8.0

602-- @since 0.8.0

505{-# INLINE toList #-}

603{-# INLINE toList #-}

506toList :: Storable a => Array a -> [a]

604toList :: Storable a => Array a -> [a]

507−toList = MA.toList . unsafeThaw

605+toList s = build (\c n -> toListFB c n s)

508

606

509-------------------------------------------------------------------------------

607-------------------------------------------------------------------------------

510-- Folds

608-- Folds