git.iko.soy/streamly
on master help sign in
Inline MC.try to fix perf for GHC-9
67f8513Harendra Kumar
benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs+27−4
compare with master
unifiedsplit
@@ -36,6 +36,8 @@ import Streamly.Benchmark.Common.Handle
36
36
37#ifdef INSPECTION
37#ifdef INSPECTION
38import Test.Inspection
38import Test.Inspection
39+
40+import qualified Streamly.Internal.Data.Stream.StreamD as D
39#endif
41#endif
40
42
41-------------------------------------------------------------------------------
43-------------------------------------------------------------------------------
@@ -48,6 +50,10 @@ readWriteOnExceptionStream inh devNull =
48 let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
50 let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
49 in S.fold (FH.write devNull) $ readEx
51 in S.fold (FH.write devNull) $ readEx
50
52
53+#ifdef INSPECTION
54+inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
55+#endif
56+
51-- | Send the file contents to /dev/null with exception handling
57-- | Send the file contents to /dev/null with exception handling
52readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
58readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
53readWriteHandleExceptionStream inh devNull =
59readWriteHandleExceptionStream inh devNull =
@@ -55,12 +61,20 @@ readWriteHandleExceptionStream inh devNull =
55 readEx = S.handle handler (S.unfold FH.read inh)
61 readEx = S.handle handler (S.unfold FH.read inh)
56 in S.fold (FH.write devNull) $ readEx
62 in S.fold (FH.write devNull) $ readEx
57
63
64+#ifdef INSPECTION
65+inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
66+#endif
67+
58-- | Send the file contents to /dev/null with exception handling
68-- | Send the file contents to /dev/null with exception handling
59readWriteFinally_Stream :: Handle -> Handle -> IO ()
69readWriteFinally_Stream :: Handle -> Handle -> IO ()
60readWriteFinally_Stream inh devNull =
70readWriteFinally_Stream inh devNull =
61 let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)
71 let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)
62 in S.fold (FH.write devNull) readEx
72 in S.fold (FH.write devNull) readEx
63
73
74+#ifdef INSPECTION
75+inspect $ hasNoTypeClasses 'readWriteFinally_Stream
76+#endif
77+
64readWriteFinallyStream :: Handle -> Handle -> IO ()
78readWriteFinallyStream :: Handle -> Handle -> IO ()
65readWriteFinallyStream inh devNull =
79readWriteFinallyStream inh devNull =
66 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
80 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
@@ -75,7 +89,6 @@ fromToBytesBracket_Stream inh devNull =
75
89
76#ifdef INSPECTION
90#ifdef INSPECTION
77inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
91inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
78−-- inspect $ 'fromToBytesBracketStream `hasNoType` ''Step
79#endif
92#endif
80
93
81fromToBytesBracketStream :: Handle -> Handle -> IO ()
94fromToBytesBracketStream :: Handle -> Handle -> IO ()
@@ -91,16 +104,29 @@ readWriteBeforeAfterStream inh devNull =
91 $ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)
104 $ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)
92 in S.fold (FH.write devNull) readEx
105 in S.fold (FH.write devNull) readEx
93
106
107+#ifdef INSPECTION
108+inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
109+#endif
110+
94readWriteAfterStream :: Handle -> Handle -> IO ()
111readWriteAfterStream :: Handle -> Handle -> IO ()
95readWriteAfterStream inh devNull =
112readWriteAfterStream inh devNull =
96 let readEx = IP.after (hClose inh) (S.unfold FH.read inh)
113 let readEx = IP.after (hClose inh) (S.unfold FH.read inh)
97 in S.fold (FH.write devNull) readEx
114 in S.fold (FH.write devNull) readEx
98
115
116+#ifdef INSPECTION
117+inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
118+#endif
119+
99readWriteAfter_Stream :: Handle -> Handle -> IO ()
120readWriteAfter_Stream :: Handle -> Handle -> IO ()
100readWriteAfter_Stream inh devNull =
121readWriteAfter_Stream inh devNull =
101 let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)
122 let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)
102 in S.fold (FH.write devNull) readEx
123 in S.fold (FH.write devNull) readEx
103
124
125+#ifdef INSPECTION
126+inspect $ hasNoTypeClasses 'readWriteAfter_Stream
127+inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
128+#endif
129+
104o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
130o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
105o_1_space_copy_stream_exceptions env =
131o_1_space_copy_stream_exceptions env =
106 [ bgroup "exceptions"
132 [ bgroup "exceptions"
@@ -139,7 +165,6 @@ readChunksOnException inh devNull =
139
165
140#ifdef INSPECTION
166#ifdef INSPECTION
141inspect $ hasNoTypeClasses 'readChunksOnException
167inspect $ hasNoTypeClasses 'readChunksOnException
142−-- inspect $ 'readChunksOnException `hasNoType` ''Step
143#endif
168#endif
144
169
145-- | Send the file contents to /dev/null with exception handling
170-- | Send the file contents to /dev/null with exception handling
@@ -150,7 +175,6 @@ readChunksBracket_ inh devNull =
150
175
151#ifdef INSPECTION
176#ifdef INSPECTION
152inspect $ hasNoTypeClasses 'readChunksBracket_
177inspect $ hasNoTypeClasses 'readChunksBracket_
153−-- inspect $ 'readChunksBracket `hasNoType` ''Step
154#endif
178#endif
155
179
156readChunksBracket :: Handle -> Handle -> IO ()
180readChunksBracket :: Handle -> Handle -> IO ()
@@ -185,7 +209,6 @@ toChunksBracket_ inh devNull =
185
209
186#ifdef INSPECTION
210#ifdef INSPECTION
187inspect $ hasNoTypeClasses 'toChunksBracket_
211inspect $ hasNoTypeClasses 'toChunksBracket_
188−-- inspect $ 'toChunksBracket `hasNoType` ''Step
189#endif
212#endif
190
213
191toChunksBracket :: Handle -> Handle -> IO ()
214toChunksBracket :: Handle -> Handle -> IO ()
src/Streamly/Internal/Data/Stream/StreamD/Exception.hs+8−7
@@ -29,6 +29,7 @@ import Control.Exception (Exception, SomeException, mask_)
29import Control.Monad.Catch (MonadCatch)
29import Control.Monad.Catch (MonadCatch)
30import Control.Monad.IO.Class (MonadIO(..))
30import Control.Monad.IO.Class (MonadIO(..))
31import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp_)
31import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp_)
32+import GHC.Exts (inline)
32import Streamly.Internal.Data.IOFinalizer
33import Streamly.Internal.Data.IOFinalizer
33 (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)
34 (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)
34
35
@@ -231,7 +232,7 @@ after action (Stream step state) = Stream step' Nothing
231{-# INLINE_NORMAL onException #-}
232{-# INLINE_NORMAL onException #-}
232onException :: MonadCatch m => m b -> Stream m a -> Stream m a
233onException :: MonadCatch m => m b -> Stream m a -> Stream m a
233onException action str =
234onException action str =
234− gbracket_ (return ()) MC.try return
235+ gbracket_ (return ()) (inline MC.try) return
235 (\_ (e :: MC.SomeException) _ -> nilM (action >> MC.throwM e))
236 (\_ (e :: MC.SomeException) _ -> nilM (action >> MC.throwM e))
236 (\_ -> str)
237 (\_ -> str)
237
238
@@ -255,7 +256,7 @@ _onException action (Stream step state) = Stream step' state
255bracket_ :: MonadCatch m
256bracket_ :: MonadCatch m
256 => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a
257 => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a
257bracket_ bef aft bet =
258bracket_ bef aft bet =
258− gbracket_ bef MC.try aft
259+ gbracket_ bef (inline MC.try) aft
259 (\a (e :: SomeException) _ -> nilM (aft a >> MC.throwM e)) bet
260 (\a (e :: SomeException) _ -> nilM (aft a >> MC.throwM e)) bet
260
261
261-- | See 'Streamly.Internal.Data.Stream.IsStream.bracket'.
262-- | See 'Streamly.Internal.Data.Stream.IsStream.bracket'.
@@ -264,7 +265,7 @@ bracket_ bef aft bet =
264bracket :: (MonadAsync m, MonadCatch m)
265bracket :: (MonadAsync m, MonadCatch m)
265 => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a
266 => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a
266bracket bef aft bet =
267bracket bef aft bet =
267− gbracket bef MC.try aft
268+ gbracket bef (inline MC.try) aft
268 (\a (e :: SomeException) _ -> aft a >> return (nilM (MC.throwM e))) bet
269 (\a (e :: SomeException) _ -> aft a >> return (nilM (MC.throwM e))) bet
269
270
270data BracketState s v = BracketInit | BracketRun s v
271data BracketState s v = BracketInit | BracketRun s v
@@ -285,7 +286,7 @@ _bracket bef aft bet = Stream step' BracketInit
285 -- here, otherwise we get huge perf degradation, see note in concatMap.
286 -- here, otherwise we get huge perf degradation, see note in concatMap.
286 step' gst (BracketRun (UnStream step state) v) = do
287 step' gst (BracketRun (UnStream step state) v) = do
287 -- res <- step gst state `MC.onException` aft v
288 -- res <- step gst state `MC.onException` aft v
288− res <- MC.try $ step gst state
289+ res <- inline MC.try $ step gst state
289 case res of
290 case res of
290 Left (e :: SomeException) -> aft v >> MC.throwM e >> return Stop
291 Left (e :: SomeException) -> aft v >> MC.throwM e >> return Stop
291 Right r -> case r of
292 Right r -> case r of
@@ -313,7 +314,7 @@ finally action xs = bracket (return ()) (\_ -> action) (const xs)
313ghandle :: (MonadCatch m, Exception e)
314ghandle :: (MonadCatch m, Exception e)
314 => (e -> Stream m a -> Stream m a) -> Stream m a -> Stream m a
315 => (e -> Stream m a -> Stream m a) -> Stream m a -> Stream m a
315ghandle f str =
316ghandle f str =
316− gbracket_ (return ()) MC.try return (\_ -> f) (\_ -> str)
317+ gbracket_ (return ()) (inline MC.try) return (\_ -> f) (\_ -> str)
317
318
318-- | See 'Streamly.Internal.Data.Stream.IsStream.handle'.
319-- | See 'Streamly.Internal.Data.Stream.IsStream.handle'.
319--
320--
@@ -321,7 +322,7 @@ ghandle f str =
321handle :: (MonadCatch m, Exception e)
322handle :: (MonadCatch m, Exception e)
322 => (e -> Stream m a) -> Stream m a -> Stream m a
323 => (e -> Stream m a) -> Stream m a -> Stream m a
323handle f str =
324handle f str =
324− gbracket_ (return ()) MC.try return (\_ e _ -> f e) (\_ -> str)
325+ gbracket_ (return ()) (inline MC.try) return (\_ e _ -> f e) (\_ -> str)
325
326
326-- | Alternate (custom) implementation of 'handle'.
327-- | Alternate (custom) implementation of 'handle'.
327--
328--
@@ -334,7 +335,7 @@ _handle f (Stream step state) = Stream step' (Left state)
334
335
335 {-# INLINE_LATE step' #-}
336 {-# INLINE_LATE step' #-}
336 step' gst (Left st) = do
337 step' gst (Left st) = do
337− res <- MC.try $ step gst st
338+ res <- inline MC.try $ step gst st
338 case res of
339 case res of
339 Left e -> return $ Skip $ Right (f e)
340 Left e -> return $ Skip $ Right (f e)
340 Right r -> case r of
341 Right r -> case r of