diff options
| -rw-r--r-- | lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs | 7 |
1 files changed, 4 insertions, 3 deletions
diff --git a/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs b/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs index d886f939..adce64ba 100644 --- a/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs +++ b/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs | |||
| @@ -156,6 +156,7 @@ threadsInformation = do | |||
| 156 | modifyThreads :: MonadBaseControl IO m => ThreadId -> | 156 | modifyThreads :: MonadBaseControl IO m => ThreadId -> |
| 157 | (Map.Map ThreadId PerThread -> Map.Map ThreadId PerThread) -> m () | 157 | (Map.Map ThreadId PerThread -> Map.Map ThreadId PerThread) -> m () |
| 158 | modifyThreads tid f = do | 158 | modifyThreads tid f = do |
| 159 | let tidHash = hashThreadId tid | 159 | let mvar = globalMVarArray V.! hashThreadId tid |
| 160 | let mvar = globalMVarArray V.! tidHash | 160 | bracket (takeMVar mvar) |
| 161 | modifyMVarMasked_ mvar (return . f) | 161 | (\m -> putMVar mvar $! f m) |
| 162 | (\m -> return ()) | ||