[project @ 2000-04-10 16:02:58 by simonpj]

[ghc-hetmet.git] / ghc / lib / std / PrelConc.lhs

diff --git a/ghc/lib/std/PrelConc.lhs b/ghc/lib/std/PrelConc.lhs
index 6c1df4a..f096db1 100644 (file)
--- a/ghc/lib/std/PrelConc.lhs
+++ b/ghc/lib/std/PrelConc.lhs
@@ -7,22 +7,23 @@
 Basic concurrency stuff
 
 \begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS -fcompiling-prelude -fno-implicit-prelude #-}
 
 module PrelConc
-
-       -- Thread Ids
-       ( ThreadId      -- abstract
+       ( ThreadId(..)
 
        -- Forking and suchlike
-       , forkIO        -- :: IO () -> IO ThreadId
        , myThreadId    -- :: IO ThreadId
        , killThread    -- :: ThreadId -> IO ()
        , raiseInThread -- :: ThreadId -> Exception -> IO ()
        , par           -- :: a -> b -> b
-       , fork          -- :: a -> b -> b
        , seq           -- :: a -> b -> b
-       {-threadDelay, threadWaitRead, threadWaitWrite,-}
+       , yield         -- :: IO ()
+
+       -- Waiting
+       , threadDelay           -- :: Int -> IO ()
+       , threadWaitRead        -- :: Int -> IO ()
+       , threadWaitWrite       -- :: Int -> IO ()
 
        -- MVars
        , MVar          -- abstract
@@ -43,7 +44,7 @@ import PrelIOBase     ( IO(..), MVar(..), unsafePerformIO )
 import PrelBase                ( Int(..) )
 import PrelException    ( Exception(..), AsyncException(..) )
 
-infixr 0 `par`, `fork`
+infixr 0 `par`, `seq`
 \end{code}
 
 %************************************************************************
@@ -58,9 +59,7 @@ data ThreadId = ThreadId ThreadId#
 -- But since ThreadId# is unlifted, the Weak type must use open
 -- type variables.
 
-forkIO :: IO () -> IO ThreadId
-forkIO action = IO $ \ s -> 
-   case (fork# action s) of (# s1, id #) -> (# s1, ThreadId id #)
+--forkIO has now been hoisted out into the Concurrent library.
 
 killThread :: ThreadId -> IO ()
 killThread (ThreadId id) = IO $ \ s ->
@@ -74,6 +73,10 @@ myThreadId :: IO ThreadId
 myThreadId = IO $ \s ->
    case (myThreadId# s) of (# s1, id #) -> (# s1, ThreadId id #)
 
+yield :: IO ()
+yield = IO $ \s -> 
+   case (yield# s) of s1 -> (# s1, () #)
+
 -- "seq" is defined a bit wierdly (see below)
 --
 -- The reason for the strange "0# -> parError" case is that
@@ -89,18 +92,9 @@ myThreadId = IO $ \s ->
 seq :: a -> b -> b
 seq  x y = case (seq#  x) of { 0# -> seqError; _ -> y }
 
-par, fork :: a -> b -> b
-
 {-# INLINE par  #-}
-{-# INLINE fork #-}
-#if defined(__PARALLEL_HASKELL__) || defined (__GRANSIM__)
+par :: a -> b -> b
 par  x y = case (par# x) of { 0# -> parError; _ -> y }
-#else
-par  _ y = y
-#endif
-
-fork x y = unsafePerformIO (forkIO (x `seq` return ())) `seq` y
-
 \end{code}
 
 %************************************************************************
@@ -120,9 +114,6 @@ writes.
 \begin{code}
 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
 
-instance Eq (MVar a) where
-       (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
-
 newEmptyMVar  :: IO (MVar a)
 
 newEmptyMVar = IO $ \ s# ->
@@ -198,19 +189,9 @@ specified file descriptor is available for reading (just like select).
 @threadWaitWrite@ is similar, but for writing on a file descriptor.
 
 \begin{code}
-{- Not yet -- SDM 
 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
 
-threadDelay (I# x#) = IO $ \ s# ->
-    case delay# x# s# of
-      s2# -> (# s2#, () #)
-
-threadWaitRead (I# x#) = IO $ \ s# -> 
-    case waitRead# x# s# of
-      s2# -> (# s2#, () #)
-
-threadWaitWrite (I# x#) = IO $ \ s# ->
-    case waitWrite# x# s# of
-      s2# -> (# s2#, () #)
--}
+threadDelay     (I# ms) = IO $ \s -> case delay# ms s     of s -> (# s, () #)
+threadWaitRead  (I# fd) = IO $ \s -> case waitRead# fd s  of s -> (# s, () #)
+threadWaitWrite (I# fd) = IO $ \s -> case waitWrite# fd s of s -> (# s, () #)
 \end{code}