Safe Haskell | None |
---|
LogicGrowsOnTrees.Parallel.Common.Workgroup
Description
This module provides most of the common functionality needed to implement a adapter where the number of workers can be adjusted during the run.
- class RequestQueueMonad m => WorkgroupRequestQueueMonad m where
- changeNumberOfWorkersAsync :: (Word -> Word) -> (Word -> IO ()) -> m ()
- type InnerMonad inner_state = StateT inner_state IO
- data MessageForSupervisorReceivers exploration_mode worker_id = MessageForSupervisorReceivers {
- receiveProgressUpdateFromWorker :: worker_id -> ProgressUpdate (ProgressFor exploration_mode) -> IO ()
- receiveStolenWorkloadFromWorker :: worker_id -> Maybe (StolenWorkload (ProgressFor exploration_mode)) -> IO ()
- receiveFailureFromWorker :: worker_id -> String -> IO ()
- receiveFinishedFromWorker :: worker_id -> WorkerFinishedProgressFor exploration_mode -> IO ()
- receiveQuitFromWorker :: worker_id -> IO ()
- type WorkerId = Int
- data WorkgroupCallbacks inner_state = WorkgroupCallbacks {
- createWorker :: WorkerId -> InnerMonad inner_state ()
- destroyWorker :: WorkerId -> Bool -> InnerMonad inner_state ()
- killAllWorkers :: [WorkerId] -> InnerMonad inner_state ()
- sendProgressUpdateRequestTo :: WorkerId -> InnerMonad inner_state ()
- sendWorkloadStealRequestTo :: WorkerId -> InnerMonad inner_state ()
- sendWorkloadTo :: WorkerId -> Workload -> InnerMonad inner_state ()
- newtype WorkgroupControllerMonad inner_state exploration_mode α = C {
- unwrapC :: RequestQueueReader exploration_mode WorkerId (WorkgroupStateMonad inner_state) α
- changeNumberOfWorkers :: WorkgroupRequestQueueMonad m => (Word -> Word) -> m Word
- setNumberOfWorkersAsync :: WorkgroupRequestQueueMonad m => Word -> IO () -> m ()
- setNumberOfWorkers :: WorkgroupRequestQueueMonad m => Word -> m ()
- runWorkgroup :: ExplorationMode exploration_mode -> inner_state -> (MessageForSupervisorReceivers exploration_mode WorkerId -> WorkgroupCallbacks inner_state) -> ProgressFor exploration_mode -> WorkgroupControllerMonad inner_state exploration_mode () -> IO (RunOutcomeFor exploration_mode)
Type-classes
class RequestQueueMonad m => WorkgroupRequestQueueMonad m whereSource
A WorkgroupRequestQueueMonad
is a RequestQueueMonad
but with the
additional ability to change the number of workers in the system.
Methods
changeNumberOfWorkersAsync :: (Word -> Word) -> (Word -> IO ()) -> m ()Source
Change the number of workers; the first argument is a map that computes the new number of workers given the old number of workers, and the second argument is a callback that will be invoked with the new number of workers.
See changeNumberOfWorkers
for the synchronous version of this request.
If you just want to set the number of workers to some fixed value, then
see setNumberOfWorkers
/ setNumberOfWorkersAsync
.
Instances
WorkgroupRequestQueueMonad (ThreadsControllerMonad exploration_mode) | |
WorkgroupRequestQueueMonad (WorkgroupControllerMonad inner_state exploration_mode) |
Types
type InnerMonad inner_state = StateT inner_state IOSource
This is the monad in which the adapter specific code is run.
data MessageForSupervisorReceivers exploration_mode worker_id Source
This data structure contains callbacks to be invoked when a message has been received, depending on the kind of message.
Constructors
MessageForSupervisorReceivers | |
Fields
|
data WorkgroupCallbacks inner_state Source
A set of callbacks invoked by the supervisor code in this module.
Constructors
WorkgroupCallbacks | |
Fields
|
newtype WorkgroupControllerMonad inner_state exploration_mode α Source
This is the monad in which the workgroup controller will run.
Constructors
C | |
Fields
|
Instances
Monad (WorkgroupControllerMonad inner_state exploration_mode) | |
Functor (WorkgroupControllerMonad inner_state exploration_mode) | |
Applicative (WorkgroupControllerMonad inner_state exploration_mode) | |
MonadCatchIO (WorkgroupControllerMonad inner_state exploration_mode) | |
MonadIO (WorkgroupControllerMonad inner_state exploration_mode) | |
HasExplorationMode (WorkgroupControllerMonad inner_state exploration_mode) | |
RequestQueueMonad (WorkgroupControllerMonad inner_state exploration_mode) | |
WorkgroupRequestQueueMonad (WorkgroupControllerMonad inner_state exploration_mode) |
Functions
Worker count adjustment
changeNumberOfWorkers :: WorkgroupRequestQueueMonad m => (Word -> Word) -> m WordSource
Like changeNumberOfWorkersAsync
, but it blocks until the number of workers
has been changed and returns the new number of workers.
setNumberOfWorkersAsync :: WorkgroupRequestQueueMonad m => Word -> IO () -> m ()Source
Request that the number of workers be set to the given amount, invoking the given callback when this has been done.
setNumberOfWorkers :: WorkgroupRequestQueueMonad m => Word -> m ()Source
Like setNumberOfWorkersAsync
, but blocks until the number of workers has been set to the desired value.
Runner
Arguments
:: ExplorationMode exploration_mode | the mode in which we are exploring the tree |
-> inner_state | the initial adapter specific state of the inner monad |
-> (MessageForSupervisorReceivers exploration_mode WorkerId -> WorkgroupCallbacks inner_state) | a function that constructs a set of callbacks to be used by the supervisor loop in this function to do things like creating and destroying workers; it is given a set of callbacks that allows the adapter specific code to signal conditions to the supervisor |
-> ProgressFor exploration_mode | the initial progress of the exploration |
-> WorkgroupControllerMonad inner_state exploration_mode () | the controller, which is at the very least responsible for deciding how many workers should be initially created |
-> IO (RunOutcomeFor exploration_mode) |
Explores a tree using a workgroup; this function is only intended to be used by adapters where the number of workers can be changed on demand.