summaryrefslogtreecommitdiff
path: root/src/Control/Concurrent/Lifted/Instrument.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-07-28 20:58:43 -0400
committerjoe <joe@jerkface.net>2017-07-28 20:58:43 -0400
commitd0ff6c3ac977035f3493b679978da73517550028 (patch)
treef00c62d6e95a7f10ff58580601c5651465310cc0 /src/Control/Concurrent/Lifted/Instrument.hs
parente4ecff0ba5ad4b392a419ab7723c5df49513d1fa (diff)
More details in threads listing.
Diffstat (limited to 'src/Control/Concurrent/Lifted/Instrument.hs')
-rw-r--r--src/Control/Concurrent/Lifted/Instrument.hs13
1 files changed, 6 insertions, 7 deletions
diff --git a/src/Control/Concurrent/Lifted/Instrument.hs b/src/Control/Concurrent/Lifted/Instrument.hs
index 957b67bb..7ee78c8b 100644
--- a/src/Control/Concurrent/Lifted/Instrument.hs
+++ b/src/Control/Concurrent/Lifted/Instrument.hs
@@ -45,26 +45,25 @@ fork action = do
45 t <- Raw.fork $ do 45 t <- Raw.fork $ do
46 tid <- myThreadId 46 tid <- myThreadId
47 tm <- liftBase getCurrentTime 47 tm <- liftBase getCurrentTime
48 bracket_ (modifyThreads $ Map.insert tid (PerThread "" tm)) 48 bracket_ (modifyThreads $! Map.insert tid (PerThread "" tm))
49 (modifyThreads $ Map.delete tid) 49 (modifyThreads $! Map.delete tid)
50 action 50 action
51 return t 51 return t
52 52
53labelThread :: ThreadId -> String -> IO () 53labelThread :: ThreadId -> String -> IO ()
54labelThread tid s = do 54labelThread tid s = do
55 GHC.labelThread tid s 55 GHC.labelThread tid s
56 modifyThreads $ Map.adjust (\pt -> pt { lbl = s }) tid 56 modifyThreads $! Map.adjust (\pt -> pt { lbl = s }) tid
57{-# INLINE labelThread #-} 57{-# INLINE labelThread #-}
58 58
59threadsInformation :: IO [PerThread] 59threadsInformation :: IO [(ThreadId,PerThread)]
60threadsInformation = do 60threadsInformation = do
61 m <- threads <$> readMVar globals 61 m <- threads <$> readMVar globals
62 return $ Map.elems m 62 return $ Map.toList m
63 63
64 64
65modifyThreads :: MonadBase IO m => (Map.Map ThreadId PerThread -> Map.Map ThreadId PerThread) -> m () 65modifyThreads :: MonadBase IO m => (Map.Map ThreadId PerThread -> Map.Map ThreadId PerThread) -> m ()
66modifyThreads f = do 66modifyThreads f = do
67 g <- takeMVar globals 67 g <- takeMVar globals
68 let f' st = st { threads = f (threads st) } 68 let f' st = st { threads = f (threads st) }
69 r = f' g 69 putMVar globals $! f' g
70 putMVar globals r