[commit: base] master: move mkWeakThreadId to GHC.Conc.Sync; export it from Control.Concurrent (e18035d)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/e18035d84b274b9f617bc8f1eb74b29ef49e58f8

>---------------------------------------------------------------

commit e18035d84b274b9f617bc8f1eb74b29ef49e58f8
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Thu Apr 12 11:04:54 2012 +0100

    move mkWeakThreadId to GHC.Conc.Sync; export it from Control.Concurrent

>---------------------------------------------------------------

 Control/Concurrent.hs |    3 +++
 GHC/Conc.lhs          |    1 +
 GHC/Conc/Sync.lhs     |   22 ++++++++++++++++++++++
 GHC/TopHandler.lhs    |    8 --------
 4 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 55861fc..770d9c3 100644
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -89,6 +89,9 @@ module Control.Concurrent (
         runInUnboundThread,
 #endif
 
+        -- * Weak references to ThreadIds
+        mkWeakThreadId,
+
         -- * GHC's implementation of concurrency
 
         -- |This section describes features specific to GHC's
diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index a6ee11a..ad8cfc4 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -51,6 +51,7 @@ module GHC.Conc
         , runSparks
         , yield         -- :: IO ()
         , labelThread   -- :: ThreadId -> String -> IO ()
+        , mkWeakThreadId -- :: ThreadId -> IO (Weak ThreadId)
 
         , ThreadStatus(..), BlockReason(..)
         , threadStatus  -- :: ThreadId -> IO ThreadStatus
diff --git a/GHC/Conc/Sync.lhs b/GHC/Conc/Sync.lhs
index aa0ae07..928fbf1 100644
--- a/GHC/Conc/Sync.lhs
+++ b/GHC/Conc/Sync.lhs
@@ -61,6 +61,7 @@ module GHC.Conc.Sync
         , runSparks
         , yield         -- :: IO ()
         , labelThread   -- :: ThreadId -> String -> IO ()
+        , mkWeakThreadId -- :: ThreadId -> IO (Weak ThreadId)
 
         , ThreadStatus(..), BlockReason(..)
         , threadStatus  -- :: ThreadId -> IO ThreadStatus
@@ -119,6 +120,7 @@ import GHC.MVar
 import GHC.Real         ( fromIntegral )
 import GHC.Pack         ( packCString# )
 import GHC.Show         ( Show(..), showString )
+import GHC.Weak
 
 infixr 0 `par`, `pseq`
 \end{code}
@@ -514,6 +516,26 @@ threadCapability :: ThreadId -> IO (Int, Bool)
 threadCapability (ThreadId t) = IO $ \s ->
    case threadStatus# t s of
      (# s', _, cap#, locked# #) -> (# s', (I# cap#, locked# /=# 0#) #)
+
+-- | make a weak pointer to a 'ThreadId'.  It can be important to do
+-- this if you want to hold a reference to a 'ThreadId' while still
+-- allowing the thread to receive the @BlockedIndefinitely@ family of
+-- exceptions (e.g. 'BlockedIndefinitelyOnMVar').  Holding a normal
+-- 'ThreadId' reference will prevent the delivery of
+-- @BlockedIndefinitely@ exceptions because the reference could be
+-- used as the target of 'throwTo' at any time, which would unblock
+-- the thread.
+--
+-- Holding a @Weak ThreadId@, on the other hand, will not prevent the
+-- thread from receiving @BlockedIndefinitely@ exceptions.  It is
+-- still possible to throw an exception to a @Weak ThreadId@, but the
+-- caller must use @deRefWeak@ first to determine whether the thread
+-- still exists.
+--
+mkWeakThreadId :: ThreadId -> IO (Weak ThreadId)
+mkWeakThreadId t@(ThreadId t#) = IO $ \s ->
+   case mkWeak# t# t (unsafeCoerce# 0#) s of 
+      (# s1, w #) -> (# s1, Weak w #)
 \end{code}
 
 
diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs
index 419edff..f1b0cbf 100644
--- a/GHC/TopHandler.lhs
+++ b/GHC/TopHandler.lhs
@@ -104,14 +104,6 @@ foreign import ccall unsafe
 	-> IO CInt			-- (ret) old action code
 #endif
 
--- make a weak pointer to a ThreadId: holding the weak pointer doesn't
--- keep the thread alive and prevent it from being identified as
--- deadlocked.  Vitally important for the main thread.
-mkWeakThreadId :: ThreadId -> IO (Weak ThreadId)
-mkWeakThreadId t@(ThreadId t#) = IO $ \s ->
-   case mkWeak# t# t (unsafeCoerce# 0#) s of 
-      (# s1, w #) -> (# s1, Weak w #)
-
 -- | 'runIO' is wrapped around every @foreign export@ and @foreign
 -- import \"wrapper\"@ to mop up any uncaught exceptions.  Thus, the
 -- result of running 'System.Exit.exitWith' in a foreign-exported