ghc/lib/std/PrelConc.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[PrelConc]{Module @PrelConc@}
   6
   7 Basic concurrency stuff
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 module PrelConc (
  13
  14                 -- Thread Ids
  15         ThreadId,
  16
  17                 -- Forking and suchlike
  18         forkIO,
  19         killThread,
  20         seq, par, fork,
  21         {-threadDelay, threadWaitRead, threadWaitWrite, -}
  22
  23                 -- MVars
  24         MVar, newMVar, newEmptyMVar, takeMVar, putMVar, readMVar, swapMVar
  25     ) where
  26
  27 import PrelBase
  28 import {-# SOURCE #-} PrelErr ( parError )
  29 import PrelST           ( ST(..), STret(..), liftST )
  30 import PrelIOBase       ( IO(..), MVar(..), liftIO, unsafePerformIO )
  31 import PrelErr          ( parError )
  32 import PrelBase         ( Int(..) )
  33 import PrelErr          ( seqError )
  34
  35 infixr 0 `par`, `fork`
  36 \end{code}
  37
  38 %************************************************************************
  39 %*                                                                      *
  40 \subsection{@ThreadId@, @par@, and @fork@}
  41 %*                                                                      *
  42 %************************************************************************
  43
  44 \begin{code}
  45 data ThreadId = ThreadId ThreadId#
  46 -- ToDo: data ThreadId = ThreadId (WeakPair ThreadId# ())
  47 -- But since ThreadId# is unlifted, the WeakPair type must use open
  48 -- type variables.
  49
  50 forkIO :: IO () -> IO ThreadId
  51 forkIO action = IO $ \ s ->
  52    case (fork# action s) of (# s, id #) -> (# s, ThreadId id #)
  53
  54 killThread :: ThreadId -> IO ()
  55 killThread (ThreadId id) = IO $ \ s ->
  56    case (killThread# id s) of s -> (# s, () #)
  57
  58 -- "seq" is defined a bit wierdly (see below)
  59 --
  60 -- The reason for the strange "0# -> parError" case is that
  61 -- it fools the compiler into thinking that seq is non-strict in
  62 -- its second argument (even if it inlines seq at the call site).
  63 -- If it thinks seq is strict in "y", then it often evaluates
  64 -- "y" before "x", which is totally wrong.
  65 --
  66 -- Just before converting from Core to STG there's a bit of magic
  67 -- that recognises the seq# and eliminates the duff case.
  68
  69 {-# INLINE seq  #-}
  70 seq :: a -> b -> b
  71 seq  x y = case (seq#  x) of { 0# -> seqError; _ -> y }
  72
  73 par, fork :: a -> b -> b
  74
  75 {-# INLINE par  #-}
  76 {-# INLINE fork #-}
  77 #if defined(__PARALLEL_HASKELL__) || defined (__GRANSIM__)
  78 par  x y = case (par# x) of { 0# -> parError; _ -> y }
  79 #else
  80 par  x y = y
  81 #endif
  82
  83 fork x y = unsafePerformIO (forkIO (x `seq` return ())) `seq` y
  84
  85 \end{code}
  86
  87 %************************************************************************
  88 %*                                                                      *
  89 \subsection[mvars]{M-Structures}
  90 %*                                                                      *
  91 %************************************************************************
  92
  93 M-Vars are rendezvous points for concurrent threads.  They begin
  94 empty, and any attempt to read an empty M-Var blocks.  When an M-Var
  95 is written, a single blocked thread may be freed.  Reading an M-Var
  96 toggles its state from full back to empty.  Therefore, any value
  97 written to an M-Var may only be read once.  Multiple reads and writes
  98 are allowed, but there must be at least one read between any two
  99 writes.
 100
 101 \begin{code}
 102 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
 103
 104 instance Eq (MVar a) where
 105         (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
 106
 107 newEmptyMVar  :: IO (MVar a)
 108
 109 newEmptyMVar = IO $ \ s# ->
 110     case newMVar# s# of
 111          (# s2#, svar# #) -> (# s2#, MVar svar# #)
 112
 113 takeMVar :: MVar a -> IO a
 114
 115 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
 116
 117 putMVar  :: MVar a -> a -> IO ()
 118
 119 putMVar (MVar mvar#) x = IO $ \ s# ->
 120     case putMVar# mvar# x s# of
 121         s2# -> (# s2#, () #)
 122
 123 newMVar :: a -> IO (MVar a)
 124
 125 newMVar value =
 126     newEmptyMVar        >>= \ mvar ->
 127     putMVar mvar value  >>
 128     return mvar
 129
 130 readMVar :: MVar a -> IO a
 131
 132 readMVar mvar =
 133     takeMVar mvar       >>= \ value ->
 134     putMVar mvar value  >>
 135     return value
 136
 137 swapMVar :: MVar a -> a -> IO a
 138
 139 swapMVar mvar new =
 140     takeMVar mvar       >>= \ old ->
 141     putMVar mvar new    >>
 142     return old
 143 \end{code}
 144
 145
 146 %************************************************************************
 147 %*                                                                      *
 148 \subsection{Thread waiting}
 149 %*                                                                      *
 150 %************************************************************************
 151
 152 @threadDelay@ delays rescheduling of a thread until the indicated
 153 number of microseconds have elapsed.  Generally, the microseconds are
 154 counted by the context switch timer, which ticks in virtual time;
 155 however, when there are no runnable threads, we don't accumulate any
 156 virtual time, so we start ticking in real time.  (The granularity is
 157 the effective resolution of the context switch timer, so it is
 158 affected by the RTS -C option.)
 159
 160 @threadWaitRead@ delays rescheduling of a thread until input on the
 161 specified file descriptor is available for reading (just like select).
 162 @threadWaitWrite@ is similar, but for writing on a file descriptor.
 163
 164 \begin{code}
 165 {- Not yet -- SDM
 166 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
 167
 168 threadDelay (I# x#) = IO $ \ s# ->
 169     case delay# x# s# of
 170       s2# -> (# s2#, () #)
 171
 172 threadWaitRead (I# x#) = IO $ \ s# ->
 173     case waitRead# x# s# of
 174       s2# -> (# s2#, () #)
 175
 176 threadWaitWrite (I# x#) = IO $ \ s# ->
 177     case waitWrite# x# s# of
 178       s2# -> (# s2#, () #)
 179 -}
 180 \end{code}