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         par, fork, seq,
  21         {-threadDelay, threadWaitRead, threadWaitWrite,-}
  22
  23                 -- MVars
  24         MVar
  25      , newMVar
  26      , newEmptyMVar
  27      , takeMVar
  28      , putMVar
  29      , readMVar
  30      , swapMVar
  31        -- use with care (see comment.)
  32      , isEmptyMVar
  33     ) where
  34
  35 import PrelBase
  36 import PrelErr ( parError, seqError )
  37 import PrelST           ( ST(..), STret(..), liftST )
  38 import PrelIOBase       ( IO(..), MVar(..), unsafePerformIO )
  39 import PrelBase         ( Int(..) )
  40
  41 infixr 0 `par`, `fork`
  42 \end{code}
  43
  44 %************************************************************************
  45 %*                                                                      *
  46 \subsection{@ThreadId@, @par@, and @fork@}
  47 %*                                                                      *
  48 %************************************************************************
  49
  50 \begin{code}
  51 data ThreadId = ThreadId ThreadId#
  52 -- ToDo: data ThreadId = ThreadId (WeakPair ThreadId# ())
  53 -- But since ThreadId# is unlifted, the WeakPair type must use open
  54 -- type variables.
  55
  56 forkIO :: IO () -> IO ThreadId
  57 forkIO action = IO $ \ s ->
  58    case (fork# action s) of (# s1, id #) -> (# s1, ThreadId id #)
  59
  60 killThread :: ThreadId -> IO ()
  61 killThread (ThreadId id) = IO $ \ s ->
  62    case (killThread# id s) of s1 -> (# s1, () #)
  63
  64 -- "seq" is defined a bit wierdly (see below)
  65 --
  66 -- The reason for the strange "0# -> parError" case is that
  67 -- it fools the compiler into thinking that seq is non-strict in
  68 -- its second argument (even if it inlines seq at the call site).
  69 -- If it thinks seq is strict in "y", then it often evaluates
  70 -- "y" before "x", which is totally wrong.
  71 --
  72 -- Just before converting from Core to STG there's a bit of magic
  73 -- that recognises the seq# and eliminates the duff case.
  74
  75 {-# INLINE seq  #-}
  76 seq :: a -> b -> b
  77 seq  x y = case (seq#  x) of { 0# -> seqError; _ -> y }
  78
  79 par, fork :: a -> b -> b
  80
  81 {-# INLINE par  #-}
  82 {-# INLINE fork #-}
  83 #if defined(__PARALLEL_HASKELL__) || defined (__GRANSIM__)
  84 par  x y = case (par# x) of { 0# -> parError; _ -> y }
  85 #else
  86 par  _ y = y
  87 #endif
  88
  89 fork x y = unsafePerformIO (forkIO (x `seq` return ())) `seq` y
  90
  91 \end{code}
  92
  93 %************************************************************************
  94 %*                                                                      *
  95 \subsection[mvars]{M-Structures}
  96 %*                                                                      *
  97 %************************************************************************
  98
  99 M-Vars are rendezvous points for concurrent threads.  They begin
 100 empty, and any attempt to read an empty M-Var blocks.  When an M-Var
 101 is written, a single blocked thread may be freed.  Reading an M-Var
 102 toggles its state from full back to empty.  Therefore, any value
 103 written to an M-Var may only be read once.  Multiple reads and writes
 104 are allowed, but there must be at least one read between any two
 105 writes.
 106
 107 \begin{code}
 108 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
 109
 110 instance Eq (MVar a) where
 111         (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
 112
 113 newEmptyMVar  :: IO (MVar a)
 114
 115 newEmptyMVar = IO $ \ s# ->
 116     case newMVar# s# of
 117          (# s2#, svar# #) -> (# s2#, MVar svar# #)
 118
 119 takeMVar :: MVar a -> IO a
 120
 121 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
 122
 123 putMVar  :: MVar a -> a -> IO ()
 124
 125 putMVar (MVar mvar#) x = IO $ \ s# ->
 126     case putMVar# mvar# x s# of
 127         s2# -> (# s2#, () #)
 128
 129 newMVar :: a -> IO (MVar a)
 130
 131 newMVar value =
 132     newEmptyMVar        >>= \ mvar ->
 133     putMVar mvar value  >>
 134     return mvar
 135
 136 readMVar :: MVar a -> IO a
 137
 138 readMVar mvar =
 139     takeMVar mvar       >>= \ value ->
 140     putMVar mvar value  >>
 141     return value
 142
 143 swapMVar :: MVar a -> a -> IO a
 144
 145 swapMVar mvar new =
 146     takeMVar mvar       >>= \ old ->
 147     putMVar mvar new    >>
 148     return old
 149
 150 {-
 151  Low-level op. for checking whether an MVar is filled-in or not.
 152  Notice that the boolean value returned  is just a snapshot of
 153  the state of the MVar. By the time you get to react on its result,
 154  the MVar may have been filled (or emptied) - so be extremely
 155  careful when using this operation.
 156
 157  If you can re-work your abstractions to avoid having to
 158  depend on isEmptyMVar, then you're encouraged to do so,
 159  i.e., consider yourself warned about the imprecision in
 160  general of isEmptyMVar :-)
 161 -}
 162 isEmptyMVar :: MVar a -> IO Bool
 163 isEmptyMVar (MVar mv#) = IO $ \ s# ->
 164     case isEmptyMVar# mv# s# of
 165         (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
 166 \end{code}
 167
 168
 169 %************************************************************************
 170 %*                                                                      *
 171 \subsection{Thread waiting}
 172 %*                                                                      *
 173 %************************************************************************
 174
 175 @threadDelay@ delays rescheduling of a thread until the indicated
 176 number of microseconds have elapsed.  Generally, the microseconds are
 177 counted by the context switch timer, which ticks in virtual time;
 178 however, when there are no runnable threads, we don't accumulate any
 179 virtual time, so we start ticking in real time.  (The granularity is
 180 the effective resolution of the context switch timer, so it is
 181 affected by the RTS -C option.)
 182
 183 @threadWaitRead@ delays rescheduling of a thread until input on the
 184 specified file descriptor is available for reading (just like select).
 185 @threadWaitWrite@ is similar, but for writing on a file descriptor.
 186
 187 \begin{code}
 188 {- Not yet -- SDM
 189 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
 190
 191 threadDelay (I# x#) = IO $ \ s# ->
 192     case delay# x# s# of
 193       s2# -> (# s2#, () #)
 194
 195 threadWaitRead (I# x#) = IO $ \ s# ->
 196     case waitRead# x# s# of
 197       s2# -> (# s2#, () #)
 198
 199 threadWaitWrite (I# x#) = IO $ \ s# ->
 200     case waitWrite# x# s# of
 201       s2# -> (# s2#, () #)
 202 -}
 203 \end{code}