forkLabeled

1 files changed, 7 insertions, 0 deletions

diff --git a/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs b/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs
index fc3b6369..eeda4de8 100644
--- a/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs
+++ b/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Control.Concurrent.Lifted.Instrument
     ( module Control.Concurrent.Lifted
+    , forkLabeled
     , forkIO
     , forkOS
     , fork
@@ -42,6 +43,12 @@ globals = unsafePerformIO $ newMVar $ GlobalState
     }
 {-# NOINLINE globals #-}
 
+forkLabeled :: String -> IO () -> IO ThreadId
+forkLabeled lbl action = do
+    t <- forkIO action
+    labelThread t lbl
+    return t
+{-# INLINE forkLabeled #-}
 
 forkIO :: IO () -> IO ThreadId
 forkIO = instrumented GHC.forkIO