[project @ 2003-05-12 10:16:22 by ross]

[ghc-base.git] / Control / Concurrent.hs

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 968e303..06e4b1a 100644 (file)
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -21,11 +21,15 @@ module Control.Concurrent (
        -- * Basic concurrency operations
 
         ThreadId,
        -- * Basic concurrency operations
 
         ThreadId,

+#ifdef __GLASGOW_HASKELL__

        myThreadId,
        myThreadId,

+#endif

 
        forkIO,
 
        forkIO,

+#ifdef __GLASGOW_HASKELL__

        killThread,
        throwTo,
        killThread,
        throwTo,

+#endif

 
        -- * Scheduling
 
 
        -- * Scheduling
 

@@ -52,8 +56,10 @@ module Control.Concurrent (
        module Control.Concurrent.SampleVar,
 
        -- * Merging of streams
        module Control.Concurrent.SampleVar,
 
        -- * Merging of streams

+#ifndef __HUGS__

        mergeIO,                -- :: [a]   -> [a] -> IO [a]
        nmergeIO,               -- :: [[a]] -> IO [a]
        mergeIO,                -- :: [a]   -> [a] -> IO [a]
        nmergeIO,               -- :: [[a]] -> IO [a]

+#endif

        -- $merge
 
        -- * GHC's implementation of concurrency
        -- $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.IOBase      ( IO(..) )
 import GHC.IOBase      ( unsafeInterleaveIO )
 import GHC.Base

-import GHC.Ptr

 #endif
 
 #ifdef __HUGS__
 #endif
 
 #ifdef __HUGS__

-import IOExts ( unsafeInterleaveIO )
-import ConcBase
+import Hugs.ConcBase

 #endif
 
 import Control.Concurrent.MVar
 #endif
 
 import Control.Concurrent.MVar

@@ -95,6 +99,10 @@ import Control.Concurrent.QSem
 import Control.Concurrent.QSemN
 import Control.Concurrent.SampleVar
 
 import Control.Concurrent.QSemN
 import Control.Concurrent.SampleVar
 

+#ifdef __HUGS__
+type ThreadId = ()
+#endif
+

 {- $conc_intro
 
 The concurrency extension for Haskell is described in the paper
 {- $conc_intro
 
 The concurrency extension for Haskell is described in the paper

@@ -109,8 +117,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
 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.
+In GHC, threads may also communicate via exceptions.

 -}
 
 {- $conc_scheduling
 -}
 
 {- $conc_scheduling

@@ -148,12 +156,10 @@ functions blocks only the thread making the call.
 -- cmp_thread in the RTS.
 
 #ifdef __GLASGOW_HASKELL__
 -- 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
 -- Returns -1, 0, 1
 
 cmpThread :: ThreadId -> ThreadId -> Ordering

@@ -172,7 +178,7 @@ instance Eq ThreadId where
 instance Ord ThreadId where
    compare = cmpThread
 
 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 = 
 
 instance Show ThreadId where
    showsPrec d t = 

@@ -207,7 +213,7 @@ real_handler ex =
 
 #endif /* __GLASGOW_HASKELL__ */
 
 
 #endif /* __GLASGOW_HASKELL__ */
 

-
+#ifndef __HUGS__

 max_buff_size :: Int
 max_buff_size = 1
 
 max_buff_size :: Int
 max_buff_size = 1
 

@@ -279,6 +285,7 @@ nmergeIO lss
     return val
   where
     mapIO f xs = sequence (map f xs)
     return val
   where
     mapIO f xs = sequence (map f xs)

+#endif /* __HUGS__ */

 
 -- ---------------------------------------------------------------------------
 -- More docs
 
 -- ---------------------------------------------------------------------------
 -- More docs

@@ -305,7 +312,7 @@ nmergeIO lss
 >     return mvar
 
       Note that we use 'finally' from the
 >     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.
 
       'MVar' is written to even if the thread dies or
       is killed for some reason.
 

@@ -354,7 +361,7 @@ nmergeIO lss
 
       The rescheduling timer runs on a 20ms granularity by
       default, but this may be altered using the
 
       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.
 
       \"tick\" the running thread is pre-empted as soon as
       possible.