1 % -----------------------------------------------------------------------------
2 % $Id: PrelConc.lhs,v 1.25 2001/09/14 15:49:56 simonpj Exp $
4 % (c) The University of Glasgow, 1994-2000
7 \section[PrelConc]{Module @PrelConc@}
9 Basic concurrency stuff
12 {-# OPTIONS -fno-implicit-prelude #-}
17 -- Forking and suchlike
18 , myThreadId -- :: IO ThreadId
19 , killThread -- :: ThreadId -> IO ()
20 , throwTo -- :: ThreadId -> Exception -> IO ()
21 , par -- :: a -> b -> b
22 , pseq -- :: a -> b -> b
26 , threadDelay -- :: Int -> IO ()
27 , threadWaitRead -- :: Int -> IO ()
28 , threadWaitWrite -- :: Int -> IO ()
32 , newMVar -- :: a -> IO (MVar a)
33 , newEmptyMVar -- :: IO (MVar a)
34 , takeMVar -- :: MVar a -> IO a
35 , putMVar -- :: MVar a -> a -> IO ()
36 , tryTakeMVar -- :: MVar a -> IO (Maybe a)
37 , tryPutMVar -- :: MVar a -> a -> IO Bool
38 , isEmptyMVar -- :: MVar a -> IO Bool
39 , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
45 import PrelErr ( parError, seqError )
46 import PrelIOBase ( IO(..), MVar(..) )
47 import PrelBase ( Int(..) )
48 import PrelException ( Exception(..), AsyncException(..) )
50 infixr 0 `par`, `pseq`
53 %************************************************************************
55 \subsection{@ThreadId@, @par@, and @fork@}
57 %************************************************************************
60 data ThreadId = ThreadId ThreadId#
61 -- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
62 -- But since ThreadId# is unlifted, the Weak type must use open
65 --forkIO has now been hoisted out into the Concurrent library.
67 killThread :: ThreadId -> IO ()
68 killThread (ThreadId id) = IO $ \ s ->
69 case (killThread# id (AsyncException ThreadKilled) s) of s1 -> (# s1, () #)
71 throwTo :: ThreadId -> Exception -> IO ()
72 throwTo (ThreadId id) ex = IO $ \ s ->
73 case (killThread# id ex s) of s1 -> (# s1, () #)
75 myThreadId :: IO ThreadId
76 myThreadId = IO $ \s ->
77 case (myThreadId# s) of (# s1, id #) -> (# s1, ThreadId id #)
81 case (yield# s) of s1 -> (# s1, () #)
83 -- Nota Bene: 'pseq' used to be 'seq'
84 -- but 'seq' is now defined in PrelGHC
86 -- "pseq" is defined a bit weirdly (see below)
88 -- The reason for the strange "0# -> parError" case is that
89 -- it fools the compiler into thinking that seq is non-strict in
90 -- its second argument (even if it inlines seq at the call site).
91 -- If it thinks seq is strict in "y", then it often evaluates
92 -- "y" before "x", which is totally wrong.
94 -- Just before converting from Core to STG there's a bit of magic
95 -- that recognises the seq# and eliminates the duff case.
99 pseq x y = case (seq# x) of { 0# -> seqError; _ -> y }
103 par x y = case (par# x) of { 0# -> parError; _ -> y }
106 %************************************************************************
108 \subsection[mvars]{M-Structures}
110 %************************************************************************
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
121 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
123 newEmptyMVar :: IO (MVar a)
124 newEmptyMVar = IO $ \ s# ->
126 (# s2#, svar# #) -> (# s2#, MVar svar# #)
128 takeMVar :: MVar a -> IO a
129 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
131 putMVar :: MVar a -> a -> IO ()
132 putMVar (MVar mvar#) x = IO $ \ s# ->
133 case putMVar# mvar# x s# of
136 tryPutMVar :: MVar a -> a -> IO Bool
137 tryPutMVar (MVar mvar#) x = IO $ \ s# ->
138 case tryPutMVar# mvar# x s# of
139 (# s, 0# #) -> (# s, False #)
140 (# s, _ #) -> (# s, True #)
142 newMVar :: a -> IO (MVar a)
144 newEmptyMVar >>= \ mvar ->
145 putMVar mvar value >>
148 -- tryTakeMVar is a non-blocking takeMVar
149 tryTakeMVar :: MVar a -> IO (Maybe a)
150 tryTakeMVar (MVar m) = IO $ \ s ->
151 case tryTakeMVar# m s of
152 (# s, 0#, _ #) -> (# s, Nothing #) -- MVar is empty
153 (# s, _, a #) -> (# s, Just a #) -- MVar is full
156 Low-level op. for checking whether an MVar is filled-in or not.
157 Notice that the boolean value returned is just a snapshot of
158 the state of the MVar. By the time you get to react on its result,
159 the MVar may have been filled (or emptied) - so be extremely
160 careful when using this operation.
162 Use tryTakeMVar instead if possible.
164 If you can re-work your abstractions to avoid having to
165 depend on isEmptyMVar, then you're encouraged to do so,
166 i.e., consider yourself warned about the imprecision in
167 general of isEmptyMVar :-)
169 isEmptyMVar :: MVar a -> IO Bool
170 isEmptyMVar (MVar mv#) = IO $ \ s# ->
171 case isEmptyMVar# mv# s# of
172 (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
174 -- Like addForeignPtrFinalizer, but for MVars
175 addMVarFinalizer :: MVar a -> IO () -> IO ()
176 addMVarFinalizer (MVar m) finalizer =
177 IO $ \s -> case mkWeak# m () finalizer s of { (# s1, w #) -> (# s1, () #) }
181 %************************************************************************
183 \subsection{Thread waiting}
185 %************************************************************************
187 @threadDelay@ delays rescheduling of a thread until the indicated
188 number of microseconds have elapsed. Generally, the microseconds are
189 counted by the context switch timer, which ticks in virtual time;
190 however, when there are no runnable threads, we don't accumulate any
191 virtual time, so we start ticking in real time. (The granularity is
192 the effective resolution of the context switch timer, so it is
193 affected by the RTS -C option.)
195 @threadWaitRead@ delays rescheduling of a thread until input on the
196 specified file descriptor is available for reading (just like select).
197 @threadWaitWrite@ is similar, but for writing on a file descriptor.
200 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
202 threadDelay (I# ms) = IO $ \s -> case delay# ms s of s -> (# s, () #)
203 threadWaitRead (I# fd) = IO $ \s -> case waitRead# fd s of s -> (# s, () #)
204 threadWaitWrite (I# fd) = IO $ \s -> case waitWrite# fd s of s -> (# s, () #)