edenmodules-1.2.0.0: Semi-explicit parallel programming library

Copyright(c) Philipps Universitaet Marburg 2005-2012
LicenseBSD-style (see the file LICENSE)
Maintainereden@mathematik.uni-marburg.de
Stabilitybeta
Portabilitynot portable
Safe HaskellNone
LanguageHaskell98

Control.Parallel.Eden

Contents

Description

Provides functions for semi-explicit distributed functional programming. Defines high-level coordination concepts via Prim.Op.s (which are wrapped inside ParPrim.hs).

Depends on GHC. Using standard GHC, you will get a threaded simulation of Eden. Use the special GHC-Eden compiler from http://www.mathematik.uni-marburg.de/~eden for parallel execution with distributed heaps.

Eden Group Marburg ( http://www.mathematik.uni-marburg.de/~eden )

Synopsis

Basic Eden

Process definition

data Process a b Source

Process abstractions of type Process a b can be created with function process. Process abstractions define remote functions similar to lambda abstractions, which define local functions.

process Source

Arguments

:: (Trans a, Trans b) 
=> (a -> b)

Input function

-> Process a b

Process abstraction from input function

Creates a process abstraction Process a b from a function a -> b.

rfi Source

Arguments

:: Trans b 
=> (a -> b)

Input function

-> a

Offline input

-> Process () b

Process abstraction; process takes unit input

Remote function invocation, evaluating a function application remotely without communicating the input argument

Parallel Action

data PA a Source

Instances

Monad PA 
Functor PA 
MonadFix PA 
Applicative PA 

runPA :: PA a -> a Source

Process instantiation

The operator # is the standard operator for process instantiation in Eden. Similar to applying a function f to an argument x (f x), it instantiates a process for f with the argument x (process f # x). The computation is the same from a denotational point of view. The operational semantics, however, is different because the operation is executed remotely. If you prefer to expose the side effects of such an operation explicitly with the IO-Monad wrapped in the parallel action monad, you can use function instantiate (p # x = runPA (instantiate p x)). It is non-trivial to instantiate a list of processes such that all instantiations take place immediately. Therefore Eden provides function spawn which wraps this commonly used pattern.

The Eden runtime system handles process placementfor the basic instantiation functions. In the default setting, process placement is done round robin, where the distribution is decided locally by each machine. The runtime option qrnd enables random process placement. Eden further offers functions instantiateAt and spawnAt with an additional placement parameter. instantiateAt i instantiates the process at machine i mod noPe for a positive i and instantiateAt 0 = instantiate. This is similar for spawnAt.

All instantiation functions are also provided in versions which take functions instead of process abstractions as parameters. In this case, the process abstractions are implicitly created prior to instantiation. The function version of # is e.g. called $#, the names of other instantiation functions of this kind contain an F.

(#) Source

Arguments

:: (Trans a, Trans b) 
=> Process a b

Process abstraction

-> a

Process input

-> b

Process output

Instantiates a process abstraction on a remote machine, sends the input of type a and returns the process output of type b.

($#) Source

Arguments

:: (Trans a, Trans b) 
=> (a -> b)

Process abstraction

-> a

Process input

-> b

Process output

Instantiates a process defined by the given function on a remote machine, sends the input of type a and returns the process output of type b.

spawn Source

Arguments

:: (Trans a, Trans b) 
=> [Process a b]

Process abstractions

-> [a]

Process inputs

-> [b]

Process outputs

Instantiates a list of process abstractions on remote machines with corresponding inputs of type a and returns the processes outputs, each of type b. The i-th process is supplied with the i-th input generating the i-th output. The number of processes (= length of output list) is determined by the length of the shorter input list (thus one list may be infinite).

spawnF Source

Arguments

:: (Trans a, Trans b) 
=> [a -> b]

Process abstractions

-> [a]

Process inputs

-> [b]

Process outputs

Instantiates processes defined by the given list of functions on remote machines with corresponding inputs of type a and returns the processes outputs, each of type b. The i-th process is supplied with the i-th input generating the i-th output. The number of processes (= length of output list) is determined by the length of the shorter input list (thus one list may be infinite).

spawnAt Source

Arguments

:: (Trans a, Trans b) 
=> [Int]

Machine numbers

-> [Process a b]

Process abstractions

-> [a]

Process inputs

-> [b]

Process outputs

Same as spawn , but with an additional [Int] argument that specifies where to instantiate the processes.

spawnFAt Source

Arguments

:: (Trans a, Trans b) 
=> [Int]

Machine numbers

-> [a -> b]

Process abstractions

-> [a]

Process inputs

-> [b]

Process outputs

Same as spawnF , but with an additional [Int] argument that specifies where to instantiate the processes.

instantiate Source

Arguments

:: (Trans a, Trans b) 
=> Process a b

Process abstraction

-> a

Process input

-> PA b

Process output

Instantiates a process on a remote machine, sends the input of type a and returns the process output of type b in the parallel action monad, thus it can be combined to a larger parallel action.

instantiateF Source

Arguments

:: (Trans a, Trans b) 
=> (a -> b)

Function for Process

-> a

Process input

-> PA b

Process output

Instantiates a process defined by the given function on a remote machine, sends the input of type a and returns the process output of type b in the parallel action monad, thus it can be combined to a larger parallel action.

instantiateAt Source

Arguments

:: (Trans a, Trans b) 
=> Int

Machine number

-> Process a b

Process abstraction

-> a

Process input

-> PA b

Process output

Instantiation with explicit placement (see instantiate).

instantiateFAt Source

Arguments

:: (Trans a, Trans b) 
=> Int

Machine number

-> (a -> b)

Process abstraction

-> a

Process input

-> PA b

Process output

Instantiation with explicit placement (see instantiate).

Overloaded Communication

Communication of process inputs and outputs is done implicitly by the Eden runtime system. The sent data has to be transmissible i.e. it has to be an instance of type class Trans. All data will be evaluated to normal form before it is sent in one message. Communication is overloaded for lists which are sent as streams element by element, and for tuples which are sent using concurrent channel connections for each tuple element. Note that lists in tuples are streamed concurrently, but a list of tuples is streamed element-wise, with each tuple elements evaluated as a whole. The inner list of nested lists will also be sent in one packet.

class NFData a => Trans a where Source

Trans class: overloads communication for streams and tuples. You need to declare normal-form evaluation in an instance declaration of NFData. Use the default implementation for write and createComm for instances of Trans.

Minimal complete definition

Nothing

Methods

write :: a -> IO () Source

createComm :: IO (ChanName a, a) Source

Instances

Trans Bool 
Trans Char 
Trans Double 
Trans Float 
Trans Int 
Trans Integer 
Trans () 
Trans a => Trans [a] 
Trans a => Trans (Maybe a) 
(Trans a, Trans b) => Trans (Either a b) 
(Trans a, Trans b) => Trans (a, b) 
(Trans a, Trans b, Trans c) => Trans (a, b, c) 
(Trans a, Trans b, Trans c, Trans d) => Trans (a, b, c, d) 
(Trans a, Trans b, Trans c, Trans d, Trans e) => Trans (a, b, c, d, e) 
(Trans a, Trans b, Trans c, Trans d, Trans e, Trans f) => Trans (a, b, c, d, e, f) 
(Trans a, Trans b, Trans c, Trans d, Trans e, Trans f, Trans g) => Trans (a, b, c, d, e, f, g) 
(Trans a, Trans b, Trans c, Trans d, Trans e, Trans f, Trans g, Trans h) => Trans (a, b, c, d, e, f, g, h) 
(Trans a, Trans b, Trans c, Trans d, Trans e, Trans f, Trans g, Trans h, Trans i) => Trans (a, b, c, d, e, f, g, h, i) 

Explicit placement

noPe :: Int Source

Number of (logical) machines in the system

selfPe :: Int Source

Local machine number (ranges from 1 to noPe)

type Places = [Int] Source

Places where to instantiate lists of processes

Remote Data

A remote data handle RD a represents data of type a which may be located on a remote machine. Such a handle is very small and can be passed via intermediate machines with only little communication overhead. You can create a remote data using the function release and access a remote value using the function fetch.

Notice that a remote value may only be fetched exactly once!

type RD a = ChanName (ChanName a) Source

release Source

Arguments

:: Trans a 
=> a

The original data

-> RD a

The Remote Data handle

Converts local data into corresponding remote data.

releasePA Source

Arguments

:: Trans a 
=> a

The original data

-> PA (RD a)

The Remote Data handle

Converts local data into corresponding remote data. The result is in the parallel action monad and can be combined to a larger parallel action.

fetch Source

Arguments

:: Trans a 
=> RD a

The Remote Data handle

-> a

The original data

This establishes a direct connection to the process which released the data in the first place. Notice that a remote value may only be fetched exactly once!

fetchPA :: Trans a => RD a -> PA a Source

This establishes a direct connection to the process which released the data in the first place. The result is in the parallel action monad and can be combined to a larger parallel action. Notice that you have to fetch a remote value exactly once!

releaseAll Source

Arguments

:: Trans a 
=> [a]

The original data

-> [RD a]

The Remote Data handles, one for each list element

Transforms a list of local data into a corresponding remote data list.

fetchAll Source

Arguments

:: Trans a 
=> [RD a]

The Remote Data handles

-> [a]

The original data

Transforms a list of remote data into a corresponding local data list. map fetch would wait for each list element until fetching the next one. Function fetchAll blocks only on partial defined list structure, not on content.

liftRD Source

Arguments

:: (Trans a, Trans b) 
=> (a -> b)

Function to be lifted

-> RD a

Remote input

-> RD b

Remote output

Function liftRD is used to lift functions acting on normal data to function performing the same computation on Remote Data.

liftRD2 Source

Arguments

:: (Trans a, Trans b, Trans c) 
=> (a -> b -> c)

Function to be lifted

-> RD a

First remote input

-> RD b

Second remote input

-> RD c

Remote output

see liftRD

liftRD3 :: (Trans a, Trans b, Trans c, Trans d) => (a -> b -> c -> d) -> RD a -> RD b -> RD c -> RD d Source

see liftRD

liftRD4 :: (Trans a, Trans b, Trans c, Trans d, Trans e) => (a -> b -> c -> d -> e) -> RD a -> RD b -> RD c -> RD d -> RD e Source

see liftRD

Dynamic Channels

type ChanName a = Comm a Source

A channel name ChanName a is a handle for a reply channel. The channel can be created with the function new and you can connect to such a channel with the function parfill.

new Source

Arguments

:: Trans a 
=> (ChanName a -> a -> b)

Parameter function that takes a channel name and a substitute for the lazily received value.

-> b

Forwarded result

A channel can be created with the function new (this is an unsafe side effect!). It takes a function whose first parameter is the channel name ChanName a and whose second parameter is the value of type a that will be received lazily in the future. The ChanName and the value of type a can be used in the body of the parameter function to create the output of type b. The output of the parameter function will be forwarded to the output of new .

Example: new (channame val -> (channame,val)) returns the tuple (channame, value) .

parfill Source

Arguments

:: Trans a 
=> ChanName a

ChanName to connect with

-> a

Data that will be send

-> b

Forwarded to result

-> b

Result (available after sending)

You can connect to a reply channel with function parfill (this is an unsafe side effect!). The first parameter is the name of the channel, the second parameter is the value to be send. The third parameter will be the functions result after the concurrent sending operation is initiated. The sending operation will be triggered as soon as the result of type b is demanded. Take care not to make the result of parfill depend on the sent value, as this will create a deadlock.

Nondeterminism

merge Source

Arguments

:: [[a]]

Input lists

-> [a]

Nondeterministically merged output list

Non-deterministically merges a list of lists (usually input streams) into a single list. The order of the output list is determined by the availability of the inner lists constructors. (Function merge is defined using a list merge function nmergeIO_E) (similar to nmergeIO from Concurrent Haskell, but in a custom version).

mergeProc Source

Arguments

:: [[a]]

Input lists

-> [a]

Nondeterministically merged output list

same as merge

Deprecated legacy code for Eden 5

data Lift a Source

Deprecated: Lift data type not needed in Eden 6 implementation

Constructors

Lift a

Deprecated: Lift data type not needed in Eden 6 implementation

deLift :: Lift a -> a Source

Deprecated: Lift data type not needed in Eden 6 implementation

createProcess :: (Trans a, Trans b) => Process a b -> a -> Lift b Source

Deprecated: better use instantiate :: Process a b -> a -> IO b instead

cpAt :: (Trans a, Trans b) => Int -> Process a b -> a -> Lift b Source

Reexported functions from Control.Deepseq

class NFData a where

Minimal complete definition

Nothing

Methods

rnf :: a -> ()

Instances

NFData Bool 
NFData Char 
NFData Double 
NFData Float 
NFData Int 
NFData Int8 
NFData Int16 
NFData Int32 
NFData Int64 
NFData Integer 
NFData Word 
NFData Word8 
NFData Word16 
NFData Word32 
NFData Word64 
NFData () 
NFData Version 
NFData a => NFData [a] 
(Integral a, NFData a) => NFData (Ratio a) 
NFData a => NFData (Maybe a) 
NFData (Fixed a) 
(RealFloat a, NFData a) => NFData (Complex a) 
NFData (ChanName' a) 
NFData (a -> b) 
(NFData a, NFData b) => NFData (Either a b) 
(NFData a, NFData b) => NFData (a, b) 
(NFData k, NFData a) => NFData (Map k a) 
(Ix a, NFData a, NFData b) => NFData (Array a b) 
(NFData a, NFData b, NFData c) => NFData (a, b, c) 
(NFData a, NFData b, NFData c, NFData d) => NFData (a, b, c, d) 
(NFData a1, NFData a2, NFData a3, NFData a4, NFData a5) => NFData (a1, a2, a3, a4, a5) 
(NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6) => NFData (a1, a2, a3, a4, a5, a6) 
(NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7) => NFData (a1, a2, a3, a4, a5, a6, a7) 
(NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8) => NFData (a1, a2, a3, a4, a5, a6, a7, a8) 
(NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8, NFData a9) => NFData (a1, a2, a3, a4, a5, a6, a7, a8, a9) 

Reexported functions from Control.Seq (strategies differ from those in Control.Parallel!)

type Strategy a = a -> ()

using :: a -> Strategy a -> a

seqFoldable :: Foldable t => Strategy a -> Strategy (t a)

Reexported functions from Control.Parallel

pseq :: a -> b -> b