[project @ 1996-06-27 16:55:06 by partain]

[ghc-hetmet.git] / ghc / lib / concurrent / Concurrent.hs

diff --git a/ghc/lib/prelude/Concurrent.lhs b/ghc/lib/concurrent/Concurrent.hs
similarity index 59%
rename from ghc/lib/prelude/Concurrent.lhs
rename to ghc/lib/concurrent/Concurrent.hs
index 08c5d35..3f51a78 100644 (file)
--- a/ghc/lib/prelude/Concurrent.lhs
+++ b/ghc/lib/concurrent/Concurrent.hs
@@ -1,3 +1,4 @@
+{-
 %
 % (c) The AQUA Project, Glasgow University, 1995
 %
@@ -10,23 +11,26 @@ Currently, the collection only contains the abstractions found in the
 \tr{ftp.dcs.gla.ac.uk/pub/glasgow-fp/drafts}.)  plus a couple of
 others. See the paper and the individual files containing the module
 definitions for explanation on what they do.
+-}
 
-\begin{code}
 module Concurrent (
        forkIO,
-       par, seq, -- reexported from Parallel
+       par, seq, fork, -- re-exported from GHCbase
 
-       threadWait, threadDelay,
+       -- waiting on file descriptor I/O
+       threadWaitRead, threadWaitWrite, 
 
-       ChannelVar..,
-       Channel..,
-       Semaphore..,
-       Merge..,
-       SampleVar..,
+       -- wait for timeout
+        threadDelay,
+
+       module ChannelVar,
+       module Channel,
+       module Semaphore,
+       module Merge,
+       module SampleVar,
 
        -- IVars and MVars come from here, too
-       IVar(..), MVar(..), -- for convenience...
-       _IVar, _MVar,   -- abstract
+       IVar, MVar,
        newEmptyMVar, takeMVar, putMVar, newMVar, readMVar, swapMVar,
        newIVar, readIVar, writeIVar
 
@@ -39,21 +43,12 @@ import Semaphore
 import Merge
 import SampleVar
 
-import PreludeGlaST    ( forkST )
-import PreludePrimIO   ( newEmptyMVar, newMVar, putMVar,
-                         readMVar, swapMVar, takeMVar, _MVar,
-                         newIVar, readIVar, writeIVar, _IVar,
-                         IVar(..), MVar(..),
-                         threadWait, threadDelay
-                       )
+import GHCbase
 
 forkIO :: IO () -> IO ()
 
-forkIO action s
-  = let
+forkIO (IO (ST action)) = IO $ ST $ \ s ->
+    let
        (_, new_s) = action s
     in
-    new_s `_fork_` (Right (), s)
- where
-    _fork_ x y = case (fork# x) of { 0# -> parError#; _ -> y }
-\end{code}
+    new_s `fork` (Right (), s)