bf8561e · streamly · git.iko.soy

git.iko.soy/streamly

Reuse mutable array code in Foreign.Type

commitbf8561e18ddf1eb5e0a7b9cb96b97b7c9f18c416 authorAdithya Kumar <adithya@composewell.com> dateSat 4 Jun 2022, 02:41 (4 years ago) parent0d5a96e

2 files changed+83−116

compare with master

unifiedsplit

core/src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+74−34 core/src/Streamly/Internal/Data/Array/Foreign/Type.hs+9−82

core/src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+74−34

@@ -98,9 +98,14 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type

9898 -- ** To streams

9999 , ReadUState(..)

100100 , read

101+ , readRev_

101102 , readRev

102103

103104 -- ** To containers

105+ , toStreamD_

106+ , toStreamDRev_

107+ , toStreamK_

108+ , toStreamKRev_

104109 , toStreamD

105110 , toStreamDRev

106111 , toStreamK

@@ -1536,12 +1541,11 @@ producer = Producer step (return . toReadUState) extract

15361541read :: forall m a. (MonadIO m, Storable a) => Unfold m (Array a) a

15371542read = Producer.simplify producer

15381543

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

1540−--

1541−-- /Pre-release/

1542−{-# INLINE_NORMAL readRev #-}

1543−readRev :: forall m a. (MonadIO m, Storable a) => Unfold m (Array a) a

1544−readRev = Unfold step inject

1544+{-# INLINE_NORMAL readRev_ #-}

1545+readRev_ ::

1546+ forall m a. (Monad m, Storable a)

1547+ => (forall b. IO b -> m b) -> Unfold m (Array a) a

1548+readRev_ liftio = Unfold step inject

15451549 where

15461550

15471551 inject (Array contents start end _) =

@@ -1550,12 +1554,24 @@ readRev = Unfold step inject

15501554

15511555 {-# INLINE_LATE step #-}

15521556 step (ReadUState contents start p) | p < start = do

1553− liftIO $ touch contents

1557+ -- Is the following replicated properly?

1558+ -- let x = unsafeInlineIO $ touch contents

1559+ -- in x `seq` return D.Stop

1560+ liftio $ touch contents

15541561 return D.Stop

1562+ -- unit <- liftio $ touch contents

1563+ -- unit `seq` return D.Stop

15551564 step (ReadUState contents start p) = do

1556− x <- liftIO $ peek p

1565+ x <- liftio $ peek p

15571566 return $ D.Yield x (ReadUState contents start (PTR_PREV(p,a)))

15581567

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

1569+--

1570+-- /Pre-release/

1571+{-# INLINE_NORMAL readRev #-}

1572+readRev :: forall m a. (MonadIO m, Storable a) => Unfold m (Array a) a

1573+readRev = readRev_ liftIO

1574+

15591575-------------------------------------------------------------------------------

15601576-- to Lists and streams

15611577-------------------------------------------------------------------------------

@@ -1600,27 +1616,35 @@ toList Array{..} = liftIO $ go arrStart

16001616 touch arrContents

16011617 (:) x <$> go (PTR_NEXT(p,a))

16021618

1603−-- | Use the 'read' unfold instead.

1604−--

1605−-- @toStreamD = D.unfold read@

1606−--

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

1608−{-# INLINE_NORMAL toStreamD #-}

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

1610−toStreamD Array{..} = D.Stream step arrStart

1619+{-# INLINE_NORMAL toStreamD_ #-}

1620+toStreamD_ ::

1621+ forall m a. (Monad m, Storable a)

1622+ => (forall b. IO b -> m b) -> Array a -> D.Stream m a

1623+toStreamD_ liftio Array{..} = D.Stream step arrStart

16111624

16121625 where

16131626

16141627 {-# INLINE_LATE step #-}

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

1616− step _ p = liftIO $ do

1629+ step _ p = liftio $ do

16171630 r <- peek p

16181631 touch arrContents

16191632 return $ D.Yield r (PTR_NEXT(p,a))

16201633

1621−{-# INLINE toStreamK #-}

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

1623−toStreamK Array{..} = go arrStart

1634+-- | Use the 'read' unfold instead.

1635+--

1636+-- @toStreamD = D.unfold read@

1637+--

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

1639+{-# INLINE_NORMAL toStreamD #-}

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

1641+toStreamD arr = toStreamD_ liftIO arr

1642+

1643+{-# INLINE toStreamK_ #-}

1644+toStreamK_ ::

1645+ forall m a. (Monad m, Storable a)

1646+ => (forall b. IO b -> m b) -> Array a -> K.Stream m a

1647+toStreamK_ liftio Array{..} = go arrStart

16241648

16251649 where

16261650

@@ -1630,16 +1654,17 @@ toStreamK Array{..} = go arrStart

16301654 r <- peek p

16311655 touch arrContents

16321656 return r

1633− in liftIO elemM `K.consM` go (PTR_NEXT(p,a))

1657+ in liftio elemM `K.consM` go (PTR_NEXT(p,a))

16341658

1635−-- | Use the 'readRev' unfold instead.

1636−--

1637−-- @toStreamDRev = D.unfold readRev@

1638−--

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

1640−{-# INLINE_NORMAL toStreamDRev #-}

1641−toStreamDRev :: forall m a. (MonadIO m, Storable a) => Array a -> D.Stream m a

1642−toStreamDRev Array{..} =

1659+{-# INLINE toStreamK #-}

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

1661+toStreamK arr = toStreamK_ liftIO arr

1662+

1663+{-# INLINE_NORMAL toStreamDRev_ #-}

1664+toStreamDRev_ ::

1665+ forall m a. (Monad m, Storable a)

1666+ => (forall b. IO b -> m b) -> Array a -> D.Stream m a

1667+toStreamDRev_ liftio Array{..} =

16431668 let p = PTR_PREV(aEnd,a)

16441669 in D.Stream step p

16451670

@@ -1647,14 +1672,25 @@ toStreamDRev Array{..} =

16471672

16481673 {-# INLINE_LATE step #-}

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

1650− step _ p = liftIO $ do

1675+ step _ p = liftio $ do

16511676 r <- peek p

16521677 touch arrContents

16531678 return $ D.Yield r (PTR_PREV(p,a))

16541679

1655−{-# INLINE toStreamKRev #-}

1656−toStreamKRev :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a

1657−toStreamKRev Array {..} =

1680+-- | Use the 'readRev' unfold instead.

1681+--

1682+-- @toStreamDRev = D.unfold readRev@

1683+--

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

1685+{-# INLINE_NORMAL toStreamDRev #-}

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

1687+toStreamDRev arr = toStreamDRev_ liftIO arr

1688+

1689+{-# INLINE toStreamKRev_ #-}

1690+toStreamKRev_ ::

1691+ forall m a. (Monad m, Storable a)

1692+ => (forall b. IO b -> m b) -> Array a -> K.Stream m a

1693+toStreamKRev_ liftio Array {..} =

16581694 let p = PTR_PREV(aEnd,a)

16591695 in go p

16601696

@@ -1666,7 +1702,11 @@ toStreamKRev Array {..} =

16661702 r <- peek p

16671703 touch arrContents

16681704 return r

1669− in liftIO elemM `K.consM` go (PTR_PREV(p,a))

1705+ in liftio elemM `K.consM` go (PTR_PREV(p,a))

1706+

1707+{-# INLINE toStreamKRev #-}

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

1709+toStreamKRev arr = toStreamKRev_ liftIO arr

16701710

16711711-------------------------------------------------------------------------------

16721712-- Folding

core/src/Streamly/Internal/Data/Array/Foreign/Type.hs+9−82

@@ -92,7 +92,7 @@ import GHC.ForeignPtr (ForeignPtr)

9292import GHC.IO (unsafePerformIO)

9393import GHC.Ptr (Ptr(..))

9494import Streamly.Internal.Data.Array.Foreign.Mut.Type

95− (ArrayContents, ReadUState(..), touch)

95+ (ArrayContents, touch)

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

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

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

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

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

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

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

106+import qualified Streamly.Internal.Data.Unfold.Type as Unfold

106107import qualified GHC.Exts as Exts

107108

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

@@ -122,9 +123,6 @@ import qualified Data.Foldable as F

122123-- >>> import Prelude hiding (length, foldr, read, unlines, splitAt)

123124-- >>> import Streamly.Internal.Data.Array.Foreign as Array

124125

125−-- XXX Since these are immutable arrays MonadIO constraint can be removed from

126−-- most places.

127−

128126-------------------------------------------------------------------------------

129127-- Array Data Type

130128-------------------------------------------------------------------------------

@@ -476,94 +474,23 @@ length arr = MA.length (unsafeThaw arr)

476474-- @since 0.8.0

477475{-# INLINE_NORMAL readRev #-}

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

479−readRev = Unfold step inject

480− where

481−

482− inject (Array contents start end) =

483− let p = PTR_PREV(end,a)

484− in return $ ReadUState contents start p

485−

486− {-# INLINE_LATE step #-}

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

488− let x = unsafeInlineIO $ touch contents

489− in x `seq` return D.Stop

490− step (ReadUState contents start p) = do

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

492− -- toList/foldr case which makes them much faster due to not

493− -- accumulating the list and fusing better with the pure consumers.

494− --

495− -- This should be safe as the array contents are guaranteed to be

496− -- evaluated/written to before we peek at them.

497− let !x = unsafeInlineIO $ peek p

498− return $ D.Yield x (ReadUState contents start (PTR_PREV(p,a)))

499−

477+readRev = Unfold.lmap unsafeThaw $ MA.readRev_ (return . unsafeInlineIO)

500478

501479{-# INLINE_NORMAL toStreamD #-}

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

503−toStreamD Array{..} = D.Stream step arrStart

504−

505− where

506−

507− {-# INLINE_LATE step #-}

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

509− step _ p = do

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

511− -- toList/foldr case which makes them much faster due to not

512− -- accumulating the list and fusing better with the pure consumers.

513− --

514− -- This should be safe as the array contents are guaranteed to be

515− -- evaluated/written to before we peek at them.

516− --

517− let !x = unsafeInlineIO $ do

518− r <- peek p

519− touch arrContents

520− return r

521− return $ D.Yield x (PTR_NEXT(p,a))

481+toStreamD arr = MA.toStreamD_ (return . unsafeInlineIO) (unsafeThaw arr)

522482

523483{-# INLINE toStreamK #-}

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

525−toStreamK Array{..} = go arrStart

526−

527− where

528−

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

530− | otherwise =

531− -- See Note in toStreamD.

532− let !x = unsafeInlineIO $ do

533− r <- peek p

534− touch arrContents

535− return r

536− in x `K.cons` go (PTR_NEXT(p,a))

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

485+toStreamK arr = MA.toStreamK_ (return . unsafeInlineIO) (unsafeThaw arr)

537486

538487{-# INLINE_NORMAL toStreamDRev #-}

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

540−toStreamDRev Array{..} = D.Stream step (PTR_PREV(aEnd,a))

541−

542− where

543−

544− {-# INLINE_LATE step #-}

545− step _ p | p < arrStart = return D.Stop

546− step _ p = do

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

548− let !x = unsafeInlineIO $ do

549− r <- peek p

550− touch arrContents

551− return r

552− return $ D.Yield x (PTR_PREV(p,a))

489+toStreamDRev arr = MA.toStreamDRev_ (return . unsafeInlineIO) (unsafeThaw arr)

553490

554491{-# INLINE toStreamKRev #-}

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

556−toStreamKRev Array {..} = go (PTR_PREV(aEnd,a))

557−

558− where

559−

560− go p | p < arrStart = K.nil

561− | otherwise =

562− let !x = unsafeInlineIO $ do

563− r <- peek p

564− touch arrContents

565− return r

566− in x `K.cons` go (PTR_PREV(p,a))

492+toStreamKRev :: forall m a. (Monad m, Storable a) => Array a -> K.Stream m a

493+toStreamKRev arr = MA.toStreamKRev_ (return . unsafeInlineIO) (unsafeThaw arr)

567494

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

569496--