summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Control/Concurrent/Lifted/Instrument.hs9
1 files changed, 5 insertions, 4 deletions
diff --git a/src/Control/Concurrent/Lifted/Instrument.hs b/src/Control/Concurrent/Lifted/Instrument.hs
index 673e77cd..e4582375 100644
--- a/src/Control/Concurrent/Lifted/Instrument.hs
+++ b/src/Control/Concurrent/Lifted/Instrument.hs
@@ -1,4 +1,5 @@
1{-# LANGUAGE FlexibleContexts #-} 1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE Strict #-}
2module Control.Concurrent.Lifted.Instrument 3module Control.Concurrent.Lifted.Instrument
3 ( module Control.Concurrent.Lifted 4 ( module Control.Concurrent.Lifted
4 , forkIO 5 , forkIO
@@ -21,13 +22,13 @@ import Data.Time()
21import Data.Time.Clock 22import Data.Time.Clock
22 23
23data PerThread = PerThread 24data PerThread = PerThread
24 { lbl :: !String 25 { lbl :: String
25 , startTime :: !UTCTime 26 , startTime :: UTCTime
26 } 27 }
27 deriving (Eq,Ord,Show) 28 deriving (Eq,Ord,Show)
28 29
29data GlobalState = GlobalState 30data GlobalState = GlobalState
30 { threads :: ! ( Map.Map ThreadId PerThread ) 31 { threads :: Map.Map ThreadId PerThread
31 } 32 }
32 33
33globals :: MVar GlobalState 34globals :: MVar GlobalState
@@ -67,4 +68,4 @@ modifyThreads f = do
67 g <- takeMVar globals 68 g <- takeMVar globals
68 let f' st = st { threads = f (threads st) } 69 let f' st = st { threads = f (threads st) }
69 r = f' g 70 r = f' g
70 threads r `seq` putMVar globals r 71 putMVar globals r