2864

pending completion

Build # 2864

Build Type

Pull #488

travis-ci-com

Committed by

web-flow

Commit Message

<a href="https://github.com/composewell/streamly/commit/<a class=hub.com/composewell/streamly/commit/e0b2891aa9e03fe789ea6d4f7f1ddd64eb98212e">e0b2891aa<a href="https://github.com/composewell/streamly/commit/e0b2891aa9e03fe789ea6d4f7f1ddd64eb98212e">">Merge </a><a class="double-link" href="https://github.com/composewell/streamly/commit/<a class="double-link" href="https://github.com/composewell/streamly/commit/3e6de5030634f564189b0646f0efe08a19d565bd">3e6de5030</a>">3e6de5030</a><a href="https://github.com/composewell/streamly/commit/e0b2891aa9e03fe789ea6d4f7f1ddd64eb98212e"> into f38b672e4">f38b672e4</a>

Pull Request Pull Request #488: Enhance the fold type to capture terminating folds

Run Details

557 of 557 new or added lines in 14 files covered. (100.0%)

3342 of 9480 relevant lines covered (35.25%)

0.35 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

78.85

/src/Streamly/Internal/Data/SmallArray.hs

-- |
-- Module      : Streamly.Internal.Data.SmallArray
-- Copyright   : (c) 2019 Composewell Technologies
--
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UnboxedTuples #-}

#include "inline.hs"

module Streamly.Internal.Data.SmallArray
  (
    -- XXX should it be just Array instead? We should be able to replace one
    -- array type with another easily.
    SmallArray(..)

  , foldl'
  , foldr

  , length

  , writeN

  , toStreamD
  , toStreamDRev

  , toStream
  , toStreamRev
  , read

  , fromListN
  , fromStreamDN
  , fromStreamN

  , streamFold
  , fold
  )
where

import Prelude hiding (foldr, length, read)
import Control.DeepSeq (NFData(..))
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import GHC.IO (unsafePerformIO)
import Data.Functor.Identity (runIdentity)

import Streamly.Internal.Data.SmallArray.Types

import Streamly.Internal.Data.Strict (Tuple'(..))
import Streamly.Internal.Data.Unfold.Types (Unfold(..))
import Streamly.Internal.Data.Fold.Types (Fold(..))
import Streamly.Internal.Data.Stream.StreamK.Type (IsStream)
import Streamly.Internal.Data.Stream.Serial (SerialT)

import qualified Streamly.Internal.Data.Stream.StreamD as D
import qualified Streamly.Internal.Data.Fold.Types as FL

{-# NOINLINE bottomElement #-}
bottomElement :: a
bottomElement = undefined

{-# INLINE length #-}
length :: SmallArray a -> Int
length = sizeofSmallArray

{-# INLINE_NORMAL toStreamD #-}
toStreamD :: Monad m => SmallArray a -> D.Stream m a
toStreamD arr = D.Stream step 0
  where
    {-# INLINE_LATE step #-}
    step _ i
        | i == length arr = return D.Stop
        | otherwise =
            return $
            case indexSmallArray## arr i of
                (# x #) -> D.Yield x (i + 1)

{-# INLINE_NORMAL toStreamDRev #-}
toStreamDRev :: Monad m => SmallArray a -> D.Stream m a
toStreamDRev arr = D.Stream step (length arr - 1)
  where
    {-# INLINE_LATE step #-}
    step _ i
        | i < 0 = return D.Stop
        | otherwise =
            return $
            case indexSmallArray## arr i of
                (# x #) -> D.Yield x (i - 1)

{-# INLINE_NORMAL foldl' #-}
foldl' :: (b -> a -> b) -> b -> SmallArray a -> b
foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr

{-# INLINE_NORMAL foldr #-}
foldr :: (a -> b -> b) -> b -> SmallArray a -> b
foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr

-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an
-- 'SmallArray'.
--
-- Since we are folding to a 'SmallArray' @n@ should be <= 128, for larger number
-- of elements use an 'Array' from either "Streamly.Data.Array" or "Streamly.Memory.Array".
{-# INLINE_NORMAL writeN #-}
writeN :: MonadIO m => Int -> Fold m a (SmallArray a)
writeN limit = Fold step initial extract
  where
    initial = do
        marr <- liftIO $ newSmallArray limit bottomElement
        return (Tuple' marr 0)
    step (Tuple' marr i) x
        | i == limit = fmap FL.Done $ liftIO $ freezeSmallArray marr 0 i
        | otherwise = do
            liftIO $ writeSmallArray marr i x
            return $ FL.Partial (Tuple' marr (i + 1))
    extract (Tuple' marr len) = liftIO $ freezeSmallArray marr 0 len

{-# INLINE_NORMAL fromStreamDN #-}
fromStreamDN :: MonadIO m => Int -> D.Stream m a -> m (SmallArray a)
fromStreamDN limit str = do
    marr <- liftIO $ newSmallArray (max limit 0) bottomElement
    i <-
        D.foldlM'
            (\i x -> i `seq` liftIO (writeSmallArray marr i x) >> return (i + 1))
            (return 0) $
        D.take limit str
    liftIO $ freezeSmallArray marr 0 i

-- | Create a 'SmallArray' from the first @n@ elements of a list. The
-- array may hold less than @n@ elements if the length of the list <=
-- @n@.
--
-- It is recommended to use a value of @n@ <= 128. For larger sized
-- arrays, use an 'Array' from "Streamly.Data.Array" or
-- "Streamly.Memory.Array"
{-# INLINABLE fromListN #-}
fromListN :: Int -> [a] -> SmallArray a
fromListN n xs = unsafePerformIO $ fromStreamDN n $ D.fromList xs

instance NFData a => NFData (SmallArray a) where
    {-# INLINE rnf #-}
    rnf = foldl' (\_ x -> rnf x) ()

-- | Create a 'SmallArray' from the first @n@ elements of a stream. The
-- array is allocated to size @n@, if the stream terminates before @n@
-- elements then the array may hold less than @n@ elements.
--
-- For optimal performance use this with @n@ <= 128.
{-# INLINE fromStreamN #-}
fromStreamN :: MonadIO m => Int -> SerialT m a -> m (SmallArray a)
fromStreamN n m = do
    when (n < 0) $ error "fromStreamN: negative write count specified"
    fromStreamDN n $ D.toStreamD m

{-# INLINE_EARLY toStream #-}
toStream :: (Monad m, IsStream t) => SmallArray a -> t m a
toStream = D.fromStreamD . toStreamD

{-# INLINE_EARLY toStreamRev #-}
toStreamRev :: (Monad m, IsStream t) => SmallArray a -> t m a
toStreamRev = D.fromStreamD . toStreamDRev

{-# INLINE fold #-}
fold :: Monad m => Fold m a b -> SmallArray a -> m b
fold f arr = D.runFold f (toStreamD arr)

{-# INLINE streamFold #-}
streamFold :: Monad m => (SerialT m a -> m b) -> SmallArray a -> m b
streamFold f arr = f (toStream arr)

{-# INLINE_NORMAL read #-}
read :: Monad m => Unfold m (SmallArray a) a
read = Unfold step inject
  where
    inject arr = return (arr, 0)
    step (arr, i)
        | i == length arr = return D.Stop
        | otherwise =
            return $
            case indexSmallArray## arr i of
                (# x #) -> D.Yield x (arr, i + 1)

1	-- \|
2	-- Module : Streamly.Internal.Data.SmallArray
3	-- Copyright : (c) 2019 Composewell Technologies
4	--
5	-- License : BSD-3-Clause
6	-- Maintainer : streamly@composewell.com
7	-- Stability : experimental
8	-- Portability : GHC
9
10	{-# OPTIONS_GHC -fno-warn-orphans #-}
11	{-# LANGUAGE UnboxedTuples #-}
12
13	#include "inline.hs"
14
15	module Streamly.Internal.Data.SmallArray
16	(
17	-- XXX should it be just Array instead? We should be able to replace one
18	-- array type with another easily.
19	SmallArray(..)
20
21	, foldl'
22	, foldr
23
24	, length
25
26	, writeN
27
28	, toStreamD
29	, toStreamDRev
30
31	, toStream
32	, toStreamRev
33	, read
34
35	, fromListN
36	, fromStreamDN
37	, fromStreamN
38
39	, streamFold
40	, fold
41	)
42	where
43
44	import Prelude hiding (foldr, length, read)
45	import Control.DeepSeq (NFData(..))
46	import Control.Monad (when)
47	import Control.Monad.IO.Class (MonadIO, liftIO)
48	import GHC.IO (unsafePerformIO)
49	import Data.Functor.Identity (runIdentity)
50
51	import Streamly.Internal.Data.SmallArray.Types
52
53	import Streamly.Internal.Data.Strict (Tuple'(..))
54	import Streamly.Internal.Data.Unfold.Types (Unfold(..))
55	import Streamly.Internal.Data.Fold.Types (Fold(..))
56	import Streamly.Internal.Data.Stream.StreamK.Type (IsStream)
57	import Streamly.Internal.Data.Stream.Serial (SerialT)
58
59	import qualified Streamly.Internal.Data.Stream.StreamD as D
60	import qualified Streamly.Internal.Data.Fold.Types as FL
61
62	{-# NOINLINE bottomElement #-}
63	bottomElement :: a
64	bottomElement = undefined	×
65
66	{-# INLINE length #-}
67	length :: SmallArray a -> Int
68	length = sizeofSmallArray	1✔
69
70	{-# INLINE_NORMAL toStreamD #-}
71	toStreamD :: Monad m => SmallArray a -> D.Stream m a
72	toStreamD arr = D.Stream step 0	1✔
73	where
74	{-# INLINE_LATE step #-}
75	step _ i	1✔
76	\| i == length arr = return D.Stop	1✔
77	\| otherwise =	1✔
78	return $	1✔
79	case indexSmallArray## arr i of	1✔
80	(# x #) -> D.Yield x (i + 1)	1✔
81
82	{-# INLINE_NORMAL toStreamDRev #-}
83	toStreamDRev :: Monad m => SmallArray a -> D.Stream m a
84	toStreamDRev arr = D.Stream step (length arr - 1)	1✔
85	where
86	{-# INLINE_LATE step #-}
87	step _ i	1✔
88	\| i < 0 = return D.Stop	1✔
89	\| otherwise =	1✔
90	return $	1✔
91	case indexSmallArray## arr i of	1✔
92	(# x #) -> D.Yield x (i - 1)	1✔
93
94	{-# INLINE_NORMAL foldl' #-}
95	foldl' :: (b -> a -> b) -> b -> SmallArray a -> b
96	foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr	×
97
98	{-# INLINE_NORMAL foldr #-}
99	foldr :: (a -> b -> b) -> b -> SmallArray a -> b
100	foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr	×
101
102	-- \| @writeN n@ folds a maximum of @n@ elements from the input stream to an
103	-- 'SmallArray'.
104	--
105	-- Since we are folding to a 'SmallArray' @n@ should be <= 128, for larger number
106	-- of elements use an 'Array' from either "Streamly.Data.Array" or "Streamly.Memory.Array".
107	{-# INLINE_NORMAL writeN #-}
108	writeN :: MonadIO m => Int -> Fold m a (SmallArray a)
109	writeN limit = Fold step initial extract	1✔
110	where
111	initial = do	1✔
112	marr <- liftIO $ newSmallArray limit bottomElement	×
113	return (Tuple' marr 0)	1✔
114	step (Tuple' marr i) x	1✔
115	\| i == limit = fmap FL.Done $ liftIO $ freezeSmallArray marr 0 i	×
116	\| otherwise = do	1✔
117	liftIO $ writeSmallArray marr i x	1✔
118	return $ FL.Partial (Tuple' marr (i + 1))	1✔
119	extract (Tuple' marr len) = liftIO $ freezeSmallArray marr 0 len	1✔
120
121	{-# INLINE_NORMAL fromStreamDN #-}
122	fromStreamDN :: MonadIO m => Int -> D.Stream m a -> m (SmallArray a)
123	fromStreamDN limit str = do	1✔
124	marr <- liftIO $ newSmallArray (max limit 0) bottomElement	×
125	i <-
126	D.foldlM'	1✔
127	(\i x -> i `seq` liftIO (writeSmallArray marr i x) >> return (i + 1))	1✔
128	(return 0) $	1✔
129	D.take limit str	1✔
130	liftIO $ freezeSmallArray marr 0 i	1✔
131
132	-- \| Create a 'SmallArray' from the first @n@ elements of a list. The
133	-- array may hold less than @n@ elements if the length of the list <=
134	-- @n@.
135	--
136	-- It is recommended to use a value of @n@ <= 128. For larger sized
137	-- arrays, use an 'Array' from "Streamly.Data.Array" or
138	-- "Streamly.Memory.Array"
139	{-# INLINABLE fromListN #-}
140	fromListN :: Int -> [a] -> SmallArray a
141	fromListN n xs = unsafePerformIO $ fromStreamDN n $ D.fromList xs	×
142
143	instance NFData a => NFData (SmallArray a) where
144	{-# INLINE rnf #-}
145	rnf = foldl' (\_ x -> rnf x) ()	×
146
147	-- \| Create a 'SmallArray' from the first @n@ elements of a stream. The
148	-- array is allocated to size @n@, if the stream terminates before @n@
149	-- elements then the array may hold less than @n@ elements.
150	--
151	-- For optimal performance use this with @n@ <= 128.
152	{-# INLINE fromStreamN #-}
153	fromStreamN :: MonadIO m => Int -> SerialT m a -> m (SmallArray a)
154	fromStreamN n m = do	1✔
155	when (n < 0) $ error "fromStreamN: negative write count specified"	×
156	fromStreamDN n $ D.toStreamD m	1✔
157
158	{-# INLINE_EARLY toStream #-}
159	toStream :: (Monad m, IsStream t) => SmallArray a -> t m a
160	toStream = D.fromStreamD . toStreamD	1✔
161
162	{-# INLINE_EARLY toStreamRev #-}
163	toStreamRev :: (Monad m, IsStream t) => SmallArray a -> t m a
164	toStreamRev = D.fromStreamD . toStreamDRev	1✔
165
166	{-# INLINE fold #-}
167	fold :: Monad m => Fold m a b -> SmallArray a -> m b
168	fold f arr = D.runFold f (toStreamD arr)	×
169
170	{-# INLINE streamFold #-}
171	streamFold :: Monad m => (SerialT m a -> m b) -> SmallArray a -> m b
172	streamFold f arr = f (toStream arr)	×
173
174	{-# INLINE_NORMAL read #-}
175	read :: Monad m => Unfold m (SmallArray a) a
176	read = Unfold step inject	1✔
177	where
178	inject arr = return (arr, 0)	1✔
179	step (arr, i)	1✔
180	\| i == length arr = return D.Stop	1✔
181	\| otherwise =	1✔
182	return $	1✔
183	case indexSmallArray## arr i of	1✔
184	(# x #) -> D.Yield x (arr, i + 1)	1✔

composewell / streamly / 2864

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous