summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Control/Concurrent/Lifted/Instrument.hs9
1 files changed, 4 insertions, 5 deletions
diff --git a/src/Control/Concurrent/Lifted/Instrument.hs b/src/Control/Concurrent/Lifted/Instrument.hs
index 41814d98..5b3237cc 100644
--- a/src/Control/Concurrent/Lifted/Instrument.hs
+++ b/src/Control/Concurrent/Lifted/Instrument.hs
@@ -47,16 +47,15 @@ forkIO :: IO () -> IO ThreadId
47forkIO = fork 47forkIO = fork
48{-# INLINE forkIO #-} 48{-# INLINE forkIO #-}
49 49
50forkOS :: (MonadBaseControl IO m, MonadIO m) => m () -> m ThreadId 50forkOS :: MonadBaseControl IO m => m () -> m ThreadId
51forkOS = instrumented Raw.forkOS 51forkOS = instrumented Raw.forkOS
52{-# INLINE forkOS #-} 52{-# INLINE forkOS #-}
53 53
54fork :: (MonadBaseControl IO m, MonadIO m) => m () -> m ThreadId 54fork :: MonadBaseControl IO m => m () -> m ThreadId
55fork = instrumented Raw.fork 55fork = instrumented Raw.fork
56{-# INLINE fork #-} 56{-# INLINE fork #-}
57 57
58instrumented :: ( MonadBaseControl IO m 58instrumented :: MonadBaseControl IO m =>
59 , MonadIO m) =>
60 (m () -> m ThreadId) -> m () -> m ThreadId 59 (m () -> m ThreadId) -> m () -> m ThreadId
61instrumented rawFork action = do 60instrumented rawFork action = do
62 t <- rawFork $ do 61 t <- rawFork $ do
@@ -66,7 +65,7 @@ instrumented rawFork action = do
66 (return ()) 65 (return ())
67 $ do catch action $ \e -> case fromException e of 66 $ do catch action $ \e -> case fromException e of
68 Just ThreadKilled -> return () 67 Just ThreadKilled -> return ()
69 Nothing -> liftIO $ do 68 Nothing -> liftBase $ do
70 g <- takeMVar globals 69 g <- takeMVar globals
71 let l = concat [ show e 70 let l = concat [ show e
72 , " (" 71 , " ("