Control.Concurrent.ThreadUtil replaces #ifdef imports

    * new function, forkLabeled
    * new module Control.Concurrent.ThreadUtil
    * label a few unlabeled threads

1 files changed, 24 insertions, 0 deletions

diff --git a/dht/src/Control/Concurrent/ThreadUtil.hs b/dht/src/Control/Concurrent/ThreadUtil.hs
new file mode 100644
index 00000000..2888e899
--- /dev/null
+++ b/dht/src/Control/Concurrent/ThreadUtil.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE CPP #-}
+module Control.Concurrent.ThreadUtil
+    (
+#ifdef THREAD_DEBUG
+      module Control.Concurrent.Lifted.Instrument
+#else
+      module Control.Control.Lifted
+    , module GHC.Conc
+#endif
+    ) where
+
+#ifdef THREAD_DEBUG
+import Control.Concurrent.Lifted.Instrument
+#else
+import Control.Concurrent.Lifted
+import GHC.Conc                  (labelThread)
+
+forkLabeled :: String -> IO () -> IO ThreadId
+forkLabeled lbl action = do
+    t <- forkIO action
+    labelThread t lbl
+    return t
+{-# INLINE forkLabeled #-}
+#endif