67f8513 · streamly · git.iko.soy

git.iko.soy/streamly

Inline MC.try to fix perf for GHC-9

commit67f851374ceeaa01c59b858117c0fb92e140f4fd authorHarendra Kumar <harendra@composewell.com> dateFri 18 Jun 2021, 22:46 (5 years ago) parent49a4333

2 files changed+35−11

compare with master

unifiedsplit

benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs+27−4 src/Streamly/Internal/Data/Stream/StreamD/Exception.hs+8−7

benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs+27−4

@@ -36,6 +36,8 @@ import Streamly.Benchmark.Common.Handle

3636

3737#ifdef INSPECTION

3838import Test.Inspection

39+

40+import qualified Streamly.Internal.Data.Stream.StreamD as D

3941#endif

4042

4143-------------------------------------------------------------------------------

@@ -48,6 +50,10 @@ readWriteOnExceptionStream inh devNull =

4850 let readEx = S.onException (hClose inh) (S.unfold FH.read inh)

4951 in S.fold (FH.write devNull) $ readEx

5052

53+#ifdef INSPECTION

54+inspect $ hasNoTypeClasses 'readWriteOnExceptionStream

55+#endif

56+

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

5258readWriteHandleExceptionStream :: Handle -> Handle -> IO ()

5359readWriteHandleExceptionStream inh devNull =

@@ -55,12 +61,20 @@ readWriteHandleExceptionStream inh devNull =

5561 readEx = S.handle handler (S.unfold FH.read inh)

5662 in S.fold (FH.write devNull) $ readEx

5763

64+#ifdef INSPECTION

65+inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream

66+#endif

67+

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

5969readWriteFinally_Stream :: Handle -> Handle -> IO ()

6070readWriteFinally_Stream inh devNull =

6171 let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)

6272 in S.fold (FH.write devNull) readEx

6373

74+#ifdef INSPECTION

75+inspect $ hasNoTypeClasses 'readWriteFinally_Stream

76+#endif

77+

6478readWriteFinallyStream :: Handle -> Handle -> IO ()

6579readWriteFinallyStream inh devNull =

6680 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)

@@ -75,7 +89,6 @@ fromToBytesBracket_Stream inh devNull =

7589

7690#ifdef INSPECTION

7791inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream

78−-- inspect $ 'fromToBytesBracketStream `hasNoType` ''Step

7992#endif

8093

8194fromToBytesBracketStream :: Handle -> Handle -> IO ()

@@ -91,16 +104,29 @@ readWriteBeforeAfterStream inh devNull =

91104 $ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)

92105 in S.fold (FH.write devNull) readEx

93106

107+#ifdef INSPECTION

108+inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step

109+#endif

110+

94111readWriteAfterStream :: Handle -> Handle -> IO ()

95112readWriteAfterStream inh devNull =

96113 let readEx = IP.after (hClose inh) (S.unfold FH.read inh)

97114 in S.fold (FH.write devNull) readEx

98115

116+#ifdef INSPECTION

117+inspect $ 'readWriteAfterStream `hasNoType` ''D.Step

118+#endif

119+

99120readWriteAfter_Stream :: Handle -> Handle -> IO ()

100121readWriteAfter_Stream inh devNull =

101122 let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)

102123 in S.fold (FH.write devNull) readEx

103124

125+#ifdef INSPECTION

126+inspect $ hasNoTypeClasses 'readWriteAfter_Stream

127+inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step

128+#endif

129+

104130o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]

105131o_1_space_copy_stream_exceptions env =

106132 [ bgroup "exceptions"

@@ -139,7 +165,6 @@ readChunksOnException inh devNull =

139165

140166#ifdef INSPECTION

141167inspect $ hasNoTypeClasses 'readChunksOnException

142−-- inspect $ 'readChunksOnException `hasNoType` ''Step

143168#endif

144169

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

@@ -150,7 +175,6 @@ readChunksBracket_ inh devNull =

150175

151176#ifdef INSPECTION

152177inspect $ hasNoTypeClasses 'readChunksBracket_

153−-- inspect $ 'readChunksBracket `hasNoType` ''Step

154178#endif

155179

156180readChunksBracket :: Handle -> Handle -> IO ()

@@ -185,7 +209,6 @@ toChunksBracket_ inh devNull =

185209

186210#ifdef INSPECTION

187211inspect $ hasNoTypeClasses 'toChunksBracket_

188−-- inspect $ 'toChunksBracket `hasNoType` ''Step

189212#endif

190213

191214toChunksBracket :: Handle -> Handle -> IO ()

src/Streamly/Internal/Data/Stream/StreamD/Exception.hs+8−7

@@ -29,6 +29,7 @@ import Control.Exception (Exception, SomeException, mask_)

2929import Control.Monad.Catch (MonadCatch)

3030import Control.Monad.IO.Class (MonadIO(..))

3131import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp_)

32+import GHC.Exts (inline)

3233import Streamly.Internal.Data.IOFinalizer

3334 (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)

3435

@@ -231,7 +232,7 @@ after action (Stream step state) = Stream step' Nothing

231232{-# INLINE_NORMAL onException #-}

232233onException :: MonadCatch m => m b -> Stream m a -> Stream m a

233234onException action str =

234− gbracket_ (return ()) MC.try return

235+ gbracket_ (return ()) (inline MC.try) return

235236 (\_ (e :: MC.SomeException) _ -> nilM (action >> MC.throwM e))

236237 (\_ -> str)

237238

@@ -255,7 +256,7 @@ _onException action (Stream step state) = Stream step' state

255256bracket_ :: MonadCatch m

256257 => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a

257258bracket_ bef aft bet =

258− gbracket_ bef MC.try aft

259+ gbracket_ bef (inline MC.try) aft

259260 (\a (e :: SomeException) _ -> nilM (aft a >> MC.throwM e)) bet

260261

261262-- | See 'Streamly.Internal.Data.Stream.IsStream.bracket'.

@@ -264,7 +265,7 @@ bracket_ bef aft bet =

264265bracket :: (MonadAsync m, MonadCatch m)

265266 => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a

266267bracket bef aft bet =

267− gbracket bef MC.try aft

268+ gbracket bef (inline MC.try) aft

268269 (\a (e :: SomeException) _ -> aft a >> return (nilM (MC.throwM e))) bet

269270

270271data BracketState s v = BracketInit | BracketRun s v

@@ -285,7 +286,7 @@ _bracket bef aft bet = Stream step' BracketInit

285286 -- here, otherwise we get huge perf degradation, see note in concatMap.

286287 step' gst (BracketRun (UnStream step state) v) = do

287288 -- res <- step gst state `MC.onException` aft v

288− res <- MC.try $ step gst state

289+ res <- inline MC.try $ step gst state

289290 case res of

290291 Left (e :: SomeException) -> aft v >> MC.throwM e >> return Stop

291292 Right r -> case r of

@@ -313,7 +314,7 @@ finally action xs = bracket (return ()) (\_ -> action) (const xs)

313314ghandle :: (MonadCatch m, Exception e)

314315 => (e -> Stream m a -> Stream m a) -> Stream m a -> Stream m a

315316ghandle f str =

316− gbracket_ (return ()) MC.try return (\_ -> f) (\_ -> str)

317+ gbracket_ (return ()) (inline MC.try) return (\_ -> f) (\_ -> str)

317318

318319-- | See 'Streamly.Internal.Data.Stream.IsStream.handle'.

319320--

@@ -321,7 +322,7 @@ ghandle f str =

321322handle :: (MonadCatch m, Exception e)

322323 => (e -> Stream m a) -> Stream m a -> Stream m a

323324handle f str =

324− gbracket_ (return ()) MC.try return (\_ e _ -> f e) (\_ -> str)

325+ gbracket_ (return ()) (inline MC.try) return (\_ e _ -> f e) (\_ -> str)

325326

326327-- | Alternate (custom) implementation of 'handle'.

327328--

@@ -334,7 +335,7 @@ _handle f (Stream step state) = Stream step' (Left state)

334335

335336 {-# INLINE_LATE step' #-}

336337 step' gst (Left st) = do

337− res <- MC.try $ step gst st

338+ res <- inline MC.try $ step gst st

338339 case res of

339340 Left e -> return $ Skip $ Right (f e)

340341 Right r -> case r of