[project @ 2002-05-09 13:16:29 by simonmar]

[ghc-base.git] / Control / Concurrent.hs

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index db570bf..673bac3 100644 (file)
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -1,15 +1,13 @@
 -----------------------------------------------------------------------------
--- 
+-- |
 -- Module      :  Control.Concurrent
 -- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/core/LICENSE)
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- $Id: Concurrent.hs,v 1.3 2001/12/21 15:07:21 simonmar Exp $
---
 -- A common interface to a collection of useful concurrency
 -- abstractions.
 --
@@ -75,7 +73,7 @@ import Control.Concurrent.SampleVar
 -- cmp_thread in the RTS.
 
 #ifdef __GLASGOW_HASKELL__
-foreign import ccall "cmp_thread" unsafe cmp_thread :: Addr# -> Addr# -> Int
+foreign import ccall unsafe "cmp_thread" cmp_thread :: Addr# -> Addr# -> Int
 -- Returns -1, 0, 1
 
 cmpThread :: ThreadId -> ThreadId -> Ordering
@@ -94,6 +92,13 @@ instance Eq ThreadId where
 instance Ord ThreadId where
    compare = cmpThread
 
+foreign import ccall unsafe "rts_getThreadId" getThreadId :: Addr# -> Int
+
+instance Show ThreadId where
+   showsPrec d (ThreadId t) = 
+       showString "ThreadId " . 
+        showsPrec d (getThreadId (unsafeCoerce# t))
+
 forkIO :: IO () -> IO ThreadId
 forkIO action = IO $ \ s -> 
    case (fork# action_plus s) of (# s1, id #) -> (# s1, ThreadId id #)