ghc/interpreter/prelude/PrelConc.hs

   1 #include "options.h"
   2
   3 #ifndef PROVIDE_CONCURRENT
   4 module PrelConc () where
   5 #else
   6 #ifdef HEAD
   7 module PrelConc (
   8
   9                 -- Thread Ids
  10         ThreadId,
  11
  12                 -- Forking and suchlike
  13         forkIO,
  14         killThread,
  15         --par, fork,
  16         {-threadDelay, threadWaitRead, threadWaitWrite, -}
  17
  18                 -- MVars
  19         MVar, newMVar, newEmptyMVar, takeMVar, putMVar, readMVar, swapMVar
  20
  21     ) where
  22
  23 --infixr 0 `par`, `fork`
  24 import PreludeBuiltin
  25 #endif /* HEAD */
  26 #ifdef BODY
  27
  28 data ThreadId
  29
  30 forkIO :: IO () -> IO ThreadId
  31 forkIO action = primFork (unsafePerformIO action)
  32
  33 killThread :: ThreadId -> IO ()
  34 killThread = primKillThread
  35
  36 data MVar a
  37
  38 instance Eq (MVar a) where (==) = primSameMVar
  39
  40 newEmptyMVar  :: IO (MVar a)
  41 newMVar :: a -> IO (MVar a)
  42 putMVar  :: MVar a -> a -> IO ()
  43 takeMVar :: MVar a -> IO a
  44 readMVar :: MVar a -> IO a
  45 swapMVar :: MVar a -> a -> IO a
  46
  47 newEmptyMVar = primNewMVar
  48 putMVar      = primPutMVar
  49 takeMVar     = primTakeMVar
  50
  51 newMVar value =
  52     newEmptyMVar        >>= \ mvar ->
  53     putMVar mvar value  >>
  54     return mvar
  55
  56 readMVar mvar =
  57     takeMVar mvar       >>= \ value ->
  58     putMVar mvar value  >>
  59     return value
  60
  61 swapMVar mvar new =
  62     takeMVar mvar       >>= \ old ->
  63     putMVar mvar new    >>
  64     return old
  65
  66 #endif /* BODY */
  67
  68 #endif /* PROVIDE_CONCURRENT */
  69