Control.Concurrent.Waitfree
- data ZeroT
- data SucT t
- data HNil
- data HCons e l
- type :*: e l = HCons e l
- data K t a
- single :: Thread t => (t -> IO a) -> IO (K t a :*: HNil)
- class Thread t where
- t :: t
- atid :: t -> AbstractThreadId
- type AbstractThreadId = Int
- comm :: (Thread s, Thread t, HAppend l l' l'') => IO (HCons (K t (b, a)) l) -> (t -> b -> IO ThreadStatus) -> IO (HCons (K s (d, c)) l') -> (s -> d -> IO ThreadStatus) -> IO (K t (b, c) :*: (K s (d, a) :*: l''))
- follows :: HAppend l l' l'' => IO l -> IO l' -> IO l''
- cycling :: HLast l last heads => IO l -> IO (HCons last heads)
- execute :: Lconvertible l => IO l -> IO ()
- (-*-) :: (Thread t, IOerSequent l, IOerSequent l') => (t -> a -> IO b) -> (l -> IO l') -> HCons (K t a) l -> IO (HCons (K t b) l')
- data ThreadStatus
Documentation
HNil
is the empty IOerSequent
'HCons (K t e)' adds a remote computation in front of a IOerSequent
Instances
A value of type 'K t a' represents a remote computation returning a
that is performed by a thread t
.
single :: Thread t => (t -> IO a) -> IO (K t a :*: HNil)Source
single
creates a IO hypersequent consisting of a single remote computation.
An abstract representation of a thread. Threads are actually implemented using forkIO
.
type AbstractThreadId = IntSource
Each Thread
type has AbstractThreadId
comm :: (Thread s, Thread t, HAppend l l' l'') => IO (HCons (K t (b, a)) l) -> (t -> b -> IO ThreadStatus) -> IO (HCons (K s (d, c)) l') -> (s -> d -> IO ThreadStatus) -> IO (K t (b, c) :*: (K s (d, a) :*: l''))Source
(-*-) :: (Thread t, IOerSequent l, IOerSequent l') => (t -> a -> IO b) -> (l -> IO l') -> HCons (K t a) l -> IO (HCons (K t b) l')Source
extend a IO hypersequent with another computation
data ThreadStatus Source
ThreadStatus shows whether a thread is finished or have to try executing another job.
Constructors
TryAnotherJob | |
Finished |
Instances
(Thread t, Lconvertible l) => Lconvertible (HCons (K t ThreadStatus) l) |