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