[project @ 2003-01-28 21:38:30 by panne]
[ghc-base.git] / Control / Concurrent.hs
index 968e303..965adeb 100644 (file)
@@ -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
@@ -81,12 +87,10 @@ import GHC.TopHandler   ( reportStackOverflow, reportError )
 import GHC.IOBase      ( IO(..) )
 import GHC.IOBase      ( unsafeInterleaveIO )
 import GHC.Base
-import GHC.Ptr
 #endif
 
 #ifdef __HUGS__
-import IOExts ( unsafeInterleaveIO )
-import ConcBase
+import Hugs.ConcBase
 #endif
 
 import Control.Concurrent.MVar
@@ -148,12 +152,10 @@ functions blocks only the thread making the call.
 -- cmp_thread in the RTS.
 
 #ifdef __GLASGOW_HASKELL__
-type StgTSO = Ptr ()
+id2TSO :: ThreadId -> ThreadId#
+id2TSO (ThreadId t) = t
 
-id2TSO :: ThreadId -> StgTSO
-id2TSO (ThreadId t) = unsafeCoerce# t
-
-foreign import ccall unsafe "cmp_thread" cmp_thread :: StgTSO -> StgTSO -> Int
+foreign import ccall unsafe "cmp_thread" cmp_thread :: ThreadId# -> ThreadId# -> Int
 -- Returns -1, 0, 1
 
 cmpThread :: ThreadId -> ThreadId -> Ordering
@@ -172,7 +174,7 @@ instance Eq ThreadId where
 instance Ord ThreadId where
    compare = cmpThread
 
-foreign import ccall unsafe "rts_getThreadId" getThreadId :: StgTSO -> Int
+foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> Int
 
 instance Show ThreadId where
    showsPrec d t = 
@@ -207,7 +209,7 @@ real_handler ex =
 
 #endif /* __GLASGOW_HASKELL__ */
 
-
+#ifndef __HUGS__
 max_buff_size :: Int
 max_buff_size = 1
 
@@ -279,6 +281,7 @@ nmergeIO lss
     return val
   where
     mapIO f xs = sequence (map f xs)
+#endif /* __HUGS__ */
 
 -- ---------------------------------------------------------------------------
 -- More docs