X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent.hs;h=6b3ec940bc2c2d3018cd95cd054936c3d3b486e6;hb=9fa9bc17072a58c0bae2cce4764d38677e96ac29;hp=f3a426ec1cb931f150bebbca70fc15f9772ae023;hpb=bbfd33a95258eb07d88722f1a9ea1dc840f07936;p=ghc-base.git diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs index f3a426e..6b3ec94 100644 --- a/Control/Concurrent.hs +++ b/Control/Concurrent.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- +-- | -- Module : Control.Concurrent -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/core/LICENSE) @@ -8,7 +8,7 @@ -- Stability : experimental -- Portability : non-portable -- --- $Id: Concurrent.hs,v 1.4 2002/04/10 15:57:16 simonmar Exp $ +-- $Id: Concurrent.hs,v 1.6 2002/04/24 16:31:37 simonmar Exp $ -- -- A common interface to a collection of useful concurrency -- abstractions. @@ -94,6 +94,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 #)