X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent.hs;h=965adeb972834b4092765c52f3450786b6ba403a;hb=1c5555c9b71fc8573e0811ae6451df700e3de771;hp=5484fc14d037e5881d696692487c19eb2597798a;hpb=90eca6686c8224e7012ee8574890f6e875975e72;p=ghc-base.git

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 5484fc1..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,13 +56,15 @@ 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
+	-- * GHC's implementation of concurrency
 
-	-- |This section describes features specific to GHC\'s
+	-- |This section describes features specific to GHC's
 	-- implementation of Concurrent Haskell.
 	
 	-- ** Terminating the program
@@ -84,8 +90,7 @@ import GHC.Base
 #endif
 
 #ifdef __HUGS__
-import IOExts ( unsafeInterleaveIO )
-import ConcBase
+import Hugs.ConcBase
 #endif
 
 import Control.Concurrent.MVar
@@ -103,7 +108,7 @@ The concurrency extension for Haskell is described in the paper
 Concurrency is \"lightweight\", which means that both thread creation
 and context switching overheads are extremely low.  Scheduling of
 Haskell threads is done internally in the Haskell runtime system, and
-doesn\'t make use of any operating system-supplied thread packages.
+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
@@ -122,7 +127,7 @@ via exceptions.
     as:
 
 
->   main = forkIO (write \'a\') >> write \'b\'
+>   main = forkIO (write 'a') >> write 'b'
 >     where write c = putChar c >> write c
 
     will print either @aaaaaaaaaaaaaa...@ or @bbbbbbbbbbbb...@,
@@ -135,9 +140,9 @@ via exceptions.
 Calling a foreign C procedure (such as @getchar@) that blocks waiting
 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
+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
@@ -358,11 +367,11 @@ nmergeIO lss
       to the locking on a 'Handle'.  Only one thread
       may hold the lock on a 'Handle' at any one
       time, so if a reschedule happens while a thread is holding the
-      lock, the other thread won\'t be able to run.  The upshot is that
+      lock, the other thread won't be able to run.  The upshot is that
       the switch from @aaaa@ to
       @bbbbb@ happens infrequently.  It can be
       improved by lowering the reschedule tick period.  We also have a
       patch that causes a reschedule whenever a thread waiting on a
-      lock is woken up, but haven\'t found it to be useful for anything
+      lock is woken up, but haven't found it to be useful for anything
       other than this example :-)
 -}