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

git.iko.soy/streamly

on 3947fee help sign in

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

288 lines 9.8 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.Tuple.Strict as Strict

43import qualified Streamly.Internal.Data.Array.Foreign.Types as AT

44import qualified Streamly.Internal.Data.Array.Foreign.Mut.Types as MA

46import Test.Inspection

47#endif

49moduleName :: String

50moduleName = "Unicode.Stream"

52-- | Copy file

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

54copyCodecUtf8ArraysLenient inh outh =

55 S.fold (FH.write outh)

56 $ SS.encodeUtf8'

57 $ IUS.decodeUtf8Arrays

58 $ IFH.toChunks inh

60#ifdef INSPECTION

61inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient

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

63#endif

65o_1_space_decode_encode_chunked :: BenchEnv -> [Benchmark]

66o_1_space_decode_encode_chunked env =

67 [ bgroup "decode-encode/toChunks"

68 [

69 mkBenchSmall "decodeEncodeUtf8Lenient" env $ \inH outH ->

70 copyCodecUtf8ArraysLenient inH outH

71 ]

72 ]

74-------------------------------------------------------------------------------

75-- copy with group/ungroup transformations

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

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

79linesUnlinesCopy inh outh =

80 S.fold (FH.write outh)

81 $ SS.encodeLatin1'

82 $ IUS.unlines IUF.fromList

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

84 $ SS.decodeLatin1

85 $ S.unfold FH.read inh

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

88linesUnlinesArrayWord8Copy inh outh =

89 S.fold (FH.write outh)

90 $ IP.interposeSuffix 10 A.read

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

92 $ S.unfold FH.read inh

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

95-- | Lines and unlines

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

97linesUnlinesArrayCharCopy inh outh =

98 S.fold (FH.write outh)

99 $ SS.encodeLatin1'

100 $ IUA.unlines

101 $ IUA.lines

102 $ SS.decodeLatin1

103 $ S.unfold FH.read inh

104

105#ifdef INSPECTION

106inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]

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

108#endif

109

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

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

112{-

113{-# INLINE linesUnlinesArrayUtf8Copy #-}

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

115linesUnlinesArrayUtf8Copy inh outh =

116 S.fold (FH.write outh)

117 $ SS.encodeLatin1'

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

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

120 $ SS.decodeLatin1

121 $ S.unfold FH.read inh

122-}

123

124-- | Word, unwords and copy

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

126wordsUnwordsCopyWord8 inh outh =

127 S.fold (FH.write outh)

128 $ IP.interposeSuffix 32 IUF.fromList

129 $ S.wordsBy isSp FL.toList

130 $ S.unfold FH.read inh

131

132#ifdef INSPECTION

133inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8

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

135#endif

136

137-- | Word, unwords and copy

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

139wordsUnwordsCopy inh outh =

140 S.fold (FH.write outh)

141 $ SS.encodeLatin1'

142 $ IUS.unwords IUF.fromList

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

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

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

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

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

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

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

150 $ S.wordsBy isSpace FL.toList

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

152 $ SS.decodeLatin1

153 $ S.unfold FH.read inh

154

155#ifdef INSPECTION

156-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy

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

158#endif

159

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

161wordsUnwordsCharArrayCopy inh outh =

162 S.fold (FH.write outh)

163 $ SS.encodeLatin1'

164 $ IUA.unwords

165 $ IUA.words

166 $ SS.decodeLatin1

167 $ S.unfold FH.read inh

168

169o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]

170o_1_space_copy_read_group_ungroup env =

171 [ bgroup "ungroup-group"

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

173 $ \inh outh -> linesUnlinesCopy inh outh

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

175 $ \inh outh -> linesUnlinesArrayWord8Copy inh outh

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

177 $ \inh outh -> linesUnlinesArrayCharCopy inh outh

178

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

180 $ \inh outh -> wordsUnwordsCopyWord8 inh outh

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

182 $ \inh outh -> wordsUnwordsCopy inh outh

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

184 $ \inh outh -> wordsUnwordsCharArrayCopy inh outh

185 ]

186 ]

187

188-------------------------------------------------------------------------------

189-- copy unfold

190-------------------------------------------------------------------------------

191

192-- | Copy file (encodeLatin1')

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

194copyStreamLatin1' inh outh =

195 S.fold (FH.write outh)

196 $ SS.encodeLatin1'

197 $ SS.decodeLatin1

198 $ S.unfold FH.read inh

199

200#ifdef INSPECTION

201inspect $ hasNoTypeClasses 'copyStreamLatin1'

202inspect $ 'copyStreamLatin1' `hasNoType` ''Step

203inspect $ 'copyStreamLatin1' `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

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

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

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

207#endif

208

209-- | Copy file (encodeLatin1)

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

211copyStreamLatin1 inh outh =

212 S.fold (FH.write outh)

213 $ SS.encodeLatin1

214 $ SS.decodeLatin1

215 $ S.unfold FH.read inh

216

217#ifdef INSPECTION

218inspect $ hasNoTypeClasses 'copyStreamLatin1

219inspect $ 'copyStreamLatin1 `hasNoType` ''Step

220inspect $ 'copyStreamLatin1 `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

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

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

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

224#endif

225

226-- | Copy file

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

228_copyStreamUtf8' inh outh =

229 S.fold (FH.write outh)

230 $ SS.encodeUtf8'

231 $ SS.decodeUtf8'

232 $ S.unfold FH.read inh

233

234#ifdef INSPECTION

235inspect $ hasNoTypeClasses '_copyStreamUtf8'

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

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

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

239#endif

240

241-- | Copy file

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

243copyStreamUtf8 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 $ 'copyStreamUtf8Lax `hasNoType` ''Step

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

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

254#endif

255

256o_1_space_decode_encode_read :: BenchEnv -> [Benchmark]

257o_1_space_decode_encode_read env =

258 [ bgroup "decode-encode"

259 [

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

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

262 copyStreamLatin1' inh outh

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

264 copyStreamLatin1 inh outh

265#ifdef DEVBUILD

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

267 _copyStreamUtf8' inh outh

268#endif

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

270 copyStreamUtf8 inh outh

271 ]

272 ]

273

274main :: IO ()

275main = do

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

277 env <- mkHandleBenchEnv

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

279

280 where

281

282 allBenchmarks env =

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

284 [ o_1_space_copy_read_group_ungroup env

285 , o_1_space_decode_encode_chunked env

286 , o_1_space_decode_encode_read env

287 ]

288 ]