X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent.hs;h=8dbec340cc9a3bee591d9e88e8e4eb4146644cca;hb=e831a7c5106c09767a93209ac278edbe5291b153;hp=9fff8277c405059224ff6b295b2e766ca726b93a;hpb=0be227fdbf8ff48f36635a25a767f32ec5f895c4;p=ghc-base.git

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 9fff827..8dbec34 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
@@ -108,8 +113,8 @@ doesn't make use of any operating system-supplied thread packages.
 Haskell threads can communicate via 'MVar's, a kind of synchronised
 mutable variable (see "Control.Concurrent.MVar").  Several common
 concurrency abstractions can be built from 'MVar's, and these are
-provided by the "Concurrent" library.  Threads may also communicate
-via exceptions. 
+provided by the "Control.Concurrent" library.  Threads may also
+communicate via exceptions. 
 -}
 
 {- $conc_scheduling
@@ -137,7 +142,7 @@ for input will block /all/ threads, unless the @threadsafe@ attribute
 is used on the foreign call (and your compiler \/ operating system
 supports it).  GHC's I\/O system uses non-blocking I\/O internally to
 implement thread-friendly I\/O, so calling standard Haskell I\/O
-functions blocks only the thead making the call.
+functions blocks only the thread making the call.
 -}
 
 -- Thread Ids, specifically the instances of Eq and Ord for these things.
@@ -147,12 +152,15 @@ functions blocks only the thead 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
@@ -299,7 +308,7 @@ nmergeIO lss
 >     return mvar
 
       Note that we use 'finally' from the
-      "Exception" module to make sure that the
+      "Control.Exception" module to make sure that the
       'MVar' is written to even if the thread dies or
       is killed for some reason.
 
@@ -348,7 +357,7 @@ nmergeIO lss
 
       The rescheduling timer runs on a 20ms granularity by
       default, but this may be altered using the
-      @-i<n>@ RTS option.  After a rescheduling
+      @-i\<n\>@ RTS option.  After a rescheduling
       \"tick\" the running thread is pre-empted as soon as
       possible.