1305145 · streamly · git.iko.soy

git.iko.soy/streamly

Add benchmarks for exception handling operations

commit1305145e06f859961683d39b728a69d1bf1698ac authorHarendra Kumar <harendra.kumar@gmail.com> dateTue 8 Oct 2019, 23:50 (7 years ago) parent26715e2

3 files changed+148−2

compare with master

unifiedsplit

benchmark/FileIO.hs+26 src/Streamly/Benchmark/FileIO/Array.hs+44−1 src/Streamly/Benchmark/FileIO/Stream.hs+78−1

benchmark/FileIO.hs+26

@@ -88,6 +88,15 @@ main = do

8888 , mkBench "cat" href $ do

8989 Handles inh _ <- readIORef href

9090 BFA.cat devNull inh

91+ , mkBench "catBracket" href $ do

92+ Handles inh _ <- readIORef href

93+ BFA.catBracket devNull inh

94+ , mkBench "catBracketStream" href $ do

95+ Handles inh _ <- readIORef href

96+ BFA.catBracketStream devNull inh

97+ , mkBench "catOnException" href $ do

98+ Handles inh _ <- readIORef href

99+ BFA.catOnException devNull inh

91100 , mkBench "read-utf8" href $ do

92101 Handles inh _ <- readIORef href

93102 BFA.decodeUtf8Lenient inh

@@ -117,6 +126,23 @@ main = do

117126 , mkBench "catStream" href $ do

118127 Handles inh _ <- readIORef href

119128 BFS.catStreamWrite devNull inh

129+#ifdef DEVBUILD

130+ , mkBench "catOnException" href $ do

131+ Handles inh _ <- readIORef href

132+ BFS.catOnException devNull inh

133+ , mkBench "catHandle" href $ do

134+ Handles inh _ <- readIORef href

135+ BFS.catHandle devNull inh

136+ , mkBench "catFinally" href $ do

137+ Handles inh _ <- readIORef href

138+ BFS.catFinally devNull inh

139+ , mkBench "catBracketStream" href $ do

140+ Handles inh _ <- readIORef href

141+ BFS.catBracketStream devNull inh

142+ , mkBench "catBracket" href $ do

143+ Handles inh _ <- readIORef href

144+ BFS.catBracket devNull inh

145+#endif

120146 , mkBench "read-word8" href $ do

121147 Handles inh _ <- readIORef href

122148 BFS.readWord8 inh

src/Streamly/Benchmark/FileIO/Array.hs+44−1

@@ -26,6 +26,9 @@ module Streamly.Benchmark.FileIO.Array

2626 , countWords

2727 , sumBytes

2828 , cat

29+ , catOnException

30+ , catBracket

31+ , catBracketStream

2932 , copy

3033 , linesUnlinesCopy

3134 , wordsUnwordsCopy

@@ -36,7 +39,7 @@ where

3639

3740import Data.Functor.Identity (runIdentity)

3841import Data.Word (Word8)

39−import System.IO (Handle)

42+import System.IO (Handle, hClose)

4043import Prelude hiding (last)

4144

4245import qualified Streamly.FileSystem.Handle as FH

@@ -48,6 +51,7 @@ import qualified Streamly.Internal.FileSystem.Handle as IFH

4851import qualified Streamly.Internal.Prelude as Internal

4952import qualified Streamly.Internal.Memory.Array as IA

5053import qualified Streamly.Internal.Memory.ArrayStream as AS

54+import qualified Streamly.Internal.Data.Unfold as IUF

5155

5256#ifdef INSPECTION

5357import Foreign.Storable (Storable)

@@ -127,6 +131,45 @@ inspect $ hasNoTypeClasses 'cat

127131inspect $ 'cat `hasNoType` ''Step

128132#endif

129133

134+-- | Send the file contents to /dev/null with exception handling

135+{-# INLINE catBracket #-}

136+catBracket :: Handle -> Handle -> IO ()

137+catBracket devNull inh =

138+ let readEx = IUF.bracket (return ()) (\_ -> hClose inh)

139+ (\_ -> IUF.first FH.readArraysOf (256*1024))

140+ in IUF.fold readEx (IFH.writeArrays devNull) inh

141+

142+#ifdef INSPECTION

143+inspect $ hasNoTypeClasses 'catBracket

144+-- inspect $ 'catBracket `hasNoType` ''Step

145+#endif

146+

147+-- | Send the file contents to /dev/null with exception handling

148+{-# INLINE catBracketStream #-}

149+catBracketStream :: Handle -> Handle -> IO ()

150+catBracketStream devNull inh =

151+ let readEx = S.bracket (return ()) (\_ -> hClose inh)

152+ (\_ -> IFH.toStreamArraysOf (256*1024) inh)

153+ in S.fold (IFH.writeArrays devNull) $ readEx

154+

155+#ifdef INSPECTION

156+inspect $ hasNoTypeClasses 'catBracketStream

157+-- inspect $ 'catBracketStream `hasNoType` ''Step

158+#endif

159+

160+-- | Send the file contents to /dev/null with exception handling

161+{-# INLINE catOnException #-}

162+catOnException :: Handle -> Handle -> IO ()

163+catOnException devNull inh =

164+ let readEx = IUF.onException (hClose inh)

165+ (IUF.first FH.readArraysOf (256*1024))

166+ in IUF.fold readEx (IFH.writeArrays devNull) inh

167+

168+#ifdef INSPECTION

169+inspect $ hasNoTypeClasses 'catOnException

170+-- inspect $ 'catOnException `hasNoType` ''Step

171+#endif

172+

130173-- | Copy file

131174{-# INLINE copy #-}

132175copy :: Handle -> Handle -> IO ()

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

@@ -8,6 +8,7 @@

88-- Portability : GHC

1010{-# LANGUAGE CPP #-}

11+{-# LANGUAGE ScopedTypeVariables #-}

1112

1213#ifdef __HADDOCK_VERSION__

1314#undef INSPECTION

@@ -29,6 +30,11 @@ module Streamly.Benchmark.FileIO.Stream

2930 , sumBytes

3031 , cat

3132 , catStreamWrite

33+ , catBracket

34+ , catBracketStream

35+ , catOnException

36+ , catHandle

37+ , catFinally

3238 , copy

3339 , linesUnlinesCopy

3440 , wordsUnwordsCopyWord8

@@ -50,9 +56,10 @@ module Streamly.Benchmark.FileIO.Stream

5056 )

5157where

5258

59+import Control.Exception (SomeException)

5360import Data.Char (ord, chr)

5461import Data.Word (Word8)

55−import System.IO (Handle)

62+import System.IO (Handle, hClose)

5663import Prelude hiding (last, length)

5764

5865import qualified Streamly.FileSystem.Handle as FH

@@ -179,6 +186,76 @@ inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState

179186inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState

180187#endif

181188

189+-- | Send the file contents to /dev/null with exception handling

190+{-# INLINE catBracket #-}

191+catBracket :: Handle -> Handle -> IO ()

192+catBracket devNull inh =

193+ let readEx = IUF.bracket (return ()) (\_ -> hClose inh) (\_ -> FH.read)

194+ in S.fold (FH.write devNull) $ S.unfold readEx inh

195+

196+#ifdef INSPECTION

197+inspect $ hasNoTypeClasses 'catBracket

198+-- inspect $ 'catBracket `hasNoType` ''Step

199+-- inspect $ 'catBracket `hasNoType` ''AT.FlattenState

200+-- inspect $ 'catBracket `hasNoType` ''D.ConcatMapUState

201+#endif

202+

203+-- | Send the file contents to /dev/null with exception handling

204+{-# INLINE catBracketStream #-}

205+catBracketStream :: Handle -> Handle -> IO ()

206+catBracketStream devNull inh =

207+ let readEx = S.bracket (return ()) (\_ -> hClose inh)

208+ (\_ -> IFH.toStream inh)

209+ in IFH.fromStream devNull $ readEx

210+

211+#ifdef INSPECTION

212+inspect $ hasNoTypeClasses 'catBracketStream

213+-- inspect $ 'catBracketStream `hasNoType` ''Step

214+#endif

215+

216+-- | Send the file contents to /dev/null with exception handling

217+{-# INLINE catOnException #-}

218+catOnException :: Handle -> Handle -> IO ()

219+catOnException devNull inh =

220+ let readEx = IUF.onException (hClose inh) FH.read

221+ in S.fold (FH.write devNull) $ S.unfold readEx inh

222+

223+#ifdef INSPECTION

224+inspect $ hasNoTypeClasses 'catOnException

225+-- inspect $ 'catOnException `hasNoType` ''Step

226+-- inspect $ 'catOnException `hasNoType` ''AT.FlattenState

227+-- inspect $ 'catOnException `hasNoType` ''D.ConcatMapUState

228+#endif

229+

230+-- | Send the file contents to /dev/null with exception handling

231+{-# INLINE catFinally #-}

232+catFinally :: Handle -> Handle -> IO ()

233+catFinally devNull inh =

234+ let readEx = IUF.finally (hClose inh) FH.read

235+ in S.fold (FH.write devNull) $ S.unfold readEx inh

236+

237+#ifdef INSPECTION

238+inspect $ hasNoTypeClasses 'catFinally

239+-- inspect $ 'catFinally `hasNoType` ''Step

240+-- inspect $ 'catFinally `hasNoType` ''AT.FlattenState

241+-- inspect $ 'catFinally `hasNoType` ''D.ConcatMapUState

242+#endif

243+

244+-- | Send the file contents to /dev/null with exception handling

245+{-# INLINE catHandle #-}

246+catHandle :: Handle -> Handle -> IO ()

247+catHandle devNull inh =

248+ let readEx = IUF.handle (\(_e :: SomeException) -> hClose inh >> return 10)

249+ FH.read

250+ in S.fold (FH.write devNull) $ S.unfold readEx inh

251+

252+#ifdef INSPECTION

253+inspect $ hasNoTypeClasses 'catHandle

254+-- inspect $ 'catHandle `hasNoType` ''Step

255+-- inspect $ 'catHandle `hasNoType` ''AT.FlattenState

256+-- inspect $ 'catHandle `hasNoType` ''D.ConcatMapUState

257+#endif

258+

182259-- | Copy file

183260{-# INLINE copy #-}

184261copy :: Handle -> Handle -> IO ()