X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent.hs;h=673bac35ab117b4441f33872dcadcd89f9467f00;hb=f7a485978f04e84b086f1974b88887cc72d832d0;hp=db570bf09612a9ff15a9b38cc838a3be026ce338;hpb=260e7f2ed9a43c6ecf5a556d77817f39ed2893ab;p=ghc-base.git diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs index db570bf..673bac3 100644 --- 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 #)