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

git.iko.soy/streamly

on 796bb22 help sign in

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

304 lines 10 kB history raw

1-- |

2-- Module : Streamly.Unicode.Stream

4-- License : BSD-3-Clause

5-- Maintainer : streamly@composewell.com

6-- Stability : experimental

7-- Portability : GHC

9{-# LANGUAGE CPP #-}

10{-# LANGUAGE ScopedTypeVariables #-}

12#ifdef __HADDOCK_VERSION__

13#undef INSPECTION

14#endif

16#ifdef INSPECTION

17{-# LANGUAGE TemplateHaskell #-}

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

19#endif

21import Prelude hiding (last, length)

22import System.IO (Handle)

24import qualified Streamly.Data.Fold as FL

25import qualified Streamly.Unicode.Stream as SS

26import qualified Streamly.FileSystem.Handle as FH

27import qualified Streamly.Internal.Data.Unfold as IUF

28import qualified Streamly.Internal.Unicode.Stream as IUS

29import qualified Streamly.Internal.FileSystem.Handle as IFH

30import qualified Streamly.Internal.Unicode.Array.Char as IUA

31import qualified Streamly.Internal.Data.Stream.IsStream as IP

32import qualified Streamly.Data.Array.Foreign as A

33import qualified Streamly.Prelude as S

35import Gauge hiding (env)

36import Streamly.Benchmark.Common

37import Streamly.Benchmark.Common.Handle

39#ifdef INSPECTION

40import Foreign.Storable (Storable)

41import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))

42import qualified Streamly.Internal.Data.Fold.Type as Fold

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

44import qualified Streamly.Internal.Data.Array.Foreign.Type as AT

45import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA

47import Test.Inspection

48#endif

50moduleName :: String

51moduleName = "Unicode.Stream"

53-- | Copy file

54{-# NOINLINE copyCodecUtf8ArraysLenient #-}

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

56copyCodecUtf8ArraysLenient inh outh =

57 S.fold (FH.write outh)

58 $ SS.encodeUtf8'

59 $ IUS.decodeUtf8Arrays

60 $ IFH.toChunks 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 "decodeEncodeUtf8Lenient" env $ \inH outH ->

72 copyCodecUtf8ArraysLenient inH outH

73 ]

74 ]

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

77-- copy with group/ungroup transformations

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

80{-# NOINLINE linesUnlinesCopy #-}

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

82linesUnlinesCopy inh outh =

83 S.fold (FH.write outh)

84 $ SS.encodeLatin1'

85 $ IUS.unlines IUF.fromList

86 $ S.splitOnSuffix (== '\n') FL.toList

87 $ SS.decodeLatin1

88 $ S.unfold FH.read inh

90{-# NOINLINE linesUnlinesArrayWord8Copy #-}

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

92linesUnlinesArrayWord8Copy inh outh =

93 S.fold (FH.write outh)

94 $ IP.interposeSuffix 10 A.read

95 $ S.splitOnSuffix (== 10) A.write

96 $ S.unfold FH.read inh

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

99-- | Lines and unlines

100{-# NOINLINE linesUnlinesArrayCharCopy #-}

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

102linesUnlinesArrayCharCopy inh outh =

103 S.fold (FH.write outh)

104 $ SS.encodeLatin1'

105 $ IUA.unlines

106 $ IUA.lines

107 $ SS.decodeLatin1

108 $ S.unfold FH.read inh

109

110#ifdef INSPECTION

111inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]

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

113#endif

114

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

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

117{-

118{-# INLINE linesUnlinesArrayUtf8Copy #-}

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

120linesUnlinesArrayUtf8Copy inh outh =

121 S.fold (FH.write outh)

122 $ SS.encodeLatin1'

123 $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)

124 $ S.splitOnSuffix (== '\n') (IFL.map SS.encodeUtf8' A.write)

125 $ SS.decodeLatin1

126 $ S.unfold FH.read inh

127-}

128

129-- | Word, unwords and copy

130{-# NOINLINE wordsUnwordsCopyWord8 #-}

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

132wordsUnwordsCopyWord8 inh outh =

133 S.fold (FH.write outh)

134 $ IP.interposeSuffix 32 IUF.fromList

135 $ S.wordsBy isSp FL.toList

136 $ S.unfold FH.read inh

137

138#ifdef INSPECTION

139inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8

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

141#endif

142

143-- | Word, unwords and copy

144{-# NOINLINE wordsUnwordsCopy #-}

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

146wordsUnwordsCopy inh outh =

147 S.fold (FH.write outh)

148 $ SS.encodeLatin1'

149 $ IUS.unwords IUF.fromList

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

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

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

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

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

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

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

157 $ S.wordsBy isSpace FL.toList

158 -- -- $ S.splitOn isSpace FL.toList

159 $ SS.decodeLatin1

160 $ S.unfold FH.read inh

161

162#ifdef INSPECTION

163-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy

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

165#endif

166

167{-# NOINLINE wordsUnwordsCharArrayCopy #-}

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

169wordsUnwordsCharArrayCopy inh outh =

170 S.fold (FH.write outh)

171 $ SS.encodeLatin1'

172 $ IUA.unwords

173 $ IUA.words

174 $ SS.decodeLatin1

175 $ S.unfold FH.read inh

176

177o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]

178o_1_space_copy_read_group_ungroup env =

179 [ bgroup "ungroup-group"

180 [ mkBenchSmall "US.unlines . S.splitOnSuffix ([Word8])" env

181 $ \inh outh -> linesUnlinesCopy inh outh

182 , mkBenchSmall "S.interposeSuffix . S.splitOnSuffix(Array Word8)" env

183 $ \inh outh -> linesUnlinesArrayWord8Copy inh outh

184 , mkBenchSmall "UA.unlines . UA.lines (Array Char)" env

185 $ \inh outh -> linesUnlinesArrayCharCopy inh outh

186

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

188 $ \inh outh -> wordsUnwordsCopyWord8 inh outh

189 , mkBenchSmall "US.unwords . S.wordsBy ([Char])" env

190 $ \inh outh -> wordsUnwordsCopy inh outh

191 , mkBenchSmall "UA.unwords . UA.words (Array Char)" env

192 $ \inh outh -> wordsUnwordsCharArrayCopy inh outh

193 ]

194 ]

195

196-------------------------------------------------------------------------------

197-- copy unfold

198-------------------------------------------------------------------------------

199

200-- | Copy file (encodeLatin1')

201{-# NOINLINE copyStreamLatin1' #-}

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

203copyStreamLatin1' inh outh =

204 S.fold (FH.write outh)

205 $ SS.encodeLatin1'

206 $ SS.decodeLatin1

207 $ S.unfold FH.read inh

208

209#ifdef INSPECTION

210inspect $ hasNoTypeClasses 'copyStreamLatin1'

211inspect $ 'copyStreamLatin1' `hasNoType` ''Step

212inspect $ 'copyStreamLatin1' `hasNoType` ''IUF.ConcatState -- FH.read/UF.many

213inspect $ 'copyStreamLatin1' `hasNoType` ''MA.ReadUState -- FH.read/A.read

214

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

216inspect $ 'copyStreamLatin1' `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe

217inspect $ 'copyStreamLatin1' `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf

218#endif

219

220-- | Copy file (encodeLatin1)

221{-# NOINLINE copyStreamLatin1 #-}

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

223copyStreamLatin1 inh outh =

224 S.fold (FH.write outh)

225 $ SS.encodeLatin1

226 $ SS.decodeLatin1

227 $ S.unfold FH.read inh

228

229#ifdef INSPECTION

230inspect $ hasNoTypeClasses 'copyStreamLatin1

231inspect $ 'copyStreamLatin1 `hasNoType` ''Step

232inspect $ 'copyStreamLatin1 `hasNoType` ''IUF.ConcatState -- FH.read/UF.many

233inspect $ 'copyStreamLatin1 `hasNoType` ''MA.ReadUState -- FH.read/A.read

234

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

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

237inspect $ 'copyStreamLatin1 `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe

238inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf

239#endif

240

241-- | Copy file

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

243_copyStreamUtf8' inh outh =

244 S.fold (FH.write outh)

245 $ SS.encodeUtf8'

246 $ SS.decodeUtf8'

247 $ S.unfold FH.read inh

248

249#ifdef INSPECTION

250inspect $ hasNoTypeClasses '_copyStreamUtf8'

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

252-- inspect $ '_copyStreamUtf8 `hasNoType` ''AT.FlattenState

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

254#endif

255

256-- | Copy file

257{-# NOINLINE copyStreamUtf8 #-}

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

259copyStreamUtf8 inh outh =

260 S.fold (FH.write outh)

261 $ SS.encodeUtf8

262 $ SS.decodeUtf8

263 $ S.unfold FH.read inh

264

265#ifdef INSPECTION

266inspect $ hasNoTypeClasses 'copyStreamUtf8

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

268-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''AT.FlattenState

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

270#endif

271

272o_1_space_decode_encode_read :: BenchEnv -> [Benchmark]

273o_1_space_decode_encode_read env =

274 [ bgroup "decode-encode"

275 [

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

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

278 copyStreamLatin1' inh outh

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

280 copyStreamLatin1 inh outh

281#ifdef DEVBUILD

282 , mkBench "copyUtf8" env $ \inh outh ->

283 _copyStreamUtf8' inh outh

284#endif

285 , mkBenchSmall "SS.encodeUtf8 . SS.decodeUtf8Lax" env $ \inh outh ->

286 copyStreamUtf8 inh outh

287 ]

288 ]

289

290main :: IO ()

291main = do

292 (_, cfg, benches) <- parseCLIOpts defaultStreamSize

293 env <- mkHandleBenchEnv

294 runMode (mode cfg) cfg benches (allBenchmarks env)

295

296 where

297

298 allBenchmarks env =

299 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat $

300 [ o_1_space_copy_read_group_ungroup env

301 , o_1_space_decode_encode_chunked env

302 , o_1_space_decode_encode_read env

303 ]

304 ]