bf8561e · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Reuse mutable array code in Foreign.Type

bf8561eAdithya Kumar4 years ago

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

compare with master

unifiedsplit

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

98 -- ** To streams

99 , ReadUState(..)

100 , read

101+ , readRev_

101 , readRev

102 , readRev

102

103

103 -- ** To containers

104 -- ** To containers

105+ , toStreamD_

106+ , toStreamDRev_

107+ , toStreamK_

108+ , toStreamKRev_

104 , toStreamD

109 , toStreamD

105 , toStreamDRev

110 , toStreamDRev

106 , toStreamK

111 , toStreamK

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

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

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

1537read = Producer.simplify producer

1542read = Producer.simplify producer

1538

1543

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

1540−--

1541−-- /Pre-release/

1542−{-# INLINE_NORMAL readRev #-}

1544+{-# INLINE_NORMAL readRev_ #-}

1545+readRev_ ::

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

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

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

1544−readRev = Unfold step inject

1548+readRev_ liftio = Unfold step inject

1545 where

1549 where

1546

1550

1547 inject (Array contents start end _) =

1551 inject (Array contents start end _) =

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

1550

1554

1551 {-# INLINE_LATE step #-}

1555 {-# INLINE_LATE step #-}

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

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

1553− liftIO $ touch contents

1560+ liftio $ touch contents

1554 return D.Stop

1561 return D.Stop

1562+ -- unit <- liftio $ touch contents

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

1555 step (ReadUState contents start p) = do

1564 step (ReadUState contents start p) = do

1556− x <- liftIO $ peek p

1565+ x <- liftio $ peek p

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

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

1558

1567

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+

1559-------------------------------------------------------------------------------

1575-------------------------------------------------------------------------------

1560-- to Lists and streams

1576-- to Lists and streams

1561-------------------------------------------------------------------------------

1577-------------------------------------------------------------------------------

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

1600 touch arrContents

1616 touch arrContents

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

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

1602

1618

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 #-}

1619+{-# INLINE_NORMAL toStreamD_ #-}

1620+toStreamD_ ::

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

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

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

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

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

1611

1624

1612 where

1625 where

1613

1626

1614 {-# INLINE_LATE step #-}

1627 {-# INLINE_LATE step #-}

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

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

1616− step _ p = liftIO $ do

1629+ step _ p = liftio $ do

1617 r <- peek p

1630 r <- peek p

1618 touch arrContents

1631 touch arrContents

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

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

1620

1633

1621−{-# INLINE toStreamK #-}

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_ ::

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

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

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

1623−toStreamK Array{..} = go arrStart

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

1624

1648

1625 where

1649 where

1626

1650

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

1630 r <- peek p

1654 r <- peek p

1631 touch arrContents

1655 touch arrContents

1632 return r

1656 return r

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

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

1634

1658

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

1659+{-# INLINE toStreamK #-}

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

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

1642−toStreamDRev Array{..} =

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{..} =

1643 let p = PTR_PREV(aEnd,a)

1668 let p = PTR_PREV(aEnd,a)

1644 in D.Stream step p

1669 in D.Stream step p

1645

1670

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

1647

1672

1648 {-# INLINE_LATE step #-}

1673 {-# INLINE_LATE step #-}

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

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

1650− step _ p = liftIO $ do

1675+ step _ p = liftio $ do

1651 r <- peek p

1676 r <- peek p

1652 touch arrContents

1677 touch arrContents

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

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

1654

1679

1655−{-# INLINE toStreamKRev #-}

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_ ::

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

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

1657−toStreamKRev Array {..} =

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

1693+toStreamKRev_ liftio Array {..} =

1658 let p = PTR_PREV(aEnd,a)

1694 let p = PTR_PREV(aEnd,a)

1659 in go p

1695 in go p

1660

1696

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

1666 r <- peek p

1702 r <- peek p

1667 touch arrContents

1703 touch arrContents

1668 return r

1704 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

1670

1710

1671-------------------------------------------------------------------------------

1711-------------------------------------------------------------------------------

1672-- Folding

1712-- Folding

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

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

92import GHC.IO (unsafePerformIO)

93import GHC.Ptr (Ptr(..))

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

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

95+ (ArrayContents, touch)

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

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

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

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

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

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

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

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

106import qualified GHC.Exts as Exts

107import qualified GHC.Exts as Exts

107

108

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

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

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

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

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

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

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

124

125

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

126−-- most places.

127−

128-------------------------------------------------------------------------------

126-------------------------------------------------------------------------------

129-- Array Data Type

127-- Array Data Type

130-------------------------------------------------------------------------------

128-------------------------------------------------------------------------------

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

476-- @since 0.8.0

474-- @since 0.8.0

477{-# INLINE_NORMAL readRev #-}

475{-# INLINE_NORMAL readRev #-}

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

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

479−readRev = Unfold step inject

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

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−

500

478

501{-# INLINE_NORMAL toStreamD #-}

479{-# INLINE_NORMAL toStreamD #-}

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

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

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

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

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

522

482

523{-# INLINE toStreamK #-}

483{-# INLINE toStreamK #-}

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

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

525−toStreamK Array{..} = go arrStart

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

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

537

486

538{-# INLINE_NORMAL toStreamDRev #-}

487{-# INLINE_NORMAL toStreamDRev #-}

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

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

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

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

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

553

490

554{-# INLINE toStreamKRev #-}

491{-# INLINE toStreamKRev #-}

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

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

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

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

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

567

494

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

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

569--

496--