2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[PrelConc]{Module @PrelConc@}
7 Basic concurrency stuff
10 {-# OPTIONS -fno-implicit-prelude #-}
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
24 , threadDelay -- :: Int -> IO ()
25 , threadWaitRead -- :: Int -> IO ()
26 , threadWaitWrite -- :: Int -> IO ()
30 , newMVar -- :: a -> IO (MVar a)
31 , newEmptyMVar -- :: IO (MVar a)
32 , takeMVar -- :: MVar a -> IO a
33 , putMVar -- :: MVar a -> a -> IO ()
34 , readMVar -- :: MVar a -> IO a
35 , swapMVar -- :: MVar a -> a -> IO a
36 , isEmptyMVar -- :: MVar a -> IO Bool
41 import PrelErr ( parError, seqError )
42 import PrelST ( liftST )
43 import PrelIOBase ( IO(..), MVar(..), unsafePerformIO )
44 import PrelBase ( Int(..) )
45 import PrelException ( Exception(..), AsyncException(..) )
50 %************************************************************************
52 \subsection{@ThreadId@, @par@, and @fork@}
54 %************************************************************************
57 data ThreadId = ThreadId ThreadId#
58 -- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
59 -- But since ThreadId# is unlifted, the Weak type must use open
62 --forkIO has now been hoisted out into the Concurrent library.
64 killThread :: ThreadId -> IO ()
65 killThread (ThreadId id) = IO $ \ s ->
66 case (killThread# id (AsyncException ThreadKilled) s) of s1 -> (# s1, () #)
68 raiseInThread :: ThreadId -> Exception -> IO ()
69 raiseInThread (ThreadId id) ex = IO $ \ s ->
70 case (killThread# id ex s) of s1 -> (# s1, () #)
72 myThreadId :: IO ThreadId
73 myThreadId = IO $ \s ->
74 case (myThreadId# s) of (# s1, id #) -> (# s1, ThreadId id #)
78 case (yield# s) of s1 -> (# s1, () #)
80 -- "seq" is defined a bit wierdly (see below)
82 -- The reason for the strange "0# -> parError" case is that
83 -- it fools the compiler into thinking that seq is non-strict in
84 -- its second argument (even if it inlines seq at the call site).
85 -- If it thinks seq is strict in "y", then it often evaluates
86 -- "y" before "x", which is totally wrong.
88 -- Just before converting from Core to STG there's a bit of magic
89 -- that recognises the seq# and eliminates the duff case.
93 seq x y = case (seq# x) of { 0# -> seqError; _ -> y }
98 #if defined(__PARALLEL_HASKELL__) || defined (__GRANSIM__)
99 par x y = case (par# x) of { 0# -> parError; _ -> y }
105 %************************************************************************
107 \subsection[mvars]{M-Structures}
109 %************************************************************************
111 M-Vars are rendezvous points for concurrent threads. They begin
112 empty, and any attempt to read an empty M-Var blocks. When an M-Var
113 is written, a single blocked thread may be freed. Reading an M-Var
114 toggles its state from full back to empty. Therefore, any value
115 written to an M-Var may only be read once. Multiple reads and writes
116 are allowed, but there must be at least one read between any two
120 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
122 instance Eq (MVar a) where
123 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
125 newEmptyMVar :: IO (MVar a)
127 newEmptyMVar = IO $ \ s# ->
129 (# s2#, svar# #) -> (# s2#, MVar svar# #)
131 takeMVar :: MVar a -> IO a
133 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
135 putMVar :: MVar a -> a -> IO ()
137 putMVar (MVar mvar#) x = IO $ \ s# ->
138 case putMVar# mvar# x s# of
141 newMVar :: a -> IO (MVar a)
144 newEmptyMVar >>= \ mvar ->
145 putMVar mvar value >>
148 readMVar :: MVar a -> IO a
151 takeMVar mvar >>= \ value ->
152 putMVar mvar value >>
155 swapMVar :: MVar a -> a -> IO a
158 takeMVar mvar >>= \ old ->
163 Low-level op. for checking whether an MVar is filled-in or not.
164 Notice that the boolean value returned is just a snapshot of
165 the state of the MVar. By the time you get to react on its result,
166 the MVar may have been filled (or emptied) - so be extremely
167 careful when using this operation.
169 If you can re-work your abstractions to avoid having to
170 depend on isEmptyMVar, then you're encouraged to do so,
171 i.e., consider yourself warned about the imprecision in
172 general of isEmptyMVar :-)
174 isEmptyMVar :: MVar a -> IO Bool
175 isEmptyMVar (MVar mv#) = IO $ \ s# ->
176 case isEmptyMVar# mv# s# of
177 (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
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, () #)