阻止线程交错输出

Question

以下程序创建两个并发运行的线程,每个线程在打印一行文本到stdout之前随机休眠一段时间.

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 ()

输出通常看起来像

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

你如何确保一次只有一个线程可以写入stdout？这似乎是的那种STM要善于东西,但所有STM交易必须有型STM a一些a,而且打印在屏幕上的动作有型IO a,而且似乎没有被嵌入的方式IO进入STM.

Answer 1

使用STM处理输出的方法是拥有一个在所有线程之间共享的输出队列,并由单个线程处理.

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

使用STM. 这是因为STM它基于乐观锁定，因此每个事务都必须在任何时候都可以重新启动。如果您将IO操作嵌入到 中STM，则它可能会被执行多次。

对于这个问题，最简单的解决方案可能是使用 aMVar作为锁：

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 ()

在此解决方案中，锁作为参数传递给printer。

有些人更喜欢将锁声明为顶级全局变量，但目前这需要unsafePerformIO并依赖于 GHC 的属性，即 AFAIK 不是 Haskell 语言报告的一部分（特别是，它依赖于具有非多态类型在程序执行期间最多被评估一次）。