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 \end{code}
 101
 102 %************************************************************************
 103 %*                                                                      *
 104 \subsection[mvars]{M-Structures}
 105 %*                                                                      *
 106 %************************************************************************
 107
 108 M-Vars are rendezvous points for concurrent threads.  They begin
 109 empty, and any attempt to read an empty M-Var blocks.  When an M-Var
 110 is written, a single blocked thread may be freed.  Reading an M-Var
 111 toggles its state from full back to empty.  Therefore, any value
 112 written to an M-Var may only be read once.  Multiple reads and writes
 113 are allowed, but there must be at least one read between any two
 114 writes.
 115
 116 \begin{code}
 117 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
 118
 119 instance Eq (MVar a) where
 120         (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
 121
 122 newEmptyMVar  :: IO (MVar a)
 123
 124 newEmptyMVar = IO $ \ s# ->
 125     case newMVar# s# of
 126          (# s2#, svar# #) -> (# s2#, MVar svar# #)
 127
 128 takeMVar :: MVar a -> IO a
 129
 130 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
 131
 132 putMVar  :: MVar a -> a -> IO ()
 133
 134 putMVar (MVar mvar#) x = IO $ \ s# ->
 135     case putMVar# mvar# x s# of
 136         s2# -> (# s2#, () #)
 137
 138 newMVar :: a -> IO (MVar a)
 139
 140 newMVar value =
 141     newEmptyMVar        >>= \ mvar ->
 142     putMVar mvar value  >>
 143     return mvar
 144
 145 readMVar :: MVar a -> IO a
 146
 147 readMVar mvar =
 148     takeMVar mvar       >>= \ value ->
 149     putMVar mvar value  >>
 150     return value
 151
 152 swapMVar :: MVar a -> a -> IO a
 153
 154 swapMVar mvar new =
 155     takeMVar mvar       >>= \ old ->
 156     putMVar mvar new    >>
 157     return old
 158
 159 {-
 160  Low-level op. for checking whether an MVar is filled-in or not.
 161  Notice that the boolean value returned  is just a snapshot of
 162  the state of the MVar. By the time you get to react on its result,
 163  the MVar may have been filled (or emptied) - so be extremely
 164  careful when using this operation.
 165
 166  If you can re-work your abstractions to avoid having to
 167  depend on isEmptyMVar, then you're encouraged to do so,
 168  i.e., consider yourself warned about the imprecision in
 169  general of isEmptyMVar :-)
 170 -}
 171 isEmptyMVar :: MVar a -> IO Bool
 172 isEmptyMVar (MVar mv#) = IO $ \ s# ->
 173     case isEmptyMVar# mv# s# of
 174         (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
 175 \end{code}
 176
 177
 178 %************************************************************************
 179 %*                                                                      *
 180 \subsection{Thread waiting}
 181 %*                                                                      *
 182 %************************************************************************
 183
 184 @threadDelay@ delays rescheduling of a thread until the indicated
 185 number of microseconds have elapsed.  Generally, the microseconds are
 186 counted by the context switch timer, which ticks in virtual time;
 187 however, when there are no runnable threads, we don't accumulate any
 188 virtual time, so we start ticking in real time.  (The granularity is
 189 the effective resolution of the context switch timer, so it is
 190 affected by the RTS -C option.)
 191
 192 @threadWaitRead@ delays rescheduling of a thread until input on the
 193 specified file descriptor is available for reading (just like select).
 194 @threadWaitWrite@ is similar, but for writing on a file descriptor.
 195
 196 \begin{code}
 197 {- Not yet -- SDM
 198 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
 199
 200 threadDelay (I# x#) = IO $ \ s# ->
 201     case delay# x# s# of
 202       s2# -> (# s2#, () #)
 203
 204 threadWaitRead (I# x#) = IO $ \ s# ->
 205     case waitRead# x# s# of
 206       s2# -> (# s2#, () #)
 207
 208 threadWaitWrite (I# x#) = IO $ \ s# ->
 209     case waitWrite# x# s# of
 210       s2# -> (# s2#, () #)
 211 -}
 212 \end{code}