[project @ 2004-10-17 00:22:03 by ross]

[haskell-directory.git] / Control / Concurrent.hs

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 9b98930..02f74fb 100644 (file)
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -62,13 +62,14 @@ module Control.Concurrent (
 #endif
        -- $merge
 
+#ifdef __GLASGOW_HASKELL__
        -- * Bound Threads
        -- $boundthreads
-#ifdef __GLASGOW_HASKELL__
        rtsSupportsBoundThreads,
        forkOS,
        isCurrentThreadBound,
-       runInBoundThread
+       runInBoundThread,
+       runInUnboundThread
 #endif
 
        -- * GHC's implementation of concurrency
@@ -90,7 +91,8 @@ import Prelude
 import Control.Exception as Exception
 
 #ifdef __GLASGOW_HASKELL__
-import GHC.Conc
+import GHC.Conc                ( ThreadId(..), myThreadId, killThread, yield,
+                         threadDelay, threadWaitRead, threadWaitWrite )
 import GHC.TopHandler   ( reportStackOverflow, reportError )
 import GHC.IOBase      ( IO(..) )
 import GHC.IOBase      ( unsafeInterleaveIO )
@@ -142,7 +144,7 @@ In GHC, threads may also communicate via exceptions.
 
     Scheduling may be either pre-emptive or co-operative,
     depending on the implementation of Concurrent Haskell (see below
-    for imformation related to specific compilers).  In a co-operative
+    for information related to specific compilers).  In a co-operative
     system, context switches only occur when you use one of the
     primitives defined in this module.  This means that programs such
     as:
@@ -228,8 +230,7 @@ real_handler ex =
 
        -- report all others:
        AsyncException StackOverflow -> reportStackOverflow False
-       ErrorCall s -> reportError False s
-       other       -> reportError False (showsPrec 0 other "\n")
+       other       -> reportError False other
 
 #endif /* __GLASGOW_HASKELL__ */
 
@@ -307,18 +308,15 @@ nmergeIO lss
     mapIO f xs = sequence (map f xs)
 #endif /* __HUGS__ */
 
+#ifdef __GLASGOW_HASKELL__
 -- ---------------------------------------------------------------------------
 -- Bound Threads
 
 {- $boundthreads
 
 Support for multiple operating system threads and bound threads as described
-below is currently only available in the GHC runtime system when the runtime system
-has been compiled using a special option.
-
-When recompiling GHC, use ./configure --enable-threaded-rts to enable this.
-To find your GHC has already been compiled that way, use
-'rtsSupportsBoundThreads' from GHCi.
+below is currently only available in the GHC runtime system if you use the
+/-threaded/ option when linking.
 
 Other Haskell systems do not currently support multiple operating system threads.
 
@@ -345,8 +343,6 @@ libraries (OpenGL, for example) will not work from a thread created using
 from @main@ or from a @foreign export@.
 -}
 
-#ifdef __GLASGOW_HASKELL__
-
 -- | 'True' if bound threads are supported.
 -- If @rtsSupportsBoundThreads@ is 'False', 'isCurrentThreadBound'
 -- will always return 'False' and both 'forkOS' and 'runInBoundThread' will
@@ -383,6 +379,9 @@ forkOS_entry stableAction = do
 foreign import ccall forkOS_createThread
     :: StablePtr (IO ()) -> IO CInt
 
+failNonThreaded = fail $ "RTS doesn't support multiple OS threads "
+                       ++"(use ghc -threaded when linking)"
+    
 forkOS action 
     | rtsSupportsBoundThreads = do
        mv <- newEmptyMVar
@@ -393,7 +392,7 @@ forkOS action
        tid <- takeMVar mv
        freeStablePtr entry
        return tid
-    | otherwise = fail "RTS not built to support multiple OS threads."
+    | otherwise = failNonThreaded
 
 -- | Returns 'True' if the calling thread is /bound/, that is, if it is
 -- safe to use foreign libraries that rely on thread-local state from the
@@ -430,7 +429,7 @@ runInBoundThread action
                case resultOrException of
                    Left exception -> Exception.throw exception
                    Right result -> return result
-    | otherwise = fail "RTS not built to support multiple OS threads."
+    | otherwise = failNonThreaded
 
 {- | 
 Run the 'IO' computation passed as the first argument. If the calling thread
@@ -446,17 +445,17 @@ doesn't need it's main thread to be bound and makes /heavy/ use of concurrency
 runInUnboundThread :: IO a -> IO a
 
 runInUnboundThread action = do
-       bound <- isCurrentThreadBound
-       if bound
-               then do
-                       mv <- newEmptyMVar
-                       forkIO (Exception.try action >>= putMVar mv)
-                       takeMVar mv >>= \either -> case either of
-                       Left exception -> Exception.throw exception
-                       Right result -> return result
-               else action
+    bound <- isCurrentThreadBound
+    if bound
+        then do
+            mv <- newEmptyMVar
+            forkIO (Exception.try action >>= putMVar mv)
+            takeMVar mv >>= \either -> case either of
+                Left exception -> Exception.throw exception
+                Right result -> return result
+        else action
        
-#endif
+#endif /* __GLASGOW_HASKELL__ */
 
 -- ---------------------------------------------------------------------------
 -- More docs
@@ -528,7 +527,7 @@ runInUnboundThread action = do
       a thread may be pre-empted whenever it allocates some memory,
       which unfortunately means that tight loops which do no
       allocation tend to lock out other threads (this only seems to
-      happen with pathalogical benchmark-style code, however).
+      happen with pathological benchmark-style code, however).
 
       The rescheduling timer runs on a 20ms granularity by
       default, but this may be altered using the