c0d4e04 · streamly · git.iko.soy

git.iko.soy/streamly

Use (concatMapU A.readU) instead of flattenArrays

Use a modular composition using concatMap and Unfold to express efficient flattening of arrays into a stream instead of using a custom flattenArrays. The generated code is almost identical in both the cases and measured performance is also similar. Also simplified readU to use one less variable threaded around the loop.

commitc0d4e04a1d5fd0350afa3b0ce7d32eecdb827e7f authorHarendra Kumar <harendra.kumar@gmail.com> dateMon 26 Aug 2019, 07:38 (7 years ago) parentbca0359

5 files changed+54−25

compare with master

unifiedsplit

src/Streamly/Benchmark/FileIO/Stream.hs+19−1 src/Streamly/FileSystem/Handle.hs+1−1 src/Streamly/Memory/Array/Types.hs+13−9 src/Streamly/Memory/ArrayStream.hs+2−2 src/Streamly/Streams/StreamD.hs+19−12

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

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

6262hinspect $ hasNoTypeClasses 'last

6363hinspect $ 'last `hasNoType` ''Step

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

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

6566

6667-- assert that flattenArrays constructors are not present

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

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

7273hinspect $ hasNoTypeClasses 'countBytes

7374hinspect $ 'countBytes `hasNoType` ''Step

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

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

7577

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

7779{-# INLINE countLines #-}

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

8587hinspect $ hasNoTypeClasses 'countLines

8688hinspect $ 'countLines `hasNoType` ''Step

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

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

8891

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

9093{-# INLINE countLinesU #-}

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

97100

98101hinspect $ hasNoTypeClasses 'countLinesU

99102hinspect $ 'countLinesU `hasNoType` ''Step

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

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

101104

102105-- | Sum the bytes in a file.

103106{-# INLINE sumBytes #-}

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

107110hinspect $ hasNoTypeClasses 'sumBytes

108111hinspect $ 'sumBytes `hasNoType` ''Step

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

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

110114

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

112116{-# INLINE cat #-}

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

116120hinspect $ hasNoTypeClasses 'cat

117121hinspect $ 'cat `hasNoType` ''Step

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

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

119124

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

121126{-# INLINE catStreamWrite #-}

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

125130hinspect $ hasNoTypeClasses 'catStreamWrite

126131hinspect $ 'catStreamWrite `hasNoType` ''Step

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

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

128134

129135-- | Copy file

130136{-# INLINE copy #-}

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

134140hinspect $ hasNoTypeClasses 'copy

135141hinspect $ 'copy `hasNoType` ''Step

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

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

137144

138145-- | Copy file

139146{-# INLINE copyCodecChar8 #-}

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

147154hinspect $ hasNoTypeClasses 'copyCodecChar8

148155hinspect $ 'copyCodecChar8 `hasNoType` ''Step

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

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

150158

151159-- | Copy file

152160{-# INLINE copyCodecUtf8 #-}

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

160168hinspect $ hasNoTypeClasses 'copyCodecUtf8

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

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

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

163172

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

165174{-# INLINE chunksOf #-}

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

171180hinspect $ hasNoTypeClasses 'chunksOf

172181hinspect $ 'chunksOf `hasNoType` ''Step

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

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

174184hinspect $ 'chunksOf `hasNoType` ''GroupState

175185

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

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

188198hinspect $ 'chunksOf `hasNoType` ''Step

189199hinspect $ 'chunksOfD `hasNoType` ''GroupState

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

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

191202

192203-- | Lines and unlines

193204{-# INLINE linesUnlinesCopy #-}

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

203214-- hinspect $ hasNoTypeClasses 'linesUnlinesCopy

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

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

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

206218

207219-- | Word, unwords and copy

208220{-# INLINE wordsUnwordsCopy #-}

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

218230-- hinspect $ hasNoTypeClasses 'wordsUnwordsCopy

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

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

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

221234

222235lf :: Word8

223236lf = fromIntegral (ord '\n')

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

256269hinspect $ hasNoTypeClasses 'splitOn

257270hinspect $ 'splitOn `hasNoType` ''Step

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

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

259273

260274-- | Split suffix on line feed.

261275{-# INLINE splitOnSuffix #-}

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

267281hinspect $ hasNoTypeClasses 'splitOnSuffix

268282hinspect $ 'splitOnSuffix `hasNoType` ''Step

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

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

270285

271286-- | Words by space

272287{-# INLINE wordsBy #-}

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

278293hinspect $ hasNoTypeClasses 'wordsBy

279294hinspect $ 'wordsBy `hasNoType` ''Step

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

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

281297

282298-- | Split on a character sequence.

283299{-# INLINE splitOnSeq #-}

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

289305hinspect $ hasNoTypeClasses 'splitOnSeq

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

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

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

292309

293310-- | Split on suffix sequence.

294311{-# INLINE splitOnSuffixSeq #-}

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

300317hinspect $ hasNoTypeClasses 'splitOnSuffixSeq

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

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

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

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

239239--

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

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

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

242242--

243243-- @since 0.7.0

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

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

8989import Data.Word (Word8)

9090import Foreign.C.String (CString)

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

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

92+import Foreign.ForeignPtr (withForeignPtr, touchForeignPtr)

9393import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

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

9595import Foreign.Storable (Storable(..))

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

9898

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

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

101−import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes, newForeignPtr_)

101+import GHC.ForeignPtr

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

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

103104import GHC.Ptr (Ptr(..))

104105

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

392393 len = aBound `minusPtr` p

393394 in assert (len >= 0) len

394395

396+data ReadUState a = ReadUState

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

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

399+

395400{-# INLINE_NORMAL readU #-}

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

397402readU = Unfold step inject

398403 where

399404

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

401− inject Array{..} =

402− return $ Array aStart (unsafeForeignPtrToPtr aStart) aEnd

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

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

403407

404408 {-# INLINE_LATE step #-}

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

406− step (Array start p end) = do

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

410+ step (ReadUState fp p) = do

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

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

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

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

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

413417 let !x = unsafeInlineIO $ do

414418 r <- peek p

415− touchForeignPtr start

419+ touchForeignPtr fp

416420 return r

417421 return $ D.Yield x

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

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

419423

420424{-# INLINE_NORMAL toStreamD #-}

421425toStreamD :: 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

6767-- @since 0.7.0

6868{-# INLINE concat #-}

6969concat :: (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)

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

7373

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

7575-- instead?

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

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

135135 -- ** Flattening nested streams

136136 , concatMapM

137137 , concatMap

138+ , ConcatMapUState (..)

138139 , concatMapU

139140

140141 -- ** Grouping

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

16971698-- Stream transformations using Unfolds

16981699-------------------------------------------------------------------------------

16991700

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

1702+data ConcatMapUState o i =

1703+ ConcatMapUOuter o

1704+ | ConcatMapUInner o i

1705+

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

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

17021708-- stream.

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

17081714

17091715{-# INLINE_NORMAL concatMapU #-}

17101716concatMapU :: 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)

17121719 where

17131720 {-# INLINE_LATE step #-}

1714− step gst (Left t) = do

1715− r <- ostep (adaptState gst) t

1721+ step gst (ConcatMapUOuter o) = do

1722+ r <- ostep (adaptState gst) o

17161723 case r of

1717− Yield a t' -> do

1718− s <- inject a

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

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

1724+ Yield a o' -> do

1725+ i <- inject a

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

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

17211728 Stop -> return $ Stop

17221729

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

1724− r <- istep s

1730+ step _ (ConcatMapUInner o i) = do

1731+ r <- istep i

17251732 return $ case r of

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

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

1728− Stop -> Skip (Left t)

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

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

1735+ Stop -> Skip (ConcatMapUOuter o)

17291736

17301737------------------------------------------------------------------------------

17311738-- Exceptions