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