c0d4e04 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Use (concatMapU A.readU) instead of flattenArrays

c0d4e04Harendra Kumar7 years ago

src/Streamly/Benchmark/FileIO/Stream.hs+19−1

compare with master

unifiedsplit

@@ -62,6 +62,7 @@ last = S.last . FH.read

62hinspect $ hasNoTypeClasses 'last

63hinspect $ 'last `hasNoType` ''Step

64hinspect $ 'last `hasNoType` ''AT.FlattenState

65+hinspect $ 'last `hasNoType` ''D.ConcatMapUState

66-- assert that flattenArrays constructors are not present

67-- assert that flattenArrays constructors are not present

67-- | Count the number of bytes in a file.

68-- | Count the number of bytes in a file.

@@ -72,6 +73,7 @@ countBytes = S.length . FH.read

72hinspect $ hasNoTypeClasses 'countBytes

73hinspect $ hasNoTypeClasses 'countBytes

73hinspect $ 'countBytes `hasNoType` ''Step

74hinspect $ 'countBytes `hasNoType` ''Step

74hinspect $ 'countBytes `hasNoType` ''AT.FlattenState

75hinspect $ 'countBytes `hasNoType` ''AT.FlattenState

76+hinspect $ 'countBytes `hasNoType` ''D.ConcatMapUState

76-- | Count the number of lines in a file.

78-- | Count the number of lines in a file.

77{-# INLINE countLines #-}

79{-# INLINE countLines #-}

@@ -85,6 +87,7 @@ countLines =

85hinspect $ hasNoTypeClasses 'countLines

87hinspect $ hasNoTypeClasses 'countLines

86hinspect $ 'countLines `hasNoType` ''Step

88hinspect $ 'countLines `hasNoType` ''Step

87hinspect $ 'countLines `hasNoType` ''AT.FlattenState

89hinspect $ 'countLines `hasNoType` ''AT.FlattenState

90+hinspect $ 'countLines `hasNoType` ''D.ConcatMapUState

89-- | Count the number of lines in a file.

92-- | Count the number of lines in a file.

90{-# INLINE countLinesU #-}

93{-# INLINE countLinesU #-}

@@ -97,7 +100,7 @@ countLinesU inh =

100

98hinspect $ hasNoTypeClasses 'countLinesU

101hinspect $ hasNoTypeClasses 'countLinesU

99hinspect $ 'countLinesU `hasNoType` ''Step

102hinspect $ 'countLinesU `hasNoType` ''Step

100−hinspect $ 'countLinesU `hasNoType` ''Either

103+hinspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState

101

104

102-- | Sum the bytes in a file.

105-- | Sum the bytes in a file.

103{-# INLINE sumBytes #-}

106{-# INLINE sumBytes #-}

@@ -107,6 +110,7 @@ sumBytes = S.sum . FH.read

107hinspect $ hasNoTypeClasses 'sumBytes

110hinspect $ hasNoTypeClasses 'sumBytes

108hinspect $ 'sumBytes `hasNoType` ''Step

111hinspect $ 'sumBytes `hasNoType` ''Step

109hinspect $ 'sumBytes `hasNoType` ''AT.FlattenState

112hinspect $ 'sumBytes `hasNoType` ''AT.FlattenState

113+hinspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState

110

114

111-- | Send the file contents to /dev/null

115-- | Send the file contents to /dev/null

112{-# INLINE cat #-}

116{-# INLINE cat #-}

@@ -116,6 +120,7 @@ cat devNull inh = S.runFold (FH.write devNull) $ FH.read inh

116hinspect $ hasNoTypeClasses 'cat

120hinspect $ hasNoTypeClasses 'cat

117hinspect $ 'cat `hasNoType` ''Step

121hinspect $ 'cat `hasNoType` ''Step

118hinspect $ 'cat `hasNoType` ''AT.FlattenState

122hinspect $ 'cat `hasNoType` ''AT.FlattenState

123+hinspect $ 'cat `hasNoType` ''D.ConcatMapUState

119

124

120-- | Send the file contents to /dev/null

125-- | Send the file contents to /dev/null

121{-# INLINE catStreamWrite #-}

126{-# INLINE catStreamWrite #-}

@@ -125,6 +130,7 @@ catStreamWrite devNull inh = Internal.writeS devNull $ FH.read inh

125hinspect $ hasNoTypeClasses 'catStreamWrite

130hinspect $ hasNoTypeClasses 'catStreamWrite

126hinspect $ 'catStreamWrite `hasNoType` ''Step

131hinspect $ 'catStreamWrite `hasNoType` ''Step

127hinspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState

132hinspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState

133+hinspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState

128

134

129-- | Copy file

135-- | Copy file

130{-# INLINE copy #-}

136{-# INLINE copy #-}

@@ -134,6 +140,7 @@ copy inh outh = S.runFold (FH.write outh) (FH.read inh)

134hinspect $ hasNoTypeClasses 'copy

140hinspect $ hasNoTypeClasses 'copy

135hinspect $ 'copy `hasNoType` ''Step

141hinspect $ 'copy `hasNoType` ''Step

136hinspect $ 'copy `hasNoType` ''AT.FlattenState

142hinspect $ 'copy `hasNoType` ''AT.FlattenState

143+hinspect $ 'copy `hasNoType` ''D.ConcatMapUState

137

144

138-- | Copy file

145-- | Copy file

139{-# INLINE copyCodecChar8 #-}

146{-# INLINE copyCodecChar8 #-}

@@ -147,6 +154,7 @@ copyCodecChar8 inh outh =

147hinspect $ hasNoTypeClasses 'copyCodecChar8

154hinspect $ hasNoTypeClasses 'copyCodecChar8

148hinspect $ 'copyCodecChar8 `hasNoType` ''Step

155hinspect $ 'copyCodecChar8 `hasNoType` ''Step

149hinspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState

156hinspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState

157+hinspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState

150

158

151-- | Copy file

159-- | Copy file

152{-# INLINE copyCodecUtf8 #-}

160{-# INLINE copyCodecUtf8 #-}

@@ -160,6 +168,7 @@ copyCodecUtf8 inh outh =

160hinspect $ hasNoTypeClasses 'copyCodecUtf8

168hinspect $ hasNoTypeClasses 'copyCodecUtf8

161-- hinspect $ 'copyCodecUtf8 `hasNoType` ''Step

169-- hinspect $ 'copyCodecUtf8 `hasNoType` ''Step

162-- hinspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState

170-- hinspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState

171+-- hinspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState

163

172

164-- | Slice in chunks of size n and get the count of chunks.

173-- | Slice in chunks of size n and get the count of chunks.

165{-# INLINE chunksOf #-}

174{-# INLINE chunksOf #-}

@@ -171,6 +180,7 @@ chunksOf n inh =

171hinspect $ hasNoTypeClasses 'chunksOf

180hinspect $ hasNoTypeClasses 'chunksOf

172hinspect $ 'chunksOf `hasNoType` ''Step

181hinspect $ 'chunksOf `hasNoType` ''Step

173hinspect $ 'chunksOf `hasNoType` ''AT.FlattenState

182hinspect $ 'chunksOf `hasNoType` ''AT.FlattenState

183+hinspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState

174hinspect $ 'chunksOf `hasNoType` ''GroupState

184hinspect $ 'chunksOf `hasNoType` ''GroupState

175

185

176-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'

186-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'

@@ -188,6 +198,7 @@ hinspect $ hasNoTypeClasses 'chunksOf

188hinspect $ 'chunksOf `hasNoType` ''Step

198hinspect $ 'chunksOf `hasNoType` ''Step

189hinspect $ 'chunksOfD `hasNoType` ''GroupState

199hinspect $ 'chunksOfD `hasNoType` ''GroupState

190hinspect $ 'chunksOfD `hasNoType` ''AT.FlattenState

200hinspect $ 'chunksOfD `hasNoType` ''AT.FlattenState

201+hinspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState

191

202

192-- | Lines and unlines

203-- | Lines and unlines

193{-# INLINE linesUnlinesCopy #-}

204{-# INLINE linesUnlinesCopy #-}

@@ -203,6 +214,7 @@ linesUnlinesCopy inh outh =

203-- hinspect $ hasNoTypeClasses 'linesUnlinesCopy

214-- hinspect $ hasNoTypeClasses 'linesUnlinesCopy

204-- hinspect $ 'linesUnlinesCopy `hasNoType` ''Step

215-- hinspect $ 'linesUnlinesCopy `hasNoType` ''Step

205-- hinspect $ 'linesUnlinesCopy `hasNoType` ''AT.FlattenState

216-- hinspect $ 'linesUnlinesCopy `hasNoType` ''AT.FlattenState

217+-- hinspect $ 'linesUnlinesCopy `hasNoType` ''D.ConcatMapUState

206

218

207-- | Word, unwords and copy

219-- | Word, unwords and copy

208{-# INLINE wordsUnwordsCopy #-}

220{-# INLINE wordsUnwordsCopy #-}

@@ -218,6 +230,7 @@ wordsUnwordsCopy inh outh =

218-- hinspect $ hasNoTypeClasses 'wordsUnwordsCopy

230-- hinspect $ hasNoTypeClasses 'wordsUnwordsCopy

219-- hinspect $ 'wordsUnwordsCopy `hasNoType` ''Step

231-- hinspect $ 'wordsUnwordsCopy `hasNoType` ''Step

220-- hinspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState

232-- hinspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState

233+-- hinspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState

221

234

222lf :: Word8

235lf :: Word8

223lf = fromIntegral (ord '\n')

236lf = fromIntegral (ord '\n')

@@ -256,6 +269,7 @@ splitOn inh =

256hinspect $ hasNoTypeClasses 'splitOn

269hinspect $ hasNoTypeClasses 'splitOn

257hinspect $ 'splitOn `hasNoType` ''Step

270hinspect $ 'splitOn `hasNoType` ''Step

258hinspect $ 'splitOn `hasNoType` ''AT.FlattenState

271hinspect $ 'splitOn `hasNoType` ''AT.FlattenState

272+hinspect $ 'splitOn `hasNoType` ''D.ConcatMapUState

259

273

260-- | Split suffix on line feed.

274-- | Split suffix on line feed.

261{-# INLINE splitOnSuffix #-}

275{-# INLINE splitOnSuffix #-}

@@ -267,6 +281,7 @@ splitOnSuffix inh =

267hinspect $ hasNoTypeClasses 'splitOnSuffix

281hinspect $ hasNoTypeClasses 'splitOnSuffix

268hinspect $ 'splitOnSuffix `hasNoType` ''Step

282hinspect $ 'splitOnSuffix `hasNoType` ''Step

269hinspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState

283hinspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState

284+hinspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState

270

285

271-- | Words by space

286-- | Words by space

272{-# INLINE wordsBy #-}

287{-# INLINE wordsBy #-}

@@ -278,6 +293,7 @@ wordsBy inh =

278hinspect $ hasNoTypeClasses 'wordsBy

293hinspect $ hasNoTypeClasses 'wordsBy

279hinspect $ 'wordsBy `hasNoType` ''Step

294hinspect $ 'wordsBy `hasNoType` ''Step

280hinspect $ 'wordsBy `hasNoType` ''AT.FlattenState

295hinspect $ 'wordsBy `hasNoType` ''AT.FlattenState

296+hinspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState

281

297

282-- | Split on a character sequence.

298-- | Split on a character sequence.

283{-# INLINE splitOnSeq #-}

299{-# INLINE splitOnSeq #-}

@@ -289,6 +305,7 @@ splitOnSeq str inh =

289hinspect $ hasNoTypeClasses 'splitOnSeq

305hinspect $ hasNoTypeClasses 'splitOnSeq

290-- hinspect $ 'splitOnSeq `hasNoType` ''Step

306-- hinspect $ 'splitOnSeq `hasNoType` ''Step

291-- hinspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState

307-- hinspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState

308+-- hinspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState

292

309

293-- | Split on suffix sequence.

310-- | Split on suffix sequence.

294{-# INLINE splitOnSuffixSeq #-}

311{-# INLINE splitOnSuffixSeq #-}

@@ -300,3 +317,4 @@ splitOnSuffixSeq str inh =

300hinspect $ hasNoTypeClasses 'splitOnSuffixSeq

317hinspect $ hasNoTypeClasses 'splitOnSuffixSeq

301-- hinspect $ 'splitOnSuffixSeq `hasNoType` ''Step

318-- hinspect $ 'splitOnSuffixSeq `hasNoType` ''Step

302-- hinspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState

319-- hinspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState

320+-- hinspect $ 'splitOnSuffixSeq `hasNoType` ''D.ConcatMapUState

src/Streamly/FileSystem/Handle.hs+1−1

@@ -237,7 +237,7 @@ readInChunksOf chunkSize h = A.concat $ readArraysOf chunkSize h

237-- Generate a stream of elements of the given type from a file 'Handle'.

238-- read :: (IsStream t, MonadIO m, Storable a) => Handle -> t m a

239--

240−-- > read = 'readByChunks' A.defaultChunkSize

240+-- > read = 'readInChunksOf' A.defaultChunkSize

241-- | Generate a byte stream from a file 'Handle'.

242--

243-- @since 0.7.0

src/Streamly/Memory/Array/Types.hs+13−9

@@ -89,7 +89,7 @@ import Data.Functor.Identity (runIdentity)

89import Data.Word (Word8)

90import Foreign.C.String (CString)

91import Foreign.C.Types (CSize(..), CInt(..))

92−import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, touchForeignPtr)

92+import Foreign.ForeignPtr (withForeignPtr, touchForeignPtr)

93import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

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

95import Foreign.Storable (Storable(..))

@@ -98,7 +98,8 @@ import Text.Read (readPrec, readListPrec, readListPrecDefault)

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

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

101+import GHC.ForeignPtr

101−import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes, newForeignPtr_)

102+ (ForeignPtr(..), mallocPlainForeignPtrAlignedBytes, newForeignPtr_)

102import GHC.IO (IO(IO), unsafePerformIO)

103import GHC.IO (IO(IO), unsafePerformIO)

103import GHC.Ptr (Ptr(..))

104import GHC.Ptr (Ptr(..))

104

105

@@ -392,18 +393,21 @@ byteCapacity Array{..} =

392 len = aBound `minusPtr` p

393 len = aBound `minusPtr` p

393 in assert (len >= 0) len

394 in assert (len >= 0) len

394

395

396+data ReadUState a = ReadUState

397+ {-# UNPACK #-} !(ForeignPtr a) -- foreign ptr with end of array pointer

398+ {-# UNPACK #-} !(Ptr a) -- current pointer

399+

395{-# INLINE_NORMAL readU #-}

400{-# INLINE_NORMAL readU #-}

396readU :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a

401readU :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a

397readU = Unfold step inject

402readU = Unfold step inject

398 where

403 where

399

404

400− -- Note we have repurposed the Array type here

401− inject Array{..} =

405+ inject (Array (ForeignPtr start contents) (Ptr end) _) =

402− return $ Array aStart (unsafeForeignPtrToPtr aStart) aEnd

406+ return $ ReadUState (ForeignPtr end contents) (Ptr start)

403

407

404 {-# INLINE_LATE step #-}

408 {-# INLINE_LATE step #-}

405− step (Array _ p end) | p == end = return D.Stop

409+ step (ReadUState (ForeignPtr end _) p) | p == (Ptr end) = return D.Stop

406− step (Array start p end) = do

410+ step (ReadUState fp p) = do

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

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

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

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

409 -- accumulating the list and fusing better with the pure consumers.

413 -- accumulating the list and fusing better with the pure consumers.

@@ -412,10 +416,10 @@ readU = Unfold step inject

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

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

413 let !x = unsafeInlineIO $ do

417 let !x = unsafeInlineIO $ do

414 r <- peek p

418 r <- peek p

415− touchForeignPtr start

419+ touchForeignPtr fp

416 return r

420 return r

417 return $ D.Yield x

421 return $ D.Yield x

418− (Array start (p `plusPtr` (sizeOf (undefined :: a))) end)

422+ (ReadUState fp (p `plusPtr` (sizeOf (undefined :: a))))

419

423

420{-# INLINE_NORMAL toStreamD #-}

424{-# INLINE_NORMAL toStreamD #-}

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

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

src/Streamly/Memory/ArrayStream.hs+2−2

@@ -67,9 +67,9 @@ import qualified Streamly.Streams.Prelude as P

67-- @since 0.7.0

68{-# INLINE concat #-}

69concat :: (IsStream t, MonadIO m, Storable a) => t m (Array a) -> t m a

70−concat m = D.fromStreamD $ A.flattenArrays (D.toStreamD m)

70+-- concat m = D.fromStreamD $ A.flattenArrays (D.toStreamD m)

71-- concat m = D.fromStreamD $ D.concatMap A.toStreamD (D.toStreamD m)

72−-- concat m = D.fromStreamD $ D.concatMapU A.readU (D.toStreamD m)

72+concat m = D.fromStreamD $ D.concatMapU A.readU (D.toStreamD m)

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

75-- instead?

src/Streamly/Streams/StreamD.hs+19−12

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

135 -- ** Flattening nested streams

136 , concatMapM

137 , concatMap

138+ , ConcatMapUState (..)

138 , concatMapU

139 , concatMapU

139

140

140 -- ** Grouping

141 -- ** Grouping

@@ -1697,6 +1698,11 @@ mapM_ m = drain . mapM m

1697-- Stream transformations using Unfolds

1698-- Stream transformations using Unfolds

1698-------------------------------------------------------------------------------

1699-------------------------------------------------------------------------------

1699

1700

1701+-- Define a unique structure to use in inspection testing

1702+data ConcatMapUState o i =

1703+ ConcatMapUOuter o

1704+ | ConcatMapUInner o i

1705+

1700-- | @concatMapU unfold stream@ uses @unfold@ to map the input stream elements

1706-- | @concatMapU unfold stream@ uses @unfold@ to map the input stream elements

1701-- to streams and then flattens the generated streams into a single output

1707-- to streams and then flattens the generated streams into a single output

1702-- stream.

1708-- stream.

@@ -1708,24 +1714,25 @@ mapM_ m = drain . mapM m

1708

1714

1709{-# INLINE_NORMAL concatMapU #-}

1715{-# INLINE_NORMAL concatMapU #-}

1710concatMapU :: Monad m => Unfold m a b -> Stream m a -> Stream m b

1716concatMapU :: Monad m => Unfold m a b -> Stream m a -> Stream m b

1711−concatMapU (Unfold istep inject) (Stream ostep u) = Stream step (Left u)

1717+concatMapU (Unfold istep inject) (Stream ostep ost) =

1718+ Stream step (ConcatMapUOuter ost)

1712 where

1719 where

1713 {-# INLINE_LATE step #-}

1720 {-# INLINE_LATE step #-}

1714− step gst (Left t) = do

1721+ step gst (ConcatMapUOuter o) = do

1715− r <- ostep (adaptState gst) t

1722+ r <- ostep (adaptState gst) o

1716 case r of

1723 case r of

1717− Yield a t' -> do

1724+ Yield a o' -> do

1718− s <- inject a

1725+ i <- inject a

1719− s `seq` return (Skip (Right (s, t')))

1726+ i `seq` return (Skip (ConcatMapUInner o' i))

1720− Skip t' -> return $ Skip (Left t')

1727+ Skip o' -> return $ Skip (ConcatMapUOuter o')

1721 Stop -> return $ Stop

1728 Stop -> return $ Stop

1722

1729

1723− step _ (Right (s, t)) = do

1730+ step _ (ConcatMapUInner o i) = do

1724− r <- istep s

1731+ r <- istep i

1725 return $ case r of

1732 return $ case r of

1726− Yield x s' -> Yield x (Right (s', t))

1733+ Yield x i' -> Yield x (ConcatMapUInner o i')

1727− Skip s' -> Skip (Right (s', t))

1734+ Skip i' -> Skip (ConcatMapUInner o i')

1728− Stop -> Skip (Left t)

1735+ Stop -> Skip (ConcatMapUOuter o)

1729

1736

1730------------------------------------------------------------------------------

1737------------------------------------------------------------------------------

1731-- Exceptions

1738-- Exceptions