diff options
-rw-r--r-- | src/Control/Concurrent/Lifted/Instrument.hs | 9 |
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 | |||
47 | forkIO = fork | 47 | forkIO = fork |
48 | {-# INLINE forkIO #-} | 48 | {-# INLINE forkIO #-} |
49 | 49 | ||
50 | forkOS :: (MonadBaseControl IO m, MonadIO m) => m () -> m ThreadId | 50 | forkOS :: MonadBaseControl IO m => m () -> m ThreadId |
51 | forkOS = instrumented Raw.forkOS | 51 | forkOS = instrumented Raw.forkOS |
52 | {-# INLINE forkOS #-} | 52 | {-# INLINE forkOS #-} |
53 | 53 | ||
54 | fork :: (MonadBaseControl IO m, MonadIO m) => m () -> m ThreadId | 54 | fork :: MonadBaseControl IO m => m () -> m ThreadId |
55 | fork = instrumented Raw.fork | 55 | fork = instrumented Raw.fork |
56 | {-# INLINE fork #-} | 56 | {-# INLINE fork #-} |
57 | 57 | ||
58 | instrumented :: ( MonadBaseControl IO m | 58 | instrumented :: MonadBaseControl IO m => |
59 | , MonadIO m) => | ||
60 | (m () -> m ThreadId) -> m () -> m ThreadId | 59 | (m () -> m ThreadId) -> m () -> m ThreadId |
61 | instrumented rawFork action = do | 60 | instrumented 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 | , " (" |