Stop threads from interleaving

Question

The following program creates two threads at the same time, each of which sleeps for an arbitrary period of time before printing a line of text into standard output.

import Control.Concurrent import Control.Monad import System.Random randomDelay t = randomRIO (0, t) >>= threadDelay printer str = forkIO . forever $ do randomDelay 1000000 -- μs putStrLn str main = do printer "Hello" printer "World" return () 

The output usually looks something like

 >> main Hello World World Hello WoHrelld o World Hello *Interrupted >> 

How do you guarantee that only one thread can write to stdout at a time? It looks like STM should be fine, but all STM transactions must be of type STM a for some a , and the action that is printed on the screen is of type IO a , and there seems to be no way to insert IO into STM .

Answer 1

The way to process output using STM is to have an output queue that is shared by all threads and processed by a single thread.

 import Control.Concurrent import Control.Concurrent.STM import Control.Monad import System.Random randomDelay t = randomRIO (0, t) >>= threadDelay printer queue str = forkIO . forever $ do randomDelay 1000000 -- μs atomically $ writeTChan queue str prepareOutputQueue = do queue <- newTChanIO forkIO . forever $ atomically (readTChan queue) >>= putStrLn return queue main = do queue <- prepareOutputQueue printer queue "Hello" printer queue "World" return () 

Answer 2

Locking in how you describe is not possible using STM . This is due to the fact that STM based on an optimistic lock and therefore every transaction must be reloaded at any point. If you entered an IO operation in STM , it could be performed several times.

Probably the easiest solution to this problem is to use MVar as a lock:

 import Control.Concurrent import Control.Concurrent.MVar import Control.Monad import System.Random randomDelay t = randomRIO (0, t) >>= threadDelay printer lock str = forkIO . forever $ do randomDelay 1000000 withMVar lock (\_ -> putStrLn str) main = do lock <- newMVar () printer lock "Hello" printer lock "World" return () 

In this solution, the lock is passed as an argument to printer .

Some people prefer to declare a lock as a global top-level variable , but currently it requires unsafePerformIO and relies on GHC properties that AFAIK are not part of the Haskell language report (in particular, it relies on a global variable with a non-polymorphic type evaluating no more once during program execution).

Answer 3

A little research based on Petr Pudlak’s answer shows that there is a Control.Concurrent.Lock module in the concurrent-extra package that provides abstraction around locks on MVar () .

Solution using this library

 import Control.Concurrent import qualified Control.Concurrent.Lock as Lock import Control.Monad import System.Random randomDelay t = randomRIO (0, t) >>= threadDelay printer lock str = forkIO . forever $ do randomDelay 1000 Lock.with lock (putStrLn str) main = do lock <- Lock.new printer lock "Hello" printer lock "World" return ()