7336d58 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Fix a bug caused by unsafeInlineIO

7336d58Harendra Kumar7 years ago

benchmark/Array.hs+40−22

compare with master

unifiedsplit

@@ -7,15 +7,14 @@

7-- Maintainer : harendra.kumar@gmail.com

9import Control.DeepSeq (NFData(..), deepseq)

10−import Data.Functor.Identity (Identity)

11import Foreign.Storable (Storable(..))

10import Foreign.Storable (Storable(..))

12import System.Random (randomRIO)

11import System.Random (randomRIO)

14−import Streamly

15import qualified GHC.Exts as GHC

13import qualified GHC.Exts as GHC

17import qualified ArrayOps as Ops

15import qualified ArrayOps as Ops

18import qualified Streamly.Array as A

16import qualified Streamly.Array as A

17+import qualified Streamly.Prelude as S

20import Gauge

19import Gauge

@@ -28,15 +27,36 @@ benchPure :: NFData b => String -> (Int -> a) -> (a -> b) -> Benchmark

28benchPure name src f = bench name $ nfIO $

27benchPure name src f = bench name $ nfIO $

29 randomRIO (1,1) >>= return . f . src

28 randomRIO (1,1) >>= return . f . src

31−{-# INLINE benchPureSink #-}

30+-- Drain a source that generates a pure array

32−benchPureSink :: NFData b => String -> (Ops.Stream Int -> b) -> Benchmark

33−benchPureSink name f = benchPure name Ops.sourceIntFromTo f

34−

35{-# INLINE benchPureSrc #-}

31{-# INLINE benchPureSrc #-}

36benchPureSrc :: (NFData a, Storable a)

32benchPureSrc :: (NFData a, Storable a)

37 => String -> (Int -> Ops.Stream a) -> Benchmark

33 => String -> (Int -> Ops.Stream a) -> Benchmark

38benchPureSrc name src = benchPure name src id

34benchPureSrc name src = benchPure name src id

36+{-# INLINE benchIO #-}

37+benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark

38+benchIO name src f = bench name $ nfIO $

39+ randomRIO (1,1) >>= src >>= return . f

40+

41+-- Drain a source that generates an array in the IO monad

42+{-# INLINE benchIOSrc #-}

43+benchIOSrc :: (NFData a, Storable a)

44+ => String -> (Int -> IO (Ops.Stream a)) -> Benchmark

45+benchIOSrc name src = benchIO name src id

46+

47+{-# INLINE benchPureSink #-}

48+benchPureSink :: NFData b => String -> (Ops.Stream Int -> b) -> Benchmark

49+benchPureSink name f = benchIO name Ops.sourceIntFromTo f

50+

51+{-# INLINE benchIO' #-}

52+benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark

53+benchIO' name src f = bench name $ nfIO $

54+ randomRIO (1,1) >>= src >>= f

55+

56+{-# INLINE benchIOSink #-}

57+benchIOSink :: NFData b => String -> (Ops.Stream Int -> IO b) -> Benchmark

58+benchIOSink name f = benchIO' name Ops.sourceIntFromTo f

59+

40mkString :: String

60mkString :: String

41mkString = "[1" ++ concat (replicate Ops.value ",1") ++ "]"

61mkString = "[1" ++ concat (replicate Ops.value ",1") ++ "]"

@@ -45,11 +65,11 @@ main =

45 defaultMain

65 defaultMain

46 [ bgroup "array"

66 [ bgroup "array"

47 [ bgroup "generation"

67 [ bgroup "generation"

48− [ benchPureSrc "fromStreamN . intFromTo" Ops.sourceIntFromTo

68+ [ benchIOSrc "fromStreamN . intFromTo" Ops.sourceIntFromTo

49− , benchPureSrc "fromStream . intFromTo" Ops.sourceIntFromToFromStream

69+ , benchIOSrc "fromStream . intFromTo" Ops.sourceIntFromToFromStream

50− , benchPureSrc "fromList . intFromTo" Ops.sourceIntFromToFromList

70+ , benchIOSrc "fromList . intFromTo" Ops.sourceIntFromToFromList

51− , benchPureSrc "fromStreamN . unfoldr" Ops.sourceUnfoldr

71+ , benchIOSrc "fromStreamN . unfoldr" Ops.sourceUnfoldr

52− , benchPureSrc "fromStreamN . fromList" Ops.sourceFromList

72+ , benchIOSrc "fromStreamN . fromList" Ops.sourceFromList

53 , benchPureSrc "fromStreamN . IsList.fromList" Ops.sourceIsList

73 , benchPureSrc "fromStreamN . IsList.fromList" Ops.sourceIsList

54 , benchPureSrc "fromStreamN . IsString.fromString" Ops.sourceIsString

74 , benchPureSrc "fromStreamN . IsString.fromString" Ops.sourceIsString

55 , mkString `deepseq` (bench "read" $ nf Ops.readInstance mkString)

75 , mkString `deepseq` (bench "read" $ nf Ops.readInstance mkString)

@@ -66,11 +86,9 @@ main =

66 , benchPureSink "<" Ops.ordInstance

86 , benchPureSink "<" Ops.ordInstance

67 , benchPureSink "min" Ops.ordInstanceMin

87 , benchPureSink "min" Ops.ordInstanceMin

68 , benchPureSink "IsList.toList" GHC.toList

88 , benchPureSink "IsList.toList" GHC.toList

69− , benchPureSink "foldl'" Ops.pureFoldl'

89+ , benchIOSink "foldl'" Ops.pureFoldl'

70− , benchPureSink "toStream"

90+ , benchIOSink "toStream" (S.drain . A.toStream)

71− (A.toStream :: A.Array Int -> SerialT Identity Int)

91+ , benchIOSink "toStreamRev" (S.drain . A.toStreamRev)

72− , benchPureSink "toStreamRev"

73− (A.toStreamRev :: A.Array Int -> SerialT Identity Int)

74#ifdef DEVBUILD

92#ifdef DEVBUILD

75 , benchPureSink "foldable/foldl'" Ops.foldableFoldl'

93 , benchPureSink "foldable/foldl'" Ops.foldableFoldl'

76 , benchPureSink "foldable/sum" Ops.foldableSum

94 , benchPureSink "foldable/sum" Ops.foldableSum

@@ -118,9 +136,9 @@ main =

118 ]

136 ]

119 -}

137 -}

120 , bgroup "transformation"

138 , bgroup "transformation"

121− [ benchPureSink "scanl'" (Ops.scanl' 1)

139+ [ benchIOSink "scanl'" (Ops.scanl' 1)

122− , benchPureSink "scanl1'" (Ops.scanl1' 1)

140+ , benchIOSink "scanl1'" (Ops.scanl1' 1)

123− , benchPureSink "map" (Ops.map 1)

141+ , benchIOSink "map" (Ops.map 1)

124 {-

142 {-

125 , benchPureSink "fmap" (Ops.fmap 1)

143 , benchPureSink "fmap" (Ops.fmap 1)

126 , benchPureSink "mapM" (Ops.mapM serially 1)

144 , benchPureSink "mapM" (Ops.mapM serially 1)

@@ -138,9 +156,9 @@ main =

138 -}

156 -}

139 ]

157 ]

140 , bgroup "transformationX4"

158 , bgroup "transformationX4"

141− [ benchPureSink "scanl'" (Ops.scanl' 4)

159+ [ benchIOSink "scanl'" (Ops.scanl' 4)

142− , benchPureSink "scanl1'" (Ops.scanl1' 4)

160+ , benchIOSink "scanl1'" (Ops.scanl1' 4)

143− , benchPureSink "map" (Ops.map 4)

161+ , benchIOSink "map" (Ops.map 4)

144 {-

162 {-

145 , benchPureSink "fmap" (Ops.fmap 4)

163 , benchPureSink "fmap" (Ops.fmap 4)

146 , benchPureSink "mapM" (Ops.mapM serially 4)

164 , benchPureSink "mapM" (Ops.mapM serially 4)

benchmark/ArrayOps.hs+30−27

@@ -14,7 +14,7 @@

14module ArrayOps where

16-- import Control.Monad (when)

17−import Data.Functor.Identity (Identity, runIdentity)

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

18-- import Data.Maybe (fromJust)

19import Prelude (Int, Bool, (+), ($), (==), (>), (.), Maybe(..), undefined)

20import qualified Prelude as P

@@ -48,8 +48,8 @@ maxValue = value + 1

48type Stream = A.Array

50{-# INLINE sourceUnfoldr #-}

51−sourceUnfoldr :: Int -> Stream Int

51+sourceUnfoldr :: MonadIO m => Int -> m (Stream Int)

52−sourceUnfoldr n = runIdentity $ A.fromStreamN value $ S.unfoldr step n

52+sourceUnfoldr n = A.fromStreamN value $ S.unfoldr step n

53 where

54 step cnt =

55 if cnt > n + value

@@ -57,30 +57,27 @@ sourceUnfoldr n = runIdentity $ A.fromStreamN value $ S.unfoldr step n

57 else (Just (cnt, cnt + 1))

59{-# INLINE sourceIntFromTo #-}

60−sourceIntFromTo :: Int -> Stream Int

60+sourceIntFromTo :: MonadIO m => Int -> m (Stream Int)

61−sourceIntFromTo n = runIdentity $

62− A.fromStreamN value $ S.enumerateFromTo n (n + value)

61+sourceIntFromTo n = A.fromStreamN value $ S.enumerateFromTo n (n + value)

64{-# INLINE sourceIntFromToFromStream #-}

63{-# INLINE sourceIntFromToFromStream #-}

65−sourceIntFromToFromStream :: Int -> Stream Int

64+sourceIntFromToFromStream :: MonadIO m => Int -> m (Stream Int)

66−sourceIntFromToFromStream n = runIdentity $

67− A.fromStream $ S.enumerateFromTo n (n + value)

65+sourceIntFromToFromStream n = A.fromStream $ S.enumerateFromTo n (n + value)

69−sourceIntFromToFromList :: Int -> Stream Int

67+sourceIntFromToFromList :: MonadIO m => Int -> m (Stream Int)

70−sourceIntFromToFromList n = A.fromList $ [n..n + value]

68+sourceIntFromToFromList n = P.return $ A.fromList $ [n..n + value]

72{-# INLINE sourceFromList #-}

70{-# INLINE sourceFromList #-}

73−sourceFromList :: Int -> Stream Int

71+sourceFromList :: MonadIO m => Int -> m (Stream Int)

74−sourceFromList n = runIdentity $ A.fromStreamN value $ S.fromList [n..n+value]

72+sourceFromList n = A.fromStreamN value $ S.fromList [n..n+value]

76{-# INLINE sourceIsList #-}

74{-# INLINE sourceIsList #-}

77sourceIsList :: Int -> Stream Int

75sourceIsList :: Int -> Stream Int

78−sourceIsList n = runIdentity $ A.fromStreamN value $ GHC.fromList [n..n+value]

76+sourceIsList n = GHC.fromList [n..n+value]

80{-# INLINE sourceIsString #-}

78{-# INLINE sourceIsString #-}

81sourceIsString :: Int -> Stream P.Char

79sourceIsString :: Int -> Stream P.Char

82−sourceIsString n = runIdentity $

83− A.fromStreamN value $ GHC.fromString (P.replicate (n + value) 'a')

80+sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')

85{-

82{-

86-------------------------------------------------------------------------------

83-------------------------------------------------------------------------------

@@ -209,18 +206,21 @@ maximumBy = S.maximumBy compare

209-- Transformation

206-- Transformation

210-------------------------------------------------------------------------------

207-------------------------------------------------------------------------------

211

208

209+{-

212{-# INLINE transform #-}

210{-# INLINE transform #-}

213transform :: Stream a -> Stream a

211transform :: Stream a -> Stream a

214transform = P.id

212transform = P.id

213+-}

215

214

216{-# INLINE composeN #-}

215{-# INLINE composeN #-}

216+composeN :: P.Monad m

217−composeN :: Int -> (Stream Int -> Stream Int) -> Stream Int -> Stream Int

217+ => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)

218−composeN n f =

218+composeN n f x =

219 case n of

220− 1 -> transform . f

220+ 1 -> f x

221− 2 -> transform . f . f

221+ 2 -> f x P.>>= f

222− 3 -> transform . f . f . f

222+ 3 -> f x P.>>= f P.>>= f

223− 4 -> transform . f . f . f . f

223+ 4 -> f x P.>>= f P.>>= f P.>>= f

224 _ -> undefined

225

226{-# INLINE scanl' #-}

@@ -256,7 +256,7 @@ scanl' , scanl1', map{-, fmap, mapMaybe, filterEven, filterAllOut,

256 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,

257 findIndices, elemIndices, insertBy, deleteBy, reverse,

258 foldrS, foldrSMap, foldrT, foldrTMap -}

259− :: Int -> Stream Int -> Stream Int

259+ :: MonadIO m => Int -> Stream Int -> m (Stream Int)

260

261{-

262{-# INLINE mapMaybeM #-}

@@ -276,8 +276,11 @@ sequence :: (S.IsStream t, S.MonadAsync m)

276 => (t m Int -> S.SerialT m Int) -> t m (m Int) -> m ()

277 -}

278

279+onArray

279−onArray :: (S.SerialT Identity Int -> S.SerialT Identity Int) -> Stream Int -> Stream Int

280+ :: MonadIO m => (S.SerialT m Int -> S.SerialT m Int)

281+ -> Stream Int

282+ -> m (Stream Int)

280−onArray f arr = runIdentity $ A.fromStreamN value $ f $ A.toStream arr

283+onArray f arr = A.fromStreamN value $ f $ A.toStream arr

281

284

282scanl' n = composeN n $ onArray $ S.scanl' (+) 0

285scanl' n = composeN n $ onArray $ S.scanl' (+) 0

283scanl1' n = composeN n $ onArray $ S.scanl1' (+)

286scanl1' n = composeN n $ onArray $ S.scanl1' (+)

@@ -507,8 +510,8 @@ readInstance str =

507 _ -> P.error "readInstance: no parse"

510 _ -> P.error "readInstance: no parse"

508

511

509{-# INLINE pureFoldl' #-}

512{-# INLINE pureFoldl' #-}

510−pureFoldl' :: Stream Int -> Int

513+pureFoldl' :: MonadIO m => Stream Int -> m Int

511−pureFoldl' = runIdentity . S.foldl' (+) 0 . A.toStream

514+pureFoldl' = S.foldl' (+) 0 . A.toStream

512

515

513#ifdef DEVBUILD

516#ifdef DEVBUILD

514{-# INLINE foldableFoldl' #-}

517{-# INLINE foldableFoldl' #-}

benchmark/LinearOps.hs+4−3

@@ -14,6 +14,7 @@

14module LinearOps where

16import Control.Monad (when)

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

17import Data.Functor.Identity (Identity, runIdentity)

18import Data.Functor.Identity (Identity, runIdentity)

18import Data.Maybe (fromJust)

19import Data.Maybe (fromJust)

19import Prelude

20import Prelude

@@ -287,7 +288,7 @@ transform = runStream

287

288

288{-# INLINE composeN #-}

289{-# INLINE composeN #-}

289composeN

290composeN

290− :: Monad m

291+ :: MonadIO m

291 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()

292 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()

292composeN n f =

293composeN n f =

293 case n of

294 case n of

@@ -342,7 +343,7 @@ scan, scanl1', map, fmap, mapMaybe, filterEven, filterAllOut,

342 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,

343 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,

343 findIndices, elemIndices, insertBy, deleteBy, reverse, reverse',

344 findIndices, elemIndices, insertBy, deleteBy, reverse, reverse',

344 foldrS, foldrSMap, foldrT, foldrTMap

345 foldrS, foldrSMap, foldrT, foldrTMap

345− :: Monad m

346+ :: MonadIO m

346 => Int -> Stream m Int -> m ()

347 => Int -> Stream m Int -> m ()

347

348

348{-# INLINE mapMaybeM #-}

349{-# INLINE mapMaybeM #-}

@@ -529,7 +530,7 @@ concatMap n = S.concatMap (\_ -> sourceUnfoldrMN maxNested n)

529{-# INLINE filterMap #-}

530{-# INLINE filterMap #-}

530scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,

531scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,

531 filterTake, filterScan, filterScanl1, filterMap

532 filterTake, filterScan, filterScanl1, filterMap

532− :: Monad m => Int -> Stream m Int -> m ()

533+ :: MonadIO m => Int -> Stream m Int -> m ()

533

534

534scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0

535scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0

535dropMap n = composeN n $ S.map (subtract 1) . S.drop 1

536dropMap n = composeN n $ S.map (subtract 1) . S.drop 1

benchmark/NanoBenchmarks.hs+4−4

@@ -52,7 +52,7 @@ takeAllDropOne = S.drop 1 . S.take maxValue

53{-# INLINE takeDrop #-}

54takeDrop :: Monad m => S.Stream m Int -> m ()

55−takeDrop = S.runStream .

55+takeDrop = S.drain .

56 takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne

58-------------------------------------------------------------------------------

@@ -67,7 +67,7 @@ dropWhileFalse = S.dropWhile (> maxValue)

68{-# INLINE dropWhileFalseX4 #-}

69dropWhileFalseX4 :: Monad m => S.Stream m Int -> m ()

70−dropWhileFalseX4 = S.runStream

70+dropWhileFalseX4 = S.drain

71 . dropWhileFalse . dropWhileFalse . dropWhileFalse . dropWhileFalse

73-------------------------------------------------------------------------------

@@ -88,9 +88,9 @@ iterateSource g i n = f i (sourceUnfoldrMN n)

88main :: IO ()

89main = do

90 defaultMain [bench "unfoldr" $ nfIO $

91− randomRIO (1,1) >>= \n -> S.runStream (sourceUnfoldr n)]

91+ randomRIO (1,1) >>= \n -> S.drain (sourceUnfoldr n)]

92 defaultMain [bench "take-drop" $ nfIO $ takeDrop sourceUnfoldrM]

93 defaultMain [bench "dropWhileFalseX4" $

94 nfIO $ dropWhileFalseX4 sourceUnfoldrM]

95 defaultMain [bench "iterate-mapM" $

96− nfIO $ S.runStream $ iterateSource (S.mapM return) 100000 10]

96+ nfIO $ S.drain $ iterateSource (S.mapM return) 100000 10]

src/Streamly/Array.hs+9−11

@@ -142,7 +142,6 @@ import System.IO (Handle, hGetBufSome, hPutBuf)

142import Prelude hiding (length, null, last, map, (!!))

143

144import GHC.ForeignPtr (mallocPlainForeignPtrBytes)

145−import GHC.IO (unsafeDupablePerformIO)

146

145

147import Streamly.Streams.Serial (SerialT)

146import Streamly.Streams.Serial (SerialT)

148import Streamly.Streams.StreamK.Type (IsStream, mkStream)

147import Streamly.Streams.StreamK.Type (IsStream, mkStream)

@@ -162,7 +161,7 @@ import qualified Streamly.Prelude as S

162--

161--

163-- @since 0.7.0

162-- @since 0.7.0

164{-# INLINE fromStreamN #-}

163{-# INLINE fromStreamN #-}

165−fromStreamN :: (Monad m, Storable a) => Int -> SerialT m a -> m (Array a)

164+fromStreamN :: (MonadIO m, Storable a) => Int -> SerialT m a -> m (Array a)

166fromStreamN n m = fromStreamDN n $ D.toStreamD m

165fromStreamN n m = fromStreamDN n $ D.toStreamD m

167

166

168-------------------------------------------------------------------------------

167-------------------------------------------------------------------------------

@@ -219,7 +218,7 @@ arr !! i =

219--

218--

220-- @since 0.7.0

219-- @since 0.7.0

221{-# INLINE flattenArrays #-}

220{-# INLINE flattenArrays #-}

222−flattenArrays :: (IsStream t, Monad m, Storable a) => t m (Array a) -> t m a

221+flattenArrays :: (IsStream t, MonadIO m, Storable a) => t m (Array a) -> t m a

223flattenArrays m = D.fromStreamD $ A.flattenArrays (D.toStreamD m)

222flattenArrays m = D.fromStreamD $ A.flattenArrays (D.toStreamD m)

224

223

225-- XXX should we have a reverseArrays API to reverse the stream of arrays

224-- XXX should we have a reverseArrays API to reverse the stream of arrays

@@ -230,7 +229,7 @@ flattenArrays m = D.fromStreamD $ A.flattenArrays (D.toStreamD m)

230--

229--

231-- @since 0.7.0

230-- @since 0.7.0

232{-# INLINE _flattenArraysRev #-}

231{-# INLINE _flattenArraysRev #-}

233−_flattenArraysRev :: (IsStream t, Monad m, Storable a) => t m (Array a) -> t m a

232+_flattenArraysRev :: (IsStream t, MonadIO m, Storable a) => t m (Array a) -> t m a

234_flattenArraysRev m = D.fromStreamD $ A.flattenArraysRev (D.toStreamD m)

233_flattenArraysRev m = D.fromStreamD $ A.flattenArraysRev (D.toStreamD m)

235

234

236-- |

235-- |

@@ -240,7 +239,7 @@ _flattenArraysRev m = D.fromStreamD $ A.flattenArraysRev (D.toStreamD m)

240--

239--

241-- @since 0.7.0

240-- @since 0.7.0

242{-# INLINE arraysOf #-}

241{-# INLINE arraysOf #-}

243−arraysOf :: (IsStream t, Monad m, Storable a)

242+arraysOf :: (IsStream t, MonadIO m, Storable a)

244 => Int -> t m a -> t m (Array a)

243 => Int -> t m a -> t m (Array a)

245arraysOf n str =

244arraysOf n str =

246 D.fromStreamD $ fromStreamDArraysOf n (D.toStreamD str)

245 D.fromStreamD $ fromStreamDArraysOf n (D.toStreamD str)

@@ -250,23 +249,22 @@ arraysOf n str =

250--

249--

251-- @since 0.7.0

250-- @since 0.7.0

252{-# INLINABLE spliceArrays #-}

251{-# INLINABLE spliceArrays #-}

253−spliceArrays :: (Monad m, Storable a) => SerialT m (Array a) -> m (Array a)

252+spliceArrays :: (MonadIO m, Storable a) => SerialT m (Array a) -> m (Array a)

254spliceArrays s = do

253spliceArrays s = do

255 buffered <- S.foldr S.cons S.nil s

254 buffered <- S.foldr S.cons S.nil s

256 len <- S.sum (S.map length buffered)

255 len <- S.sum (S.map length buffered)

257

256

258− let !arr = unsafeDupablePerformIO $ unsafeNew len

257+ arr <- liftIO $ newArray len

259− end <- S.foldl' write (aEnd arr) buffered

258+ end <- S.foldlM' write (aEnd arr) buffered

260 return $ arr {aEnd = end}

259 return $ arr {aEnd = end}

261

260

262 where

261 where

263

262

264 write dst Array{..} =

263 write dst Array{..} =

265− let !dst' = unsafeInlineIO $ withForeignPtr aStart $ \src -> do

264+ liftIO $ withForeignPtr aStart $ \src -> do

266 let len = aEnd `minusPtr` src

265 let len = aEnd `minusPtr` src

267 memcpy (castPtr dst) (castPtr src) len

266 memcpy (castPtr dst) (castPtr src) len

268 return $ dst `plusPtr` len

267 return $ dst `plusPtr` len

269− in dst'

270

268

271-- | Create an 'Array' from a stream. This is useful when we want to create a

269-- | Create an 'Array' from a stream. This is useful when we want to create a

272-- single array from a stream of unknown size. 'fromStreamN' is at least twice

270-- single array from a stream of unknown size. 'fromStreamN' is at least twice

@@ -277,7 +275,7 @@ spliceArrays s = do

277-- processing of indvidual arrays in the resulting stream should be preferred.

275-- processing of indvidual arrays in the resulting stream should be preferred.

278--

276--

279{-# INLINE fromStream #-}

277{-# INLINE fromStream #-}

280−fromStream :: (Monad m, Storable a) => SerialT m a -> m (Array a)

278+fromStream :: (MonadIO m, Storable a) => SerialT m a -> m (Array a)

281fromStream m = A.fromStreamD $ D.toStreamD m

279fromStream m = A.fromStreamD $ D.toStreamD m

282

280

283{-

281{-

src/Streamly/Array/Types.hs+56−40

@@ -25,7 +25,7 @@ module Streamly.Array.Types

25 -- * Construction

26 , unsafeInlineIO

27 , withNewArray

28− , unsafeNew

28+ , newArray

29 , unsafeAppend

30 , shrinkToFit

31 , memcpy

@@ -40,6 +40,7 @@ module Streamly.Array.Types

40 , flattenArraysRev

42 -- * Elimination

43+ , unsafeIndexIO

43 , unsafeIndex

44 , unsafeIndex

44 , length

45 , length

45 , foldl'

46 , foldl'

@@ -59,6 +60,7 @@ where

59import Control.Exception (assert)

60import Control.Exception (assert)

60import Control.DeepSeq (NFData(..))

61import Control.DeepSeq (NFData(..))

61import Control.Monad (when)

62import Control.Monad (when)

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

62import Data.Functor.Identity (runIdentity)

64import Data.Functor.Identity (runIdentity)

63import Data.Word (Word8)

65import Data.Word (Word8)

64import Foreign.C.String (CString)

66import Foreign.C.String (CString)

@@ -74,7 +76,7 @@ import Text.Read (readPrec, readListPrec, readListPrecDefault)

74import GHC.Base (Addr#, realWorld#)

76import GHC.Base (Addr#, realWorld#)

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

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

76import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes, newForeignPtr_)

78import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes, newForeignPtr_)

77−import GHC.IO (IO(IO), unsafeDupablePerformIO)

79+import GHC.IO (IO(IO), unsafePerformIO)

78import GHC.Ptr (Ptr(..))

80import GHC.Ptr (Ptr(..))

80import Streamly.Fold.Types (Fold(..))

82import Streamly.Fold.Types (Fold(..))

@@ -84,6 +86,10 @@ import qualified Streamly.Streams.StreamD.Type as D

84import qualified Streamly.Streams.StreamK as K

86import qualified Streamly.Streams.StreamK as K

85import qualified GHC.Exts as Exts

87import qualified GHC.Exts as Exts

89+#ifdef DEVBUILD

90+import qualified Data.Foldable as F

91+#endif

92+

87-------------------------------------------------------------------------------

93-------------------------------------------------------------------------------

88-- Design Notes

94-- Design Notes

89-------------------------------------------------------------------------------

95-------------------------------------------------------------------------------

@@ -178,9 +184,9 @@ unsafeInlineIO (IO m) = case m realWorld# of (# _, r #) -> r

178--

184--

179-- Note that this is internal routine, the reference to this array cannot be

185-- Note that this is internal routine, the reference to this array cannot be

180-- given out until the array has been written to and frozen.

186-- given out until the array has been written to and frozen.

181−{-# INLINE unsafeNew #-}

187+{-# INLINE newArray #-}

182−unsafeNew :: forall a. Storable a => Int -> IO (Array a)

188+newArray :: forall a. Storable a => Int -> IO (Array a)

183−unsafeNew count = do

189+newArray count = do

184 let size = count * sizeOf (undefined :: a)

190 let size = count * sizeOf (undefined :: a)

185 fptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: a))

191 fptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: a))

186 let p = unsafeForeignPtrToPtr fptr

192 let p = unsafeForeignPtrToPtr fptr

@@ -195,7 +201,7 @@ unsafeNew count = do

195{-# INLINE withNewArray #-}

201{-# INLINE withNewArray #-}

196withNewArray :: forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Array a)

202withNewArray :: forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Array a)

197withNewArray count f = do

203withNewArray count f = do

198− arr <- unsafeNew count

204+ arr <- newArray count

199 withForeignPtr (aStart arr) $ \p -> f p >> return arr

205 withForeignPtr (aStart arr) $ \p -> f p >> return arr

200

206

201-- XXX grow the array when we are beyond bound.

207-- XXX grow the array when we are beyond bound.

@@ -263,18 +269,23 @@ _fromCStringAddrUnsafe addr# = do

263-- Elimination

269-- Elimination

264-------------------------------------------------------------------------------

270-------------------------------------------------------------------------------

265

271

272+-- | Return element at the specified index without checking the bounds.

273+--

274+-- Unsafe because it does not check the bounds of the array.

275+{-# INLINE_NORMAL unsafeIndexIO #-}

276+unsafeIndexIO :: forall a. Storable a => Array a -> Int -> IO a

277+unsafeIndexIO Array {..} i =

278+ withForeignPtr aStart $ \p -> do

279+ let elemSize = sizeOf (undefined :: a)

280+ elemOff = p `plusPtr` (elemSize * i)

281+ assert (i >= 0 && elemOff `plusPtr` elemSize <= aEnd)

282+ (return ())

283+ peek elemOff

284+

266-- | Return element at the specified index without checking the bounds.

285-- | Return element at the specified index without checking the bounds.

267{-# INLINE_NORMAL unsafeIndex #-}

286{-# INLINE_NORMAL unsafeIndex #-}

268unsafeIndex :: forall a. Storable a => Array a -> Int -> a

287unsafeIndex :: forall a. Storable a => Array a -> Int -> a

269−unsafeIndex Array {..} i =

270− let !r = unsafeInlineIO $

288+unsafeIndex arr i = let !r = unsafeInlineIO $ unsafeIndexIO arr i in r

271− withForeignPtr aStart $ \p -> do

272− let elemSize = sizeOf (undefined :: a)

273− elemOff = p `plusPtr` (elemSize * i)

274− assert (i >= 0 && elemOff `plusPtr` elemSize <= aEnd)

275− (return ())

276− peek elemOff

277− in r

278

289

279-- | /O(1)/ Get the length of the array.

290-- | /O(1)/ Get the length of the array.

280--

291--

@@ -297,6 +308,12 @@ toStreamD Array{..} =

297 {-# INLINE_LATE step #-}

308 {-# INLINE_LATE step #-}

298 step _ p | p == aEnd = return D.Stop

309 step _ p | p == aEnd = return D.Stop

299 step _ p = do

310 step _ p = do

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

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

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

314+ --

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

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

300 let !x = unsafeInlineIO $ do

317 let !x = unsafeInlineIO $ do

301 r <- peek p

318 r <- peek p

302 touchForeignPtr aStart

319 touchForeignPtr aStart

@@ -314,6 +331,7 @@ toStreamDRev Array{..} =

314 {-# INLINE_LATE step #-}

331 {-# INLINE_LATE step #-}

315 step _ p | p < unsafeForeignPtrToPtr aStart = return D.Stop

332 step _ p | p < unsafeForeignPtrToPtr aStart = return D.Stop

316 step _ p = do

333 step _ p = do

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

317 let !x = unsafeInlineIO $ do

335 let !x = unsafeInlineIO $ do

318 r <- peek p

336 r <- peek p

319 touchForeignPtr aStart

337 touchForeignPtr aStart

@@ -337,18 +355,16 @@ foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr

337--

355--

338-- @since 0.7.0

356-- @since 0.7.0

339{-# INLINE_NORMAL toArrayN #-}

357{-# INLINE_NORMAL toArrayN #-}

340−toArrayN :: forall m a. (Monad m, Storable a) => Int -> Fold m a (Array a)

358+toArrayN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)

341toArrayN n = Fold step initial extract

359toArrayN n = Fold step initial extract

342

360

343 where

361 where

344

362

345− initial =

363+ initial = liftIO $ newArray n

346− let !arr = unsafeDupablePerformIO $ unsafeNew n

347− in return arr

348 step arr@(Array _ end bound) _ | end == bound = return arr

364 step arr@(Array _ end bound) _ | end == bound = return arr

349− step (Array start end bound) x =

365+ step (Array start end bound) x = do

350− let !_ = unsafeInlineIO $ poke end x

366+ liftIO $ poke end x

351− in return $ Array start (end `plusPtr` sizeOf (undefined :: a)) bound

367+ return $ Array start (end `plusPtr` sizeOf (undefined :: a)) bound

352 extract = return

368 extract = return

353

369

354{-

370{-

@@ -366,23 +382,23 @@ toArray = Fold step begin done

366-}

382-}

367

383

368{-# INLINE_NORMAL fromStreamDN #-}

384{-# INLINE_NORMAL fromStreamDN #-}

369−fromStreamDN :: forall m a. (Monad m, Storable a)

385+fromStreamDN :: forall m a. (MonadIO m, Storable a)

370 => Int -> D.Stream m a -> m (Array a)

386 => Int -> D.Stream m a -> m (Array a)

371fromStreamDN limit str = do

387fromStreamDN limit str = do

372− let !arr = unsafeDupablePerformIO $ unsafeNew limit

388+ arr <- liftIO $ newArray limit

373− end <- D.foldl' write (aEnd arr) $ D.take limit str

389+ end <- D.foldlM' write (aEnd arr) $ D.take limit str

374 return $ arr {aEnd = end}

390 return $ arr {aEnd = end}

375

391

376 where

392 where

377

393

378− write ptr x =

394+ write ptr x = do

379− let !_ = unsafeInlineIO $ poke ptr x

395+ liftIO $ poke ptr x

380− in ptr `plusPtr` sizeOf (undefined :: a)

396+ return $ ptr `plusPtr` sizeOf (undefined :: a)

381

397

382-- | @fromStreamArraysOf n stream@ groups the input stream into a stream of

398-- | @fromStreamArraysOf n stream@ groups the input stream into a stream of

383-- arrays of size n.

399-- arrays of size n.

384{-# INLINE fromStreamDArraysOf #-}

400{-# INLINE fromStreamDArraysOf #-}

385−fromStreamDArraysOf :: (Monad m, Storable a)

401+fromStreamDArraysOf :: (MonadIO m, Storable a)

386 => Int -> D.Stream m a -> D.Stream m (Array a)

402 => Int -> D.Stream m a -> D.Stream m (Array a)

387fromStreamDArraysOf n str = D.groupsOf n (toArrayN n) str

403fromStreamDArraysOf n str = D.groupsOf n (toArrayN n) str

388

404

@@ -393,7 +409,7 @@ data FlattenState s a =

393 | InnerLoop s (ForeignPtr a) (Ptr a) (Ptr a)

409 | InnerLoop s (ForeignPtr a) (Ptr a) (Ptr a)

394

410

395{-# INLINE_NORMAL flattenArrays #-}

411{-# INLINE_NORMAL flattenArrays #-}

396−flattenArrays :: forall m a. (Monad m, Storable a)

412+flattenArrays :: forall m a. (MonadIO m, Storable a)

397 => D.Stream m (Array a) -> D.Stream m a

413 => D.Stream m (Array a) -> D.Stream m a

398flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)

414flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)

399

415

@@ -413,7 +429,7 @@ flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)

413 return $ D.Skip $ OuterLoop st

429 return $ D.Skip $ OuterLoop st

414

430

415 step' _ (InnerLoop st startf p end) = do

431 step' _ (InnerLoop st startf p end) = do

416− let !x = unsafeInlineIO $ do

432+ x <- liftIO $ do

417 r <- peek p

433 r <- peek p

418 touchForeignPtr startf

434 touchForeignPtr startf

419 return r

435 return r

@@ -421,7 +437,7 @@ flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)

421 (p `plusPtr` (sizeOf (undefined :: a))) end)

437 (p `plusPtr` (sizeOf (undefined :: a))) end)

422

438

423{-# INLINE_NORMAL flattenArraysRev #-}

439{-# INLINE_NORMAL flattenArraysRev #-}

424−flattenArraysRev :: forall m a. (Monad m, Storable a)

440+flattenArraysRev :: forall m a. (MonadIO m, Storable a)

425 => D.Stream m (Array a) -> D.Stream m a

441 => D.Stream m (Array a) -> D.Stream m a

426flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)

442flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)

427

443

@@ -442,7 +458,7 @@ flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)

442 return $ D.Skip $ OuterLoop st

458 return $ D.Skip $ OuterLoop st

443

459

444 step' _ (InnerLoop st startf p end) = do

460 step' _ (InnerLoop st startf p end) = do

445− let !x = unsafeInlineIO $ do

461+ x <- liftIO $ do

446 r <- peek p

462 r <- peek p

447 touchForeignPtr startf

463 touchForeignPtr startf

448 return r

464 return r

@@ -454,7 +470,7 @@ flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)

454-- all the arrays.

470-- all the arrays.

455--

471--

456{-# INLINE fromStreamD #-}

472{-# INLINE fromStreamD #-}

457−fromStreamD :: (Monad m, Storable a) => D.Stream m a -> m (Array a)

473+fromStreamD :: (MonadIO m, Storable a) => D.Stream m a -> m (Array a)

458fromStreamD m = do

474fromStreamD m = do

459 let s = fromStreamDArraysOf defaultChunkSize m

475 let s = fromStreamDArraysOf defaultChunkSize m

460 buffered <- D.foldr K.cons K.nil s

476 buffered <- D.foldr K.cons K.nil s

@@ -479,14 +495,14 @@ instance (Show a, Storable a) => Show (Array a) where

479-- @since 0.7.0

495-- @since 0.7.0

480{-# INLINABLE fromListN #-}

496{-# INLINABLE fromListN #-}

481fromListN :: Storable a => Int -> [a] -> Array a

497fromListN :: Storable a => Int -> [a] -> Array a

482−fromListN n xs = runIdentity $ fromStreamDN n $ D.fromList xs

498+fromListN n xs = unsafePerformIO $ fromStreamDN n $ D.fromList xs

483

499

484-- | Create an 'Array' from a list. The list must be of finite size.

500-- | Create an 'Array' from a list. The list must be of finite size.

485--

501--

486-- @since 0.7.0

502-- @since 0.7.0

487{-# INLINABLE fromList #-}

503{-# INLINABLE fromList #-}

488fromList :: Storable a => [a] -> Array a

504fromList :: Storable a => [a] -> Array a

489−fromList xs = runIdentity $ fromStreamD $ D.fromList xs

505+fromList xs = unsafePerformIO $ fromStreamD $ D.fromList xs

490

506

491instance (Storable a, Read a, Show a) => Read (Array a) where

507instance (Storable a, Read a, Show a) => Read (Array a) where

492 {-# INLINE readPrec #-}

508 {-# INLINE readPrec #-}

@@ -540,7 +556,7 @@ instance (Storable a, NFData a) => NFData (Array a) where

540

556

541instance (Storable a, Ord a) => Ord (Array a) where

557instance (Storable a, Ord a) => Ord (Array a) where

542 {-# INLINE compare #-}

558 {-# INLINE compare #-}

543− compare arr1 arr2 = runIdentity $

559+ compare arr1 arr2 = unsafePerformIO $

544 D.cmpBy compare (toStreamD arr1) (toStreamD arr2)

560 D.cmpBy compare (toStreamD arr1) (toStreamD arr2)

545

561

546 -- Default definitions defined in base do not have an INLINE on them, so we

562 -- Default definitions defined in base do not have an INLINE on them, so we

@@ -570,7 +586,7 @@ instance (Storable a, Ord a) => Ord (Array a) where

570-- make the Foldable instance possible though it is much slower (7x slower).

586-- make the Foldable instance possible though it is much slower (7x slower).

571--

587--

572{-# INLINE_NORMAL toStreamD_ #-}

588{-# INLINE_NORMAL toStreamD_ #-}

573−toStreamD_ :: forall m a. Monad m => Int -> Array a -> D.Stream m a

589+toStreamD_ :: forall m a. MonadIO m => Int -> Array a -> D.Stream m a

574toStreamD_ size Array{..} =

590toStreamD_ size Array{..} =

575 let p = unsafeForeignPtrToPtr aStart

591 let p = unsafeForeignPtrToPtr aStart

576 in D.Stream step p

592 in D.Stream step p

@@ -580,7 +596,7 @@ toStreamD_ size Array{..} =

580 {-# INLINE_LATE step #-}

596 {-# INLINE_LATE step #-}

581 step _ p | p == aEnd = return D.Stop

597 step _ p | p == aEnd = return D.Stop

582 step _ p = do

598 step _ p = do

583− let !x = unsafeInlineIO $ do

599+ x <- liftIO $ do

584 r <- peek p

600 r <- peek p

585 touchForeignPtr aStart

601 touchForeignPtr aStart

586 return r

602 return r

@@ -590,7 +606,7 @@ toStreamD_ size Array{..} =

590_foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b

606_foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b

591_foldr f z arr@Array {..} =

607_foldr f z arr@Array {..} =

592 let !n = sizeOf (undefined :: a)

608 let !n = sizeOf (undefined :: a)

593− in runIdentity $ D.foldr f z $ toStreamD_ n arr

609+ in unsafePerformIO $ D.foldr f z $ toStreamD_ n arr

594

610

595-- | Note that the 'Foldable' instance is 7x slower than the direct

611-- | Note that the 'Foldable' instance is 7x slower than the direct

596-- operations.

612-- operations.

src/Streamly/Fold.hs+4−3

@@ -294,6 +294,7 @@ module Streamly.Fold

294 )

295where

296

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

297import Data.Functor.Identity (Identity)

298import Data.Functor.Identity (Identity)

298import Foreign.Storable (Storable(..))

299import Foreign.Storable (Storable(..))

299import Prelude

300import Prelude

@@ -1347,7 +1348,7 @@ _splitSuffixBy' predicate f m = grouped f (S.map (\a -> (a, predicate a)) m)

1347-- @since 0.7.0

1348-- @since 0.7.0

1348{-# INLINE splitOn #-}

1349{-# INLINE splitOn #-}

1349splitOn

1350splitOn

1350− :: (IsStream t, Monad m, Storable a, Enum a, Eq a)

1351+ :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)

1351 => Array a -> Fold m a b -> t m a -> t m b

1352 => Array a -> Fold m a b -> t m a -> t m b

1352splitOn patt f m = D.fromStreamD $ D.splitOn patt f (D.toStreamD m)

1353splitOn patt f m = D.fromStreamD $ D.splitOn patt f (D.toStreamD m)

1353

1354

@@ -1395,7 +1396,7 @@ splitOnAny subseq f m = undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.to

1395-- @since 0.7.0

1396-- @since 0.7.0

1396{-# INLINE splitSuffixOn #-}

1397{-# INLINE splitSuffixOn #-}

1397splitSuffixOn

1398splitSuffixOn

1398− :: (IsStream t, Monad m, Storable a, Enum a, Eq a)

1399+ :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)

1399 => Array a -> Fold m a b -> t m a -> t m b

1400 => Array a -> Fold m a b -> t m a -> t m b

1400splitSuffixOn patt f m =

1401splitSuffixOn patt f m =

1401 D.fromStreamD $ D.splitSuffixOn False patt f (D.toStreamD m)

1402 D.fromStreamD $ D.splitSuffixOn False patt f (D.toStreamD m)

@@ -1482,7 +1483,7 @@ splitOn' patt f m = S.intersperseM

1482-- @since 0.7.0

1483-- @since 0.7.0

1483{-# INLINE splitSuffixOn' #-}

1484{-# INLINE splitSuffixOn' #-}

1484splitSuffixOn'

1485splitSuffixOn'

1485− :: (IsStream t, Monad m, Storable a, Enum a, Eq a)

1486+ :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)

1486 => Array a -> Fold m a b -> t m a -> t m b

1487 => Array a -> Fold m a b -> t m a -> t m b

1487splitSuffixOn' patt f m =

1488splitSuffixOn' patt f m =

1488 D.fromStreamD $ D.splitSuffixOn True patt f (D.toStreamD m)

1489 D.fromStreamD $ D.splitSuffixOn True patt f (D.toStreamD m)

src/Streamly/Prelude.hs+1−1

@@ -1875,7 +1875,7 @@ reverse s = fromStreamS $ S.reverse $ toStreamS s

1875--

1876-- @since 0.7.0

1877{-# INLINE reverse' #-}

1878−reverse' :: (IsStream t, Monad m, Storable a) => t m a -> t m a

1878+reverse' :: (IsStream t, MonadIO m, Storable a) => t m a -> t m a

1879reverse' s = fromStreamD $ D.reverse' $ toStreamD s

1880

1881------------------------------------------------------------------------------

src/Streamly/RingBuffer.hs+41−30

@@ -16,15 +16,15 @@ module Streamly.RingBuffer

16 ( RingBuffer(..)

18 -- * Construction

19− , unsafeNew

19+ , new

21 -- * Modification

22− , insert

22+ , unsafeInsert

24 -- * Folds

25− , foldRing

25+ , unsafeFoldRing

26− , foldRingM

26+ , unsafeFoldRingM

27− , foldRingFullM

27+ , unsafeFoldRingFullM

29 -- * Fast Byte Comparisons

30 , unsafeEqArray

@@ -45,10 +45,10 @@ import qualified Streamly.Array.Types as A

45-- | A ring buffer is a mutable array of fixed size. Initially the array is

46-- empty, with ringStart pointing at the start of allocated memory. We call the

47-- next location to be written in the ring as ringHead. Initially ringHead ==

48−-- ringStart. When the first item is added ringHead points to ringStart +

48+-- ringStart. When the first item is added, ringHead points to ringStart +

49-- sizeof item. When the buffer becomes full ringHead would wrap around to

50-- ringStart. When the buffer is full, ringHead always points at the oldest

51−-- item in the ring and the newest item added will always overwrite the oldest

51+-- item in the ring and the newest item added always overwrites the oldest

52-- item.

53--

54-- When using it we should keep in mind that a ringBuffer is a mutable data

@@ -60,9 +60,10 @@ data RingBuffer a = RingBuffer

60 }

62-- | Create a new ringbuffer and return the ring buffer and the ringHead.

63+-- Returns the ring and the ringHead, the ringHead is same as ringStart.

63−{-# INLINE unsafeNew #-}

64+{-# INLINE new #-}

64−unsafeNew :: forall a. Storable a => Int -> IO (RingBuffer a, Ptr a)

65+new :: forall a. Storable a => Int -> IO (RingBuffer a, Ptr a)

65−unsafeNew count = do

66+new count = do

66 let size = count * sizeOf (undefined :: a)

67 let size = count * sizeOf (undefined :: a)

67 fptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: a))

68 fptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: a))

68 let p = unsafeForeignPtrToPtr fptr

69 let p = unsafeForeignPtrToPtr fptr

@@ -82,16 +83,21 @@ advance RingBuffer{..} ringHead =

82 else unsafeForeignPtrToPtr ringStart

83 else unsafeForeignPtrToPtr ringStart

84-- | Insert an item at the head of the ring, when the ring is full this

85-- | Insert an item at the head of the ring, when the ring is full this

85−-- replaces the oldest item in the ring with the new item.

86+-- replaces the oldest item in the ring with the new item. This is unsafe

87+-- beause ringHead supplied is not verified to be within the RingBuffer. Also,

88+-- the ringStart foreignPtr must be guaranteed to be alive by the caller.

86−{-# INLINE insert #-}

89+{-# INLINE unsafeInsert #-}

87−insert :: Storable a => RingBuffer a -> Ptr a -> a -> IO (Ptr a)

90+unsafeInsert :: Storable a => RingBuffer a -> Ptr a -> a -> IO (Ptr a)

88−insert rb ringHead newVal = do

91+unsafeInsert rb ringHead newVal = do

89 poke ringHead newVal

92 poke ringHead newVal

90 -- touchForeignPtr (ringStart rb)

93 -- touchForeignPtr (ringStart rb)

91 return $ advance rb ringHead

94 return $ advance rb ringHead

96+-- XXX remove all usage of A.unsafeInlineIO

97+--

93-- | Like 'unsafeEqArray' but compares only N bytes instead of entire length of

98-- | Like 'unsafeEqArray' but compares only N bytes instead of entire length of

94−-- the ring buffer.

99+-- the ring buffer. This is unsafe because the ringHead Ptr is not checked to

100+-- be in range.

95{-# INLINE unsafeEqArrayN #-}

101{-# INLINE unsafeEqArrayN #-}

96unsafeEqArrayN :: RingBuffer a -> Ptr a -> A.Array a -> Int -> Bool

102unsafeEqArrayN :: RingBuffer a -> Ptr a -> A.Array a -> Int -> Bool

97unsafeEqArrayN RingBuffer{..} rh A.Array{..} n =

103unsafeEqArrayN RingBuffer{..} rh A.Array{..} n =

@@ -105,17 +111,17 @@ unsafeEqArrayN RingBuffer{..} rh A.Array{..} n =

105 then A.memcmp (castPtr rs) (castPtr (as `plusPtr` len))

111 then A.memcmp (castPtr rs) (castPtr (as `plusPtr` len))

106 (min (rh `minusPtr` rs) (n - len))

112 (min (rh `minusPtr` rs) (n - len))

107 else return True

113 else return True

114+ -- XXX enable these, check perf impact

108 -- touchForeignPtr ringStart

115 -- touchForeignPtr ringStart

109 -- touchForeignPtr aStart

116 -- touchForeignPtr aStart

110 return (r1 && r2)

117 return (r1 && r2)

111 in res

118 in res

112

119

113-- | Byte compare the entire length of ringBuffer with the given array,

120-- | Byte compare the entire length of ringBuffer with the given array,

114−-- starting at the supplied pointer. The supplied pointer is usually the

121+-- starting at the supplied ringHead pointer. Returns true if the Array and

115−-- ringHead, therefore it would compare the ringBuffer starting at the oldest

122+-- the ringBuffer have identical contents.

116−-- item in the ring up to the newest item in the ring.

117--

123--

118−-- Returns true if the Array and the ringBuffer have identical contents. The

124+-- This is unsafe because the ringHead Ptr is not checked to be in range. The

119-- supplied array must be equal to or bigger than the ringBuffer, ARRAY BOUNDS

125-- supplied array must be equal to or bigger than the ringBuffer, ARRAY BOUNDS

120-- ARE NOT CHECKED.

126-- ARE NOT CHECKED.

121{-# INLINE unsafeEqArray #-}

127{-# INLINE unsafeEqArray #-}

@@ -130,18 +136,23 @@ unsafeEqArray RingBuffer{..} rh A.Array{..} =

130 r1 <- A.memcmp (castPtr rh) (castPtr as) len

136 r1 <- A.memcmp (castPtr rh) (castPtr as) len

131 r2 <- A.memcmp (castPtr rs) (castPtr (as `plusPtr` len))

137 r2 <- A.memcmp (castPtr rs) (castPtr (as `plusPtr` len))

132 (rh `minusPtr` rs)

138 (rh `minusPtr` rs)

139+ -- XXX enable these, check perf impact

133 -- touchForeignPtr ringStart

140 -- touchForeignPtr ringStart

134 -- touchForeignPtr aStart

141 -- touchForeignPtr aStart

135 return (r1 && r2)

142 return (r1 && r2)

136 in res

143 in res

137

144

145+-- XXX use MonadIO

146+--

138−-- | Fold the buffer starting from ringStart to a given position using a pure

147+-- | Fold the buffer starting from ringStart up to the given 'Ptr' using a pure

139-- step function. This is useful to fold the items in the ring when the ring is

148-- step function. This is useful to fold the items in the ring when the ring is

140-- not full. The supplied pointer is usually the end of the ring.

149-- not full. The supplied pointer is usually the end of the ring.

141−{-# INLINE foldRing #-}

150+--

151+-- Unsafe because the supplied Ptr is not checked to be in range.

152+{-# INLINE unsafeFoldRing #-}

142−foldRing :: forall a b. Storable a

153+unsafeFoldRing :: forall a b. Storable a

143 => Ptr a -> (b -> a -> b) -> b -> RingBuffer a -> b

154 => Ptr a -> (b -> a -> b) -> b -> RingBuffer a -> b

144−foldRing ptr f z RingBuffer{..} =

155+unsafeFoldRing ptr f z RingBuffer{..} =

145 let !res = A.unsafeInlineIO $ withForeignPtr ringStart $ \p ->

156 let !res = A.unsafeInlineIO $ withForeignPtr ringStart $ \p ->

146 go z p ptr

157 go z p ptr

147 in res

158 in res

@@ -152,11 +163,11 @@ foldRing ptr f z RingBuffer{..} =

152 x <- peek p

163 x <- peek p

153 go (f acc x) (p `plusPtr` sizeOf (undefined :: a)) q

164 go (f acc x) (p `plusPtr` sizeOf (undefined :: a)) q

154

165

155−-- | Like foldRing but with a monadic step function.

166+-- | Like unsafeFoldRing but with a monadic step function.

156−{-# INLINE foldRingM #-}

167+{-# INLINE unsafeFoldRingM #-}

157−foldRingM :: forall m a b. (Monad m, Storable a)

168+unsafeFoldRingM :: forall m a b. (Monad m, Storable a)

158 => Ptr a -> (b -> a -> m b) -> b -> RingBuffer a -> m b

169 => Ptr a -> (b -> a -> m b) -> b -> RingBuffer a -> m b

159−foldRingM ptr f z RingBuffer{..} = go z (unsafeForeignPtrToPtr ringStart) ptr

170+unsafeFoldRingM ptr f z RingBuffer{..} = go z (unsafeForeignPtrToPtr ringStart) ptr

160 where

171 where

161 go !acc !start !end

172 go !acc !start !end

162 | start == end = return acc

173 | start == end = return acc

@@ -169,10 +180,10 @@ foldRingM ptr f z RingBuffer{..} = go z (unsafeForeignPtrToPtr ringStart) ptr

169-- pointer. Assuming the supplied ringHead pointer points to the oldest item,

180-- pointer. Assuming the supplied ringHead pointer points to the oldest item,

170-- this would fold the ring starting from the oldest item to the newest item in

181-- this would fold the ring starting from the oldest item to the newest item in

171-- the ring.

182-- the ring.

172−{-# INLINE foldRingFullM #-}

183+{-# INLINE unsafeFoldRingFullM #-}

173−foldRingFullM :: forall m a b. (Monad m, Storable a)

184+unsafeFoldRingFullM :: forall m a b. (Monad m, Storable a)

174 => Ptr a -> (b -> a -> m b) -> b -> RingBuffer a -> m b

185 => Ptr a -> (b -> a -> m b) -> b -> RingBuffer a -> m b

175−foldRingFullM rh f z rb@RingBuffer{..} = go z rh

186+unsafeFoldRingFullM rh f z rb@RingBuffer{..} = go z rh

176 where

187 where

177 go !acc !start = do

188 go !acc !start = do

178 let !x = A.unsafeInlineIO $ peek start

189 let !x = A.unsafeInlineIO $ peek start

src/Streamly/Streams/StreamD.hs+31−30

@@ -228,6 +228,7 @@ module Streamly.Streams.StreamD

228 )

229where

230

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

231import Control.Monad.Trans (MonadTrans(lift))

232import Control.Monad.Trans (MonadTrans(lift))

232import Data.Word (Word32)

233import Data.Word (Word32)

233import Data.Bits (shiftR, shiftL, (.|.), (.&.))

234import Data.Bits (shiftR, shiftL, (.|.), (.&.))

@@ -241,10 +242,8 @@ import Prelude

241 notElem, null, head, tail, zipWith, lookup, foldr1, sequence,

242 notElem, null, head, tail, zipWith, lookup, foldr1, sequence,

242 (!!), scanl, scanl1, concatMap, replicate, enumFromTo, concat,

243 (!!), scanl, scanl1, concatMap, replicate, enumFromTo, concat,

243 reverse)

244 reverse)

244−import System.IO.Unsafe (unsafeDupablePerformIO)

245

246−import Streamly.Array.Types

246+import Streamly.Array.Types (Array(..), flattenArrays)

247− (Array(..), unsafeInlineIO, unsafeIndex, flattenArrays)

248import Streamly.Fold.Types (Fold(..))

247import Streamly.Fold.Types (Fold(..))

249import Streamly.SVar (MonadAsync, defState, adaptState)

248import Streamly.SVar (MonadAsync, defState, adaptState)

250import Streamly.Sink.Types (Sink(..))

249import Streamly.Sink.Types (Sink(..))

@@ -836,7 +835,7 @@ reverse m = Stream step Nothing

836

835

837-- Much faster reverse for Storables

836-- Much faster reverse for Storables

838{-# INLINE_NORMAL reverse' #-}

837{-# INLINE_NORMAL reverse' #-}

839−reverse' :: forall m a. (Monad m, Storable a) => Stream m a -> Stream m a

838+reverse' :: forall m a. (MonadIO m, Storable a) => Stream m a -> Stream m a

840{-

839{-

841-- This commented implementation copies the whole stream into one single array

840-- This commented implementation copies the whole stream into one single array

842-- and then streams from that array, this is 3-4x faster than the chunked code

841-- and then streams from that array, this is 3-4x faster than the chunked code

@@ -1148,7 +1147,7 @@ data SplitOnState s a =

1148

1147

1149{-# INLINE_NORMAL splitOn #-}

1148{-# INLINE_NORMAL splitOn #-}

1150splitOn

1149splitOn

1151− :: forall m a b. (Monad m, Storable a, Enum a, Eq a)

1150+ :: forall m a b. (MonadIO m, Storable a, Enum a, Eq a)

1152 => Array a

1151 => Array a

1153 -> Fold m a b

1152 -> Fold m a b

1154 -> Stream m a

1153 -> Stream m a

@@ -1167,13 +1166,14 @@ splitOn patArr@Array{..} (Fold fstep initial done) (Stream step state) =

1167 if patLen == 0

1166 if patLen == 0

1168 then return $ Skip $ GO_EMPTY_PAT state

1167 then return $ Skip $ GO_EMPTY_PAT state

1169 else if patLen == 1

1168 else if patLen == 1

1170− then return $ Skip $ GO_SINGLE_PAT state (unsafeIndex patArr 0)

1169+ then do

1170+ r <- liftIO $ (A.unsafeIndexIO patArr 0)

1171+ return $ Skip $ GO_SINGLE_PAT state r

1171 else if sizeOf (undefined :: a) * patLen

1172 else if sizeOf (undefined :: a) * patLen

1172 <= sizeOf (undefined :: Word)

1173 <= sizeOf (undefined :: Word)

1173 then return $ Skip $ GO_SHORT_PAT state

1174 then return $ Skip $ GO_SHORT_PAT state

1174 else do

1175 else do

1175− let !(rb, rhead) = unsafeDupablePerformIO $

1176+ (rb, rhead) <- liftIO $ RB.new patLen

1176− RB.unsafeNew patLen

1177 return $ Skip $ GO_KARP_RABIN state rb rhead

1178

1179 stepOuter gst (GO_SINGLE_PAT stt pat) = initial >>= go SPEC stt

@@ -1264,10 +1264,10 @@ splitOn patArr@Array{..} (Fold fstep initial done) (Stream step state) =

1264 res <- step (adaptState gst) st

1265 case res of

1266 Yield x s -> do

1267− let !rh' = unsafeInlineIO (RB.insert rb rh x)

1267+ rh' <- liftIO $ RB.unsafeInsert rb rh x

1268 if idx == maxIndex

1269 then do

1270− let fold = RB.foldRing (RB.ringBound rb)

1270+ let fold = RB.unsafeFoldRing (RB.ringBound rb)

1271 let !ringHash = fold addCksum 0 rb

1272 if ringHash == patHash

1273 then go2 SPEC ringHash rh' s acc

@@ -1276,7 +1276,7 @@ splitOn patArr@Array{..} (Fold fstep initial done) (Stream step state) =

1276 Skip s -> go0 SPEC idx rh s acc

1277 Stop -> do

1278 !acc' <- if idx /= 0

1279− then RB.foldRingM rh fstep acc rb

1279+ then RB.unsafeFoldRingM rh fstep acc rb

1280 else return acc

1281 done acc' >>= \r -> return $ Yield r GO_DONE

1282

@@ -1290,20 +1290,20 @@ splitOn patArr@Array{..} (Fold fstep initial done) (Stream step state) =

1290 res <- step (adaptState gst) st

1291 case res of

1292 Yield x s -> do

1293− let !old = unsafeInlineIO $ peek rh

1293+ old <- liftIO $ peek rh

1294− cksum' = deltaCksum cksum old x

1294+ let cksum' = deltaCksum cksum old x

1295 acc' <- fstep acc old

1296

1297 if (cksum' == patHash)

1298 then do

1299− let !rh'= unsafeInlineIO (RB.insert rb rh x)

1299+ rh' <- liftIO (RB.unsafeInsert rb rh x)

1300 go2 SPEC cksum' rh' s acc'

1301 else do

1302− let !rh'= unsafeInlineIO (RB.insert rb rh x)

1302+ rh' <- liftIO (RB.unsafeInsert rb rh x)

1303 go1 SPEC cksum' rh' s acc'

1304 Skip s -> go1 SPEC cksum rh s acc

1305 Stop -> do

1306− acc' <- RB.foldRingFullM rh fstep acc rb

1306+ acc' <- RB.unsafeFoldRingFullM rh fstep acc rb

1307 done acc' >>= \r -> return $ Yield r GO_DONE

1308

1309 go2 !_ !cksum' !rh' s !acc' = do

@@ -1327,7 +1327,7 @@ splitOn patArr@Array{..} (Fold fstep initial done) (Stream step state) =

1327

1328{-# INLINE_NORMAL splitSuffixOn #-}

1329splitSuffixOn

1330− :: forall m a b. (Monad m, Storable a, Enum a, Eq a)

1330+ :: forall m a b. (MonadIO m, Storable a, Enum a, Eq a)

1331 => Bool

1332 -> Array a

1333 -> Fold m a b

@@ -1348,13 +1348,14 @@ splitSuffixOn withSep patArr@Array{..} (Fold fstep initial done)

1348 if patLen == 0

1349 then return $ Skip $ GO_EMPTY_PAT state

1350 else if patLen == 1

1351− then return $ Skip $ GO_SINGLE_PAT state (unsafeIndex patArr 0)

1351+ then do

1352+ r <- liftIO $ (A.unsafeIndexIO patArr 0)

1353+ return $ Skip $ GO_SINGLE_PAT state r

1352 else if sizeOf (undefined :: a) * patLen

1354 else if sizeOf (undefined :: a) * patLen

1353 <= sizeOf (undefined :: Word)

1355 <= sizeOf (undefined :: Word)

1354 then return $ Skip $ GO_SHORT_PAT state

1356 then return $ Skip $ GO_SHORT_PAT state

1355 else do

1357 else do

1356− let !(rb, rhead) = unsafeDupablePerformIO $

1358+ (rb, rhead) <- liftIO $ RB.new patLen

1357− RB.unsafeNew patLen

1358 return $ Skip $ GO_KARP_RABIN state rb rhead

1359 return $ Skip $ GO_KARP_RABIN state rb rhead

1359

1360

1360 stepOuter gst (GO_SINGLE_PAT stt pat) = do

1361 stepOuter gst (GO_SINGLE_PAT stt pat) = do

@@ -1484,10 +1485,10 @@ splitSuffixOn withSep patArr@Array{..} (Fold fstep initial done)

1484 Yield x s -> do

1485 Yield x s -> do

1485 acc <- initial

1486 acc <- initial

1486 acc' <- if withSep then fstep acc x else return acc

1487 acc' <- if withSep then fstep acc x else return acc

1487− let !rh' = unsafeInlineIO (RB.insert rb rhead x)

1488+ rh' <- liftIO (RB.unsafeInsert rb rhead x)

1488 if idx == maxIndex

1489 if idx == maxIndex

1489 then do

1490 then do

1490− let fold = RB.foldRing (RB.ringBound rb)

1491+ let fold = RB.unsafeFoldRing (RB.ringBound rb)

1491 let !ringHash = fold addCksum 0 rb

1492 let !ringHash = fold addCksum 0 rb

1492 if ringHash == patHash

1493 if ringHash == patHash

1493 then go2 SPEC ringHash rh' s acc'

1494 then go2 SPEC ringHash rh' s acc'

@@ -1513,10 +1514,10 @@ splitSuffixOn withSep patArr@Array{..} (Fold fstep initial done)

1513 case res of

1514 case res of

1514 Yield x s -> do

1515 Yield x s -> do

1515 acc' <- if withSep then fstep acc x else return acc

1516 acc' <- if withSep then fstep acc x else return acc

1516− let !rh' = unsafeInlineIO (RB.insert rb rh x)

1517+ rh' <- liftIO (RB.unsafeInsert rb rh x)

1517 if idx == maxIndex

1518 if idx == maxIndex

1518 then do

1519 then do

1519− let fold = RB.foldRing (RB.ringBound rb)

1520+ let fold = RB.unsafeFoldRing (RB.ringBound rb)

1520 let !ringHash = fold addCksum 0 rb

1521 let !ringHash = fold addCksum 0 rb

1521 if ringHash == patHash

1522 if ringHash == patHash

1522 then go2 SPEC ringHash rh' s acc'

1523 then go2 SPEC ringHash rh' s acc'

@@ -1529,7 +1530,7 @@ splitSuffixOn withSep patArr@Array{..} (Fold fstep initial done)

1529 then return Stop

1530 then return Stop

1530 else do

1531 else do

1531 !acc' <- if idx /= 0 && not withSep

1532 !acc' <- if idx /= 0 && not withSep

1532− then RB.foldRingM rh fstep acc rb

1533+ then RB.unsafeFoldRingM rh fstep acc rb

1533 else return acc

1534 else return acc

1534 done acc' >>= \r -> return $ Yield r GO_DONE

1535 done acc' >>= \r -> return $ Yield r GO_DONE

1535

1536

@@ -1543,18 +1544,18 @@ splitSuffixOn withSep patArr@Array{..} (Fold fstep initial done)

1543 res <- step (adaptState gst) st

1544 res <- step (adaptState gst) st

1544 case res of

1545 case res of

1545 Yield x s -> do

1546 Yield x s -> do

1546− let !old = unsafeInlineIO $ peek rh

1547+ old <- liftIO $ peek rh

1547− cksum' = deltaCksum cksum old x

1548+ let cksum' = deltaCksum cksum old x

1548 acc' <- if withSep

1549 acc' <- if withSep

1549 then fstep acc x

1550 then fstep acc x

1550 else fstep acc old

1551 else fstep acc old

1551

1552

1552 if (cksum' == patHash)

1553 if (cksum' == patHash)

1553 then do

1554 then do

1554− let !rh'= unsafeInlineIO (RB.insert rb rh x)

1555+ rh' <- liftIO (RB.unsafeInsert rb rh x)

1555 go2 SPEC cksum' rh' s acc'

1556 go2 SPEC cksum' rh' s acc'

1556 else do

1557 else do

1557− let !rh'= unsafeInlineIO (RB.insert rb rh x)

1558+ rh' <- liftIO (RB.unsafeInsert rb rh x)

1558 go1 SPEC cksum' rh' s acc'

1559 go1 SPEC cksum' rh' s acc'

1559 Skip s -> go1 SPEC cksum rh s acc

1560 Skip s -> go1 SPEC cksum rh s acc

1560 Stop -> do

1561 Stop -> do

@@ -1563,7 +1564,7 @@ splitSuffixOn withSep patArr@Array{..} (Fold fstep initial done)

1563 else do

1564 else do

1564 acc' <- if withSep

1565 acc' <- if withSep

1565 then return acc

1566 then return acc

1566− else RB.foldRingFullM rh fstep acc rb

1567+ else RB.unsafeFoldRingFullM rh fstep acc rb

1567 done acc' >>= \r -> return $ Yield r GO_DONE

1568 done acc' >>= \r -> return $ Yield r GO_DONE

1568

1569

1569 go2 !_ !cksum' !rh' s !acc' = do

1570 go2 !_ !cksum' !rh' s !acc' = do

test/Arrays.hs+36−23

@@ -3,12 +3,12 @@

4module Main (main) where

6−import Data.Functor.Identity (runIdentity)

7import Foreign.Storable (Storable(..))

6import Foreign.Storable (Storable(..))

9import Test.Hspec.QuickCheck

8import Test.Hspec.QuickCheck

10−import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, (===),

9+import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary,

11 choose)

10 choose)

11+import Test.QuickCheck.Monadic (monadicIO, assert)

13import Test.Hspec as H

@@ -41,52 +41,64 @@ testLength :: Property

41testLength =

42 forAll (choose (0, maxArrLen)) $ \len ->

43 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

44+ monadicIO $ do

44− let arr = runIdentity $ A.fromStreamN len

45+ arr <- A.fromStreamN len

45− $ S.fromList list

46+ $ S.fromList list

46− in A.length arr === len

47+ assert (A.length arr == len)

48testFromToStreamN :: Property

49testFromToStreamN :: Property

49testFromToStreamN =

50testFromToStreamN =

50 forAll (choose (0, maxArrLen)) $ \len ->

51 forAll (choose (0, maxArrLen)) $ \len ->

51 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

52 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

53+ monadicIO $ do

54+ arr <- A.fromStreamN len

55+ $ S.fromList list

56+ xs <- S.toList

57+ $ A.toStream arr

58+ assert (xs == list)

59+

60+testToStreamRev :: Property

61+testToStreamRev =

62+ forAll (choose (0, maxArrLen)) $ \len ->

63+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

64+ monadicIO $ do

52− let arr = runIdentity $ A.fromStreamN len

65+ arr <- A.fromStreamN len

53− $ S.fromList list

66+ $ S.fromList list

54− in runIdentity (S.toList (A.toStream arr)) === list

67+ xs <- S.toList

68+ $ A.toStreamRev arr

69+ assert (xs == reverse list)

56testArraysOf :: Property

71testArraysOf :: Property

57testArraysOf =

72testArraysOf =

58 forAll (choose (0, maxArrLen)) $ \len ->

73 forAll (choose (0, maxArrLen)) $ \len ->

59 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

74 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

60− let xs = runIdentity

75+ monadicIO $ do

61− $ S.toList

76+ xs <- S.toList

62 $ S.concatMap A.toStream

77 $ S.concatMap A.toStream

63 $ A.arraysOf 240

78 $ A.arraysOf 240

64 $ S.fromList list

79 $ S.fromList list

65− in xs === list

80+ assert (xs == list)

67testFlattenArrays :: Property

82testFlattenArrays :: Property

68testFlattenArrays =

83testFlattenArrays =

69 forAll (choose (0, maxArrLen)) $ \len ->

84 forAll (choose (0, maxArrLen)) $ \len ->

70 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

85 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

71− let xs = runIdentity

86+ monadicIO $ do

72− $ S.toList

87+ xs <- S.toList

73 $ A.flattenArrays

88 $ A.flattenArrays

74 $ A.arraysOf 240

89 $ A.arraysOf 240

75 $ S.fromList list

90 $ S.fromList list

76− in xs === list

91+ assert (xs == list)

78−{-

79testFromToStream :: Property

93testFromToStream :: Property

80testFromToStream =

94testFromToStream =

81 forAll (choose (0, maxArrLen)) $ \len ->

95 forAll (choose (0, maxArrLen)) $ \len ->

82 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

96 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

83− let xs = runIdentity

97+ monadicIO $ do

98+ arr <- A.fromStream $ S.fromList list

84− $ S.toList

99+ xs <- S.toList

85− $ A.toStream

100+ $ A.toStream arr

86− $ runIdentity. A.fromStream

87− $ S.fromList list

88− in xs === list

101+ assert (xs == list)

89−-}

102

91main :: IO ()

103main :: IO ()

92main = hspec

104main = hspec

@@ -96,6 +108,7 @@ main = hspec

96 describe "Construction" $ do

108 describe "Construction" $ do

97 prop "length . fromStreamN n === n" $ testLength

109 prop "length . fromStreamN n === n" $ testLength

98 prop "toStream . fromStreamN n === id" $ testFromToStreamN

110 prop "toStream . fromStreamN n === id" $ testFromToStreamN

111+ prop "toStreamRev . fromStream === reverse" $ testToStreamRev

99 prop "arraysOf concats to original" $ testArraysOf

112 prop "arraysOf concats to original" $ testArraysOf

100 prop "flattenArrays concats to original" $ testFlattenArrays

113 prop "flattenArrays concats to original" $ testFlattenArrays

101− -- prop "toStream . fromStream === id" $ testFromToStream

114+ prop "toStream . fromStream === id" $ testFromToStream

test/Prop.hs+1

@@ -452,6 +452,7 @@ transformCombineOpsCommon constr desc eq t = do

452

453 -- reordering

454 prop (desc <> " reverse") $ transform reverse t S.reverse

455+ prop (desc <> " reverse'") $ transform reverse t S.reverse'

455

456

456 -- inserting

457 -- inserting

457 prop (desc <> " intersperseM") $

458 prop (desc <> " intersperseM") $