101companies

Headline

Concurrent programming and STM in Language:Haskell with TMVars

Motivation

The implementation demonstrates concurrent programming and specifically STM in Language:Haskell with Haskell's concept of TMVars, i.e., transactional MVars. To this end, the computations for the operations for totaling and cutting salaries are organized in multiple threads, in fact, transactions based on TMVars. (See Contribution:mvar for a more basic approach that uses regular thread synchronization variables, i.e., MVars.) The TMVars are used to store the progress and intermediate results of computations across multiple threads. The 

retry
combinator is leveraged to wait for certain values of transactional variables. Overall, the present implementation serves as a limited illustration of STM since the operations in question do not obviously benefit from STM.

Illustration

In the following we will illustrate both the implementation of totaling and cutting. To explain the code we first introduce a way to store and handle progress of computation, wait for results and enable multi-threaded cutting/totaling.

Representing and handling computational progress

We represent positions of interest for the next computation/transaction by using the zipper related term of focus (see the wxHaskell implementation for more information). A algebraic datatype for progress can therefore be defined as follows: 

data Progress a = Do a | Done  

type TFocusProgress = TMVar (Progress Focus)

The progress of a computation can either be that there is still some work to do or that all work is done. In the first case the corresponding type constructor takes a value providing some information about the computation to be executed. Here we use a value of the 

Focus
type. This 
TFocusProgress
datatype is defined as an 
MVar
because it should be shared among multiple threads. It is a transactional 
MVar
(
TMVar
) because the manipulation of the progress will be part of the transaction: Each total/cut transaction will call 
nextEmployeeFocus
to update the progress. This function is illustrated in the following image:

http://images6.fanpop.com/image/photos/32900000/Cat-cats-32958715-1440-900.jpg

The blue arrows illustrate the function. Each time 

nextEmployeeFocus :: Company -> Focus -> Maybe Focus
is called to compute a new focus of interest the function either returns a new focus (
Just focus
) or 
Nothing
in case all employees are processed. In the following we make use of this function to define a generic transaction function.

Generic companies transaction

We can now define a general transaction for both total and cut: 

companyTransaction :: Company -> TFocusProgress -> TMVar b -> (Focus -> b -> b) -> STM Bool
companyTransaction c tprogress tb f = do
    currentProgress <- readTMVar tprogress
    case currentProgress of
        (Do currentFocus) -> do
            currentB <- readTMVar tb
            let newB = f c currentFocus currentB
            swapTMVar tb newB
            case nextEmployeeFocus c currentFocus of
                Just newFocus -> do
                    swapTMVar tprogress (Do newFocus)
                    return False
                Nothing -> do
                    swapTMVar tprogress Done
                    return True
        Done -> return False

This function takes a company, a transactional progress and some other transactional variable which will be used in the concrete transaction. 

companyTransaction
also takes a function that transforms the value of the content of the transactional variable based on a given focus. That is, in line 3 
companyTransaction
reads the current progress and matches on the type constructors afterwards. In case all work is done (type constructor 
Done
) the function returns 
True
in line 16. In case there is still work to do 
companyTransaction
reads the current value of the second transactional variable and passes this value and the current focus to the given function 
f
in lines 6 - 7. The result of 
f
is then written in the transaction variable by swapping the content in line 8. After that the next focus is computed using 
nextEmployeeFocus
. Lines 13 and 10 match either on 
Just newFocus
or 
Nothing
. In case there is a next focus this value is swapped in the progress variable and 
False
is returned in line 12. Otherwise 
Done
is put in the variable for progress and 
True
is returned.

Waiting for results

We also provide a generic transaction that waits for a job to be done and returns the result of the job: 

getResult :: TFocusProgress -> TMVar a -> STM a
getResult tprogress ta = do
    currentProgress <- readTMVar tprogress
    case currentProgress of
        (Do  ) -> retry
        Done    -> do
            result <- readTMVar ta
            return result

In line 3 

getResult
reads the current progress of the transaction. If there is still work to do the function matches on 
Do
. In this case we use the 
retry
combinator which blocks the current thread until the content of the transactional variable for progress in modified. In case all transactions are done the function matches on 
Done
in line 6. It then reads the result from the transactional variable 
ta
and returns the content.

Using multiple threads

We make use of 

forkIO
to start multiple threads for executing the transactions: 

startTransactions :: Company -> b -> (TFocusProgress -> TMVar b -> STM Bool) -> IO b
startTransactions c initb trans = do
    case firstEmployeeFocus c of
        (Just firstFocus) -> do
            tprogress <- newTMVarIO (Do firstFocus)
            tb <- newTMVarIO initb
            forM [1..3] $ \  -> 
                forkIO $ repeatTransaction (trans tprogress tb)
            atomically $ getResult tprogress tb
        Nothing -> return initb

This function takes a company, an initial value for the content of a transactional variable and a transaction function. It returns the result from the transactional variable. To do this it first computes the first focus in question in line 3. In case this focus does not exist 

startTransactions
returns the given initial value 
b
in line 10. In case such a focus does exist 
b
it put into an transactional variable in line 5. The value of 
b
is also put in a transactional variable. After that 
startTransactions
creates three threads, each one repetitively executing the transaction. In line 9 the function waits for the result of the computation by using 
getResult
which was shown above.

To execute the transaction until the computation is done we define 

repeatTransaction
which should be straighforward: 
repeatTransaction :: STM Bool -> IO ()
repeatTransaction t = do
	done <- atomically t
	unless done $ repeatTransaction t

Now that we have defined generic functions for a company transaction, a function for waiting for results and a function for starting multiple threads to execute the transaction, we can define totaling and cutting salaries:

Total

We first define a transactional variable for holding the (intermediate) result of totaling: 

type TTotal = TMVar Float

The actual transaction for one step of totaling all salaries is defined as follows: 

addSalary :: Company -> TFocusProgress -> TTotal -> STM Bool
addSalary c tprogress ttotal = companyTransaction c tprogress ttotal (f c) 
    where f c currentFocus currentTotal = currentTotal + (salary (readEM currentFocus c))


addSalary
uses the 
companyTransaction
. The actual computation is that it reads the employee at the current focus, reads the salary and adds it the current (intermediate) total.

We can now use 

addSalary
to define 
total
: 

total :: Company -> IO Float
total c = startTransactions c 0.0 (addSalary c)

Cut

Cut also uses 

companyTransaction
to do the cutting for each focus: 

cutSalary :: TFocusProgress -> TCompany -> STM Bool
cutSalary tprogress tcompany = do
    currentCompany <- readTMVar tcompany
    companyTransaction currentCompany tprogress tcompany f 
    where 
        f currentFocus currentCompany = (writeEM currentFocus currentCompany) (cutEmployee $ readEM currentFocus currentCompany)
        cutEmployee (Employee n a s) = Employee n a (s/2)

It reads the employee at the given focus, cuts his/her salary and writes the employee back into the company by making use of 

readEM
and 
writeEM
.

Analogously to 

total
we define 
cut
: 

cut :: Company -> IO Company
cut c = startTransactions c c cutSalary

Usage

function has to be applied. One can also use the this!!Makefile with a target test for test automation.

(C) 2012-2024 softlang.org and contributors

There are no revisions for this page.

User contributions

    This user never has never made submissions.

    User edits

    Syntax for editing wiki

    For you are available next options:

    will make text bold.

    will make text italic.

    will make text underlined.

    will make text striked.

    will allow you to paste code headline into the page.

    will allow you to link into the page.

    will allow you to paste code with syntax highlight into the page. You will need to define used programming language.

    will allow you to paste image into the page.

    is list with bullets.

    is list with numbers.

    will allow your to insert slideshare presentation into the page. You need to copy link to presentation and insert it as parameter in this tag.

    will allow your to insert youtube video into the page. You need to copy link to youtube page with video and insert it as parameter in this tag.

    will allow your to insert code snippets from @worker.

    Syntax for editing wiki

    For you are available next options:

    will make text bold.

    will make text italic.

    will make text underlined.

    will make text striked.

    will allow you to paste code headline into the page.

    will allow you to link into the page.

    will allow you to paste code with syntax highlight into the page. You will need to define used programming language.

    will allow you to paste image into the page.

    is list with bullets.

    is list with numbers.

    will allow your to insert slideshare presentation into the page. You need to copy link to presentation and insert it as parameter in this tag.

    will allow your to insert youtube video into the page. You need to copy link to youtube page with video and insert it as parameter in this tag.

    will allow your to insert code snippets from @worker.