5542239 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

use rawForkIO - without an outer exception handler

5542239Harendra Kumar8 years ago

src/Streamly/Core.hs+18−3

compare with master

unifiedsplit

@@ -2,8 +2,10 @@

2{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE LambdaCase #-}

5+{-# LANGUAGE MagicHash #-}

5{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE RankNTypes #-}

7{-# LANGUAGE RankNTypes #-}

8+{-# LANGUAGE UnboxedTuples #-}

7{-# LANGUAGE UndecidableInstances #-} -- XXX

9{-# LANGUAGE UndecidableInstances #-} -- XXX

9-- |

11-- |

@@ -64,8 +66,7 @@ module Streamly.Core

64 )

66 )

65where

67where

67−import Control.Concurrent (ThreadId, forkIO,

69+import Control.Concurrent (ThreadId, myThreadId, threadDelay)

68− myThreadId, threadDelay)

69import Control.Concurrent.MVar (MVar, newEmptyMVar, tryTakeMVar,

70import Control.Concurrent.MVar (MVar, newEmptyMVar, tryTakeMVar,

70 tryPutMVar, takeMVar)

71 tryPutMVar, takeMVar)

71import Control.Exception (SomeException (..))

72import Control.Exception (SomeException (..))

@@ -90,6 +91,10 @@ import Data.Set (Set)

90import qualified Data.Set as S

91import qualified Data.Set as S

91import Prelude hiding (repeat, zipWith)

92import Prelude hiding (repeat, zipWith)

94+import GHC.Exts

95+import GHC.Conc (ThreadId(..))

96+import GHC.IO (IO(..))

97+

93------------------------------------------------------------------------------

98------------------------------------------------------------------------------

94-- Parent child thread communication type

99-- Parent child thread communication type

95------------------------------------------------------------------------------

100------------------------------------------------------------------------------

@@ -255,6 +260,16 @@ type MonadParallel m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)

255{-# DEPRECATED MonadAsync "Please use MonadParallel instead." #-}

260{-# DEPRECATED MonadAsync "Please use MonadParallel instead." #-}

256type MonadAsync m = MonadParallel m

261type MonadAsync m = MonadParallel m

257

262

263+-- Stolen from the async package. The perf improvement is modest, 2% on a

264+-- thread heavy benchmark (parallel composition using noop computations).

265+-- A version of forkIO that does not include the outer exception

266+-- handler: saves a bit of time when we will be installing our own

267+-- exception handler.

268+{-# INLINE rawForkIO #-}

269+rawForkIO :: IO () -> IO ThreadId

270+rawForkIO action = IO $ \ s ->

271+ case (fork# action s) of (# s1, tid #) -> (# s1, ThreadId tid #)

272+

258{-# INLINE doFork #-}

273{-# INLINE doFork #-}

259doFork :: MonadBaseControl IO m

274doFork :: MonadBaseControl IO m

260 => m ()

275 => m ()

@@ -262,7 +277,7 @@ doFork :: MonadBaseControl IO m

262 -> m ThreadId

277 -> m ThreadId

263doFork action exHandler =

278doFork action exHandler =

264 EL.mask $ \restore ->

279 EL.mask $ \restore ->

265− liftBaseWith $ \runInIO -> forkIO $ do

280+ liftBaseWith $ \runInIO -> rawForkIO $ do

266 _ <- runInIO $ EL.catch (restore action) exHandler

281 _ <- runInIO $ EL.catch (restore action) exHandler

267 -- XXX restore state here?

282 -- XXX restore state here?

268 return ()

283 return ()