@@ -1,5 +1,3 @@
1−{-# LANGUAGE UnboxedTuples #-}
2−
31-- |
42-- Module : Streamly.Internal.Control.Concurrent
53-- Copyright : (c) 2017 Composewell Technologies
@@ -7,29 +5,22 @@
75-- Maintainer : streamly@composewell.com
86-- Stability : experimental
97-- Portability : GHC
8+--
9+-- Note: This module is primarily for abstractions related to MonadBaseControl.
10+-- Please do not add any general routines in this. It should be renamed
11+-- appropriately.
1012
1113module Streamly.Internal.Control.Concurrent
1214 (
1315 MonadAsync
1416 , RunInIO(..)
1517 , captureMonadState
16− , doFork
17− , fork
18− , forkManaged
1918 )
2019where
2120
22−import Control.Concurrent (ThreadId, forkIO, killThread)
23−import Control.Exception (SomeException(..), catch, mask)
2421import Control.Monad.Catch (MonadThrow)
2522import Control.Monad.IO.Class (MonadIO(..))
26−import Control.Monad.Trans.Control
27− (MonadBaseControl, control, StM, liftBaseDiscard)
28−import Data.Functor (void)
29−import GHC.Conc (ThreadId(..))
30−import GHC.Exts
31−import GHC.IO (IO(..))
32−import System.Mem.Weak (addFinalizer)
23+import Control.Monad.Trans.Control (MonadBaseControl, control, StM)
3324
3425-- /Since: 0.8.0 ("Streamly.Prelude")/
3526--
@@ -53,48 +44,3 @@ newtype RunInIO m = RunInIO { runInIO :: forall b. m b -> IO (StM m b) }
5344-- execution.
5445captureMonadState :: MonadBaseControl IO m => m (RunInIO m)
5546captureMonadState = control $ \run -> run (return $ RunInIO run)
56−
57−-- Stolen from the async package. The perf improvement is modest, 2% on a
58−-- thread heavy benchmark (parallel composition using noop computations).
59−-- A version of forkIO that does not include the outer exception
60−-- handler: saves a bit of time when we will be installing our own
61−-- exception handler.
62−{-# INLINE rawForkIO #-}
63−rawForkIO :: IO () -> IO ThreadId
64−rawForkIO (IO action) = IO $ \ s ->
65− case fork# action s of (# s1, tid #) -> (# s1, ThreadId tid #)
66−
67−-- | Fork a thread to run the given computation, installing the provided
68−-- exception handler. Lifted to any monad with 'MonadBaseControl IO m'
69−-- capability.
70−--
71−-- TODO: the RunInIO argument can be removed, we can directly pass the action
72−-- as "mrun action" instead.
73−{-# INLINE doFork #-}
74−doFork :: MonadBaseControl IO m
75− => m ()
76− -> RunInIO m
77− -> (SomeException -> IO ())
78− -> m ThreadId
79−doFork action (RunInIO mrun) exHandler =
80− control $ \run ->
81− mask $ \restore -> do
82− tid <- rawForkIO $ catch (restore $ void $ mrun action)
83− exHandler
84− run (return tid)
85−
86−-- | 'fork' lifted to any monad with 'MonadBaseControl IO m' capability.
87−--
88−{-# INLINABLE fork #-}
89−fork :: MonadBaseControl IO m => m () -> m ThreadId
90−fork = liftBaseDiscard forkIO
91−
92−-- | Fork a thread that is automatically killed as soon as the reference to the
93−-- returned threadId is garbage collected.
94−--
95−{-# INLINABLE forkManaged #-}
96−forkManaged :: (MonadIO m, MonadBaseControl IO m) => m () -> m ThreadId
97−forkManaged action = do
98− tid <- fork action
99− liftIO $ addFinalizer tid (killThread tid)
100− return tid