monad-par-0.3: A library for parallel programming based on a monad

Safe HaskellSafe-Infered

Control.Monad.Par.Scheds.TraceInternal

Description

This module exposes the internals of the Par monad so that you can build your own scheduler or other extensions. Do not use this module for purposes other than extending the Par monad with new functionality.

Synopsis

Documentation

data Trace Source

Constructors

forall a . Get (IVar a) (a -> Trace) 
forall a . Put (IVar a) a Trace 
forall a . New (IVarContents a) (IVar a -> Trace) 
Fork Trace Trace 
Done 
Yield Trace 

data Sched Source

Constructors

Sched 

Fields

no :: !ThreadNumber

The threadnumber of this worker

workpool :: IORef WorkPool

The workpool for this worker

status :: IORef AllStatus

The Schedulers' status

scheds :: Array ThreadNumber Sched

The list of all workers by thread

tId :: IORef ThreadId

The ThreadId of this worker

newtype Par a Source

Constructors

Par 

Fields

runCont :: (a -> Trace) -> Trace
 

newtype IVar a Source

Constructors

IVar (IORef (IVarContents a)) 

data IVarContents a Source

Constructors

Full a 
Empty 
Blocked [a -> Trace] 

sched :: Bool -> WorkLimit -> Sched -> IORef [Trace] -> UId -> Trace -> IO ()Source

The main scheduler loop. This takes the synchrony flag, our Sched, the particular work queue we're currently working on, the uid of the work queue (for pushing work), our work limit, and the already-popped, first trace in the work queue.

INVARIANT: This should only be called by threads who ARE currently marked as working.

runPar :: Par a -> aSource

The main way to run a Par computation

runParAsync :: Par a -> aSource

An asynchronous version in which the main thread of control in a Par computation can return while forked computations still run in the background.

runParAsyncHelper :: Par a -> (a, IO ())Source

An alternative version in which the consumer of the result has the option to help run the Par computation if results it is interested in are not ready yet.

newFull :: NFData a => a -> Par (IVar a)Source

newFull_ :: a -> Par (IVar a)Source

get :: IVar a -> Par aSource

put_ :: IVar a -> a -> Par ()Source

put :: NFData a => IVar a -> a -> Par ()Source