2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[ConcBase]{Module @ConcBase@}
7 Basic concurrency stuff
10 {-# OPTIONS -fno-implicit-prelude #-}
12 -- Forking and suchlike
17 threadDelay, threadWaitRead, threadWaitWrite,
20 MVar, newMVar, newEmptyMVar, takeMVar, putMVar, readMVar, swapMVar
24 import STBase ( PrimIO(..), ST(..), State(..), StateAndPtr#(..) )
25 import IOBase ( IO(..), MVar(..) )
26 import GHCerr ( parError )
27 import PrelBase ( Int(..) )
28 import GHC ( fork#, delay#, waitRead#, waitWrite#,
29 SynchVar#, newSynchVar#, takeMVar#, putMVar#,
30 State#, RealWorld, par#
33 infixr 0 `par`, `fork`
38 %************************************************************************
40 \subsection{@par@, and @fork@}
42 %************************************************************************
45 forkST :: ST s a -> ST s a
47 forkST (ST action) = ST $ \ s ->
53 fork__ x y = case (fork# x) of { 0# -> parError; _ -> y }
55 forkPrimIO :: PrimIO a -> PrimIO a
58 forkIO :: IO () -> IO ()
59 forkIO (IO (ST action)) = IO $ ST $ \ s ->
63 new_s `fork` (Right (), s)
65 par, fork :: Eval a => a -> b -> b
70 #if defined(__PARALLEL_HASKELL__) || defined (__GRANSIM__)
71 par x y = case (par# x) of { 0# -> parError; _ -> y }
72 fork x y = case (fork# x) of { 0# -> parError; _ -> y }
79 %************************************************************************
81 \subsection[PreludeGlaST-mvars]{M-Structures}
83 %************************************************************************
85 M-Vars are rendezvous points for concurrent threads. They begin
86 empty, and any attempt to read an empty M-Var blocks. When an M-Var
87 is written, a single blocked thread may be freed. Reading an M-Var
88 toggles its state from full back to empty. Therefore, any value
89 written to an M-Var may only be read once. Multiple reads and writes
90 are allowed, but there must be at least one read between any two
94 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
96 newEmptyMVar :: IO (MVar a)
98 newEmptyMVar = IO $ ST $ \ (S# s#) ->
99 case newSynchVar# s# of
100 StateAndSynchVar# s2# svar# -> (Right (MVar svar#), S# s2#)
102 takeMVar :: MVar a -> IO a
104 takeMVar (MVar mvar#) = IO $ ST $ \ (S# s#) ->
105 case takeMVar# mvar# s# of
106 StateAndPtr# s2# r -> (Right r, S# s2#)
108 putMVar :: MVar a -> a -> IO ()
110 putMVar (MVar mvar#) x = IO $ ST $ \ (S# s#) ->
111 case putMVar# mvar# x s# of
112 s2# -> (Right (), S# s2#)
114 newMVar :: a -> IO (MVar a)
117 newEmptyMVar >>= \ mvar ->
118 putMVar mvar value >>
121 readMVar :: MVar a -> IO a
124 takeMVar mvar >>= \ value ->
125 putMVar mvar value >>
128 swapMVar :: MVar a -> a -> IO a
131 takeMVar mvar >>= \ old ->
137 %************************************************************************
139 \subsection{Thread waiting}
141 %************************************************************************
143 @threadDelay@ delays rescheduling of a thread until the indicated
144 number of microseconds have elapsed. Generally, the microseconds are
145 counted by the context switch timer, which ticks in virtual time;
146 however, when there are no runnable threads, we don't accumulate any
147 virtual time, so we start ticking in real time. (The granularity is
148 the effective resolution of the context switch timer, so it is
149 affected by the RTS -C option.)
151 @threadWaitRead@ delays rescheduling of a thread until input on the
152 specified file descriptor is available for reading (just like select).
153 @threadWaitWrite@ is similar, but for writing on a file descriptor.
156 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
158 threadDelay (I# x#) = IO $ ST $ \ (S# s#) ->
160 s2# -> (Right (), S# s2#)
162 threadWaitRead (I# x#) = IO $ ST $ \ (S# s#) ->
163 case waitRead# x# s# of
164 s2# -> (Right (), S# s2#)
166 threadWaitWrite (I# x#) = IO $ ST $ \ (S# s#) ->
167 case waitWrite# x# s# of
168 s2# -> (Right (), S# s2#)
171 %*********************************************************
173 \subsection{Ghastly return types}
175 %*********************************************************
178 data StateAndSynchVar# s elt = StateAndSynchVar# (State# s) (SynchVar# s elt)