benchmark/Streamly/Benchmark/Unicode/Stream.hs · streamly

git.iko.soy/streamly

on efecb26 help sign in

streamly/benchmark/Streamly/Benchmark/Unicode/Stream.hs

331 lines 12 kB history raw

1{-# OPTIONS_GHC -Wno-deprecations #-}

3--

4-- Module : Streamly.Unicode.Stream

6-- License : BSD-3-Clause

7-- Maintainer : streamly@composewell.com

8-- Stability : experimental

9-- Portability : GHC

11{-# LANGUAGE CPP #-}

12{-# LANGUAGE ScopedTypeVariables #-}

14#ifdef __HADDOCK_VERSION__

15#undef INSPECTION

16#endif

18#ifdef INSPECTION

19{-# LANGUAGE TemplateHaskell #-}

20{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}

21#endif

23import Streamly.Data.Stream (Stream)

24import Streamly.Data.Fold (Fold)

25import Prelude hiding (last, length)

26import System.IO (Handle)

28import qualified Streamly.Data.Array as Array

29import qualified Streamly.Data.Fold as Fold

30import qualified Streamly.Internal.Data.Stream as Stream

31import qualified Streamly.Internal.Data.Unfold as Unfold

32import qualified Streamly.Internal.FileSystem.Handle as Handle

33import qualified Streamly.Internal.Unicode.Array as UnicodeArr

34import qualified Streamly.Internal.Unicode.Stream as Unicode

36import Gauge hiding (env)

37import Streamly.Benchmark.Common

38import Streamly.Benchmark.Common.Handle

40#ifdef INSPECTION

41import Streamly.Internal.Data.Unbox (Unbox)

42import Streamly.Internal.Data.Stream (Step(..))

43import qualified Streamly.Internal.Data.Fold as Fold

44import qualified Streamly.Internal.Data.Tuple.Strict as Strict

45import qualified Streamly.Internal.Data.Array as Array

47import Test.Inspection

48#endif

50moduleName :: String

51moduleName = "Unicode.Stream"

53-- | Copy file

54{-# NOINLINE copyCodecUtf8ArraysLenient #-}

55copyCodecUtf8ArraysLenient :: Handle -> Handle -> IO ()

56copyCodecUtf8ArraysLenient inh outh =

57 Stream.fold (Handle.write outh)

58 $ Unicode.encodeUtf8'

59 $ Unicode.decodeUtf8Chunks

60 $ Handle.readChunks inh

62#ifdef INSPECTION

63inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient

64-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''Step

65#endif

67o_1_space_decode_encode_chunked :: BenchEnv -> [Benchmark]

68o_1_space_decode_encode_chunked env =

69 [ bgroup "decode-encode/toChunks"

70 [

71 mkBenchSmall "encodeUtf8' . decodeUtf8Arrays" env $ \inH outH ->

72 copyCodecUtf8ArraysLenient inH outH

73 ]

74 ]

76-------------------------------------------------------------------------------

77-- copy with group/ungroup transformations

78-------------------------------------------------------------------------------

80{-# INLINE splitOnSuffix #-}

81splitOnSuffix

82 :: (Monad m)

83 => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b

84splitOnSuffix predicate f = Stream.foldMany (Fold.takeEndBy_ predicate f)

86{-# NOINLINE linesUnlinesCopy #-}

87linesUnlinesCopy :: Handle -> Handle -> IO ()

88linesUnlinesCopy inh outh =

89 Stream.fold (Handle.write outh)

90 $ Unicode.encodeLatin1'

91 $ Unicode.unlines Unfold.fromList

92 $ splitOnSuffix (== '\n') Fold.toList

93 $ Unicode.decodeLatin1

94 $ Stream.unfold Handle.reader inh

96{-# NOINLINE linesUnlinesArrayWord8Copy #-}

97linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()

98linesUnlinesArrayWord8Copy inh outh =

99 Stream.fold (Handle.write outh)

100 $ Stream.interposeSuffix 10 Array.reader

101 $ splitOnSuffix (== 10) Array.write

102 $ Stream.unfold Handle.reader inh

103

104-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion

105-- | Lines and unlines

106{-# NOINLINE linesUnlinesArrayCharCopy #-}

107linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()

108linesUnlinesArrayCharCopy inh outh =

109 Stream.fold (Handle.write outh)

110 $ Unicode.encodeLatin1'

111 $ UnicodeArr.unlines

112 $ UnicodeArr.lines

113 $ Unicode.decodeLatin1

114 $ Stream.unfold Handle.reader inh

115

116#ifdef INSPECTION

117inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Unbox]

118-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step

119#endif

120

121-- XXX to write this we need to be able to map decodeUtf8 on the Array.read fold.

122-- For that we have to write decodeUtf8 as a Pipe.

123{-

124{-# INLINE linesUnlinesArrayUtf8Copy #-}

125linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()

126linesUnlinesArrayUtf8Copy inh outh =

127 Stream.fold (Handle.write outh)

128 $ Unicode.encodeLatin1'

129 $ Stream.intercalate (Array.fromList [10]) (pipe Unicode.decodeUtf8P Array.read)

130 $ Stream.splitOnSuffix (== '\n') (IFold.map Unicode.encodeUtf8' Array.write)

131 $ Unicode.decodeLatin1

132 $ Stream.unfold Handle.read inh

133-}

134

135-- | Word, unwords and copy

136{-# NOINLINE wordsUnwordsCopyWord8 #-}

137wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()

138wordsUnwordsCopyWord8 inh outh =

139 Stream.fold (Handle.write outh)

140 $ Stream.interposeSuffix 32 Unfold.fromList

141 $ Stream.wordsBy isSp Fold.toList

142 $ Stream.unfold Handle.reader inh

143

144#ifdef INSPECTION

145inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8

146-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step

147#endif

148

149-- | Word, unwords and copy

150{-# NOINLINE wordsUnwordsCopy #-}

151wordsUnwordsCopy :: Handle -> Handle -> IO ()

152wordsUnwordsCopy inh outh =

153 Stream.fold (Handle.write outh)

154 $ Unicode.encodeLatin1'

155 $ Unicode.unwords Unfold.fromList

156 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn

157 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse

158 -- even with high limits for inlining and spec-constr ghc options. With

159 -- -funfolding-use-threshold=400 it performs pretty well and there

160 -- is no evidence in the core that a join point involving Step

161 -- constructors is not getting inlined. Not being able to fuse at all in

162 -- this case could be an unknown issue, need more investigation.

163 $ Stream.wordsBy isSpace Fold.toList

164 -- -- $ Stream.splitOn isSpace Fold.toList

165 $ Unicode.decodeLatin1

166 $ Stream.unfold Handle.reader inh

167

168#ifdef INSPECTION

169-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy

170-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step

171#endif

172

173{-# NOINLINE wordsUnwordsCharArrayCopy #-}

174wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()

175wordsUnwordsCharArrayCopy inh outh =

176 Stream.fold (Handle.write outh)

177 $ Unicode.encodeLatin1'

178 $ UnicodeArr.unwords

179 $ UnicodeArr.words

180 $ Unicode.decodeLatin1

181 $ Stream.unfold Handle.reader inh

182

183o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]

184o_1_space_copy_read_group_ungroup env =

185 [ bgroup "ungroup-group"

186 [ mkBenchSmall "unlines . splitOnSuffix ([Word8])" env

187 $ \inh outh -> linesUnlinesCopy inh outh

188 , mkBenchSmall "interposeSuffix . splitOnSuffix (Array Word8)" env

189 $ \inh outh -> linesUnlinesArrayWord8Copy inh outh

190 , mkBenchSmall "UnicodeArr.unlines . UnicodeArr.lines (Array Char)" env

191 $ \inh outh -> linesUnlinesArrayCharCopy inh outh

192

193 , mkBenchSmall "interposeSuffix . wordsBy ([Word8])" env

194 $ \inh outh -> wordsUnwordsCopyWord8 inh outh

195 , mkBenchSmall "unwords . wordsBy ([Char])" env

196 $ \inh outh -> wordsUnwordsCopy inh outh

197 , mkBenchSmall "UnicodeArr.unwords . UnicodeArr.words (Array Char)" env

198 $ \inh outh -> wordsUnwordsCharArrayCopy inh outh

199 ]

200 ]

201

202-------------------------------------------------------------------------------

203-- copy unfold

204-------------------------------------------------------------------------------

205

206-- | Copy file (encodeLatin1')

207{-# NOINLINE copyStreamLatin1' #-}

208copyStreamLatin1' :: Handle -> Handle -> IO ()

209copyStreamLatin1' inh outh =

210 Stream.fold (Handle.write outh)

211 $ Unicode.encodeLatin1'

212 $ Unicode.decodeLatin1

213 $ Stream.unfold Handle.reader inh

214

215#ifdef INSPECTION

216inspect $ hasNoTypeClasses 'copyStreamLatin1'

217inspect $ 'copyStreamLatin1' `hasNoType` ''Step

218inspect $ 'copyStreamLatin1' `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many

219

220inspect $ 'copyStreamLatin1' `hasNoType` ''Fold.Step

221inspect $ 'copyStreamLatin1' `hasNoType` ''Array.ArrayUnsafe -- Handle.write/writeNUnsafe

222 -- Handle.read/Array.read

223inspect $ 'copyStreamLatin1' `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf

224#endif

225

226-- | Copy file (encodeLatin1)

227{-# NOINLINE copyStreamLatin1 #-}

228copyStreamLatin1 :: Handle -> Handle -> IO ()

229copyStreamLatin1 inh outh =

230 Stream.fold (Handle.write outh)

231 $ Unicode.encodeLatin1

232 $ Unicode.decodeLatin1

233 $ Stream.unfold Handle.reader inh

234

235#ifdef INSPECTION

236inspect $ hasNoTypeClasses 'copyStreamLatin1

237inspect $ 'copyStreamLatin1 `hasNoType` ''Step

238inspect $ 'copyStreamLatin1 `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many

239

240inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.ManyState

241inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.Step

242inspect $ 'copyStreamLatin1 `hasNoType` ''Array.ArrayUnsafe -- Handle.write/writeNUnsafe

243 -- Handle.read/Array.read

244inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf

245#endif

246

247-- | Copy file

248_copyStreamUtf8' :: Handle -> Handle -> IO ()

249_copyStreamUtf8' inh outh =

250 Stream.fold (Handle.write outh)

251 $ Unicode.encodeUtf8'

252 $ Unicode.decodeUtf8'

253 $ Stream.unfold Handle.reader inh

254

255#ifdef INSPECTION

256inspect $ hasNoTypeClasses '_copyStreamUtf8'

257-- inspect $ '_copyStreamUtf8 `hasNoType` ''Step

258-- inspect $ '_copyStreamUtf8 `hasNoType` ''Array.FlattenState

259-- inspect $ '_copyStreamUtf8 `hasNoType` ''D.ConcatMapUState

260#endif

261

262-- | Copy file

263{-# NOINLINE copyStreamUtf8 #-}

264copyStreamUtf8 :: Handle -> Handle -> IO ()

265copyStreamUtf8 inh outh =

266 Stream.fold (Handle.write outh)

267 $ Unicode.encodeUtf8

268 $ Unicode.decodeUtf8

269 $ Stream.unfold Handle.reader inh

270

271#ifdef INSPECTION

272inspect $ hasNoTypeClasses 'copyStreamUtf8

273-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''Step

274-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''Array.FlattenState

275-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''D.ConcatMapUState

276#endif

277

278{-# NOINLINE _copyStreamUtf8'Fold #-}

279_copyStreamUtf8'Fold :: Handle -> Handle -> IO ()

280_copyStreamUtf8'Fold inh outh =

281 Stream.fold (Handle.write outh)

282 $ Unicode.encodeUtf8

283 $ Stream.foldMany Unicode.writeCharUtf8'

284 $ Stream.unfold Handle.reader inh

285

286{-# NOINLINE _copyStreamUtf8Parser #-}

287_copyStreamUtf8Parser :: Handle -> Handle -> IO ()

288_copyStreamUtf8Parser inh outh =

289 Stream.fold (Handle.write outh)

290 $ Unicode.encodeUtf8

291 $ Stream.catRights $ Stream.parseMany

292 (Unicode.parseCharUtf8With Unicode.TransliterateCodingFailure)

293 $ Stream.unfold Handle.reader inh

294

295o_1_space_decode_encode_read :: BenchEnv -> [Benchmark]

296o_1_space_decode_encode_read env =

297 [ bgroup "decode-encode"

298 [

299 -- This needs an ascii file, as decode just errors out.

300 mkBench "encodeLatin1' . decodeLatin1" env $ \inh outh ->

301 copyStreamLatin1' inh outh

302 , mkBench "encodeLatin1 . decodeLatin1" env $ \inh outh ->

303 copyStreamLatin1 inh outh

304#ifdef INCLUDE_STRICT_UTF8

305 -- Requires valid unicode input

306 , mkBench "encodeUtf8' . decodeUtf8'" env $ \inh outh ->

307 _copyStreamUtf8' inh outh

308 , mkBench "encodeUtf8' . foldMany writeCharUtf8'" env $ \inh outh ->

309 _copyStreamUtf8'Fold inh outh

310#endif

311 , mkBenchSmall "encodeUtf8 . parseMany parseCharUtf8" env

312 $ \inh outh -> _copyStreamUtf8Parser inh outh

313 , mkBenchSmall "encodeUtf8 . decodeUtf8" env $ \inh outh ->

314 copyStreamUtf8 inh outh

315 ]

316 ]

317

318main :: IO ()

319main = do

320 env <- mkHandleBenchEnv

321 defaultMain (allBenchmarks env)

322

323 where

324

325 allBenchmarks env =

326 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat

327 [ o_1_space_copy_read_group_ungroup env

328 , o_1_space_decode_encode_chunked env

329 , o_1_space_decode_encode_read env

330 ]

331 ]