X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent.hs;h=965adeb972834b4092765c52f3450786b6ba403a;hb=1c5555c9b71fc8573e0811ae6451df700e3de771;hp=d41b4626f92213b0fa0cb3dc0b257bbcdfb23e05;hpb=2cb3e62ec5574d834b594b0523294dc5c26b371d;p=ghc-base.git diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs index d41b462..965adeb 100644 --- a/Control/Concurrent.hs +++ b/Control/Concurrent.hs @@ -20,12 +20,16 @@ module Control.Concurrent ( -- * Basic concurrency operations +#ifndef __HUGS__ ThreadId, myThreadId, +#endif forkIO, +#ifndef __HUGS__ killThread, throwTo, +#endif -- * Scheduling @@ -52,8 +56,10 @@ module Control.Concurrent ( module Control.Concurrent.SampleVar, -- * Merging of streams +#ifndef __HUGS__ mergeIO, -- :: [a] -> [a] -> IO [a] nmergeIO, -- :: [[a]] -> IO [a] +#endif -- $merge -- * GHC's implementation of concurrency @@ -84,8 +90,7 @@ import GHC.Base #endif #ifdef __HUGS__ -import IOExts ( unsafeInterleaveIO ) -import ConcBase +import Hugs.ConcBase #endif import Control.Concurrent.MVar @@ -147,12 +152,15 @@ functions blocks only the thread making the call. -- cmp_thread in the RTS. #ifdef __GLASGOW_HASKELL__ -foreign import ccall unsafe "cmp_thread" cmp_thread :: Addr# -> Addr# -> Int +id2TSO :: ThreadId -> ThreadId# +id2TSO (ThreadId t) = t + +foreign import ccall unsafe "cmp_thread" cmp_thread :: ThreadId# -> ThreadId# -> Int -- Returns -1, 0, 1 cmpThread :: ThreadId -> ThreadId -> Ordering -cmpThread (ThreadId t1) (ThreadId t2) = - case cmp_thread (unsafeCoerce# t1) (unsafeCoerce# t2) of +cmpThread t1 t2 = + case cmp_thread (id2TSO t1) (id2TSO t2) of -1 -> LT 0 -> EQ _ -> GT -- must be 1 @@ -166,12 +174,12 @@ instance Eq ThreadId where instance Ord ThreadId where compare = cmpThread -foreign import ccall unsafe "rts_getThreadId" getThreadId :: Addr# -> Int +foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> Int instance Show ThreadId where - showsPrec d (ThreadId t) = + showsPrec d t = showString "ThreadId " . - showsPrec d (getThreadId (unsafeCoerce# t)) + showsPrec d (getThreadId (id2TSO t)) {- | This sparks off a new thread to run the 'IO' computation passed as the @@ -201,7 +209,7 @@ real_handler ex = #endif /* __GLASGOW_HASKELL__ */ - +#ifndef __HUGS__ max_buff_size :: Int max_buff_size = 1 @@ -273,6 +281,7 @@ nmergeIO lss return val where mapIO f xs = sequence (map f xs) +#endif /* __HUGS__ */ -- --------------------------------------------------------------------------- -- More docs