diff options
author | joe <joe@jerkface.net> | 2017-11-18 22:43:39 -0500 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-11-18 22:43:39 -0500 |
commit | 0f4e8b298014d9db2cb3ebdb167f3a9d9ca1a3f3 (patch) | |
tree | 47eaa1d18e2628b7e7a36f42a9e16dbdd2154d7f /src/Control/Concurrent/Lifted/Instrument.hs | |
parent | bacefe39096c2c39afb6af7f01e729233a47522d (diff) |
Removed redundant MonadIO constraint from thread instrumentation.
Diffstat (limited to 'src/Control/Concurrent/Lifted/Instrument.hs')
-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 | , " (" |