Multithreading 停止线程交错输出

下面的程序创建了两个并发运行的线程，每个线程在将一行文本打印到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
>>

---

如何确保一次只能有一个线程写入标准输出？这似乎是STM应该擅长的事情，但对于某些

a

，所有STM事务都必须具有类型

STM a

，并且打印到屏幕上的操作具有类型

IO a

，而且似乎没有办法将

IO

嵌入

STM

使用

STM

无法以您描述的方式锁定。这是因为

STM

基于乐观锁定，因此每个事务都必须在任何时候重新启动。如果将

IO

操作嵌入到

STM

中，则可以执行多次

可能解决此问题的最简单方法是使用

MVar

作为锁：

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

导入控制。并发
导入控制.Concurrent.MVar
进口管制
导入系统。随机
随机延迟t=randomRIO（0，t）>>=threadDelay
打印机锁str=forkIO。永远$do
随机延迟1000000
带MVAR锁（\ \ \->putStrLn str）
main=do
锁基于的一点研究表明，包中有一个模块提供了基于
MVar（）
的锁的抽象

使用该库的解决方案是

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

导入控制。并发
将限定控件.Concurrent.Lock作为锁导入
进口管制
导入系统。随机
随机延迟t=randomRIO（0，t）>>=threadDelay
打印机锁str=forkIO。永远$do
随机延迟1000
带锁的锁（putStrLn str）
main=do
lock使用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 ()

导入控制。并发
导入控制.Concurrent.STM
进口管制
导入系统。随机
随机延迟t=randomRIO（0，t）>>=threadDelay
打印机队列str=forkIO。永远$do
随机延迟1000000——μs
原子级$writeTChan队列str
prepareOutputQueue=do
队列>=putStrLn
返回队列
main=do
队列这是使用全局锁的示例，如Petr所述

import Control.Concurrent
import Control.Monad
import System.Random
import Control.Concurrent.MVar  (newMVar, takeMVar, putMVar, MVar)
import System.IO.Unsafe (unsafePerformIO)


{-# NOINLINE lock #-}
lock :: MVar ()
lock = unsafePerformIO $ newMVar ()



printer x = forkIO . forever $ do
   randomDelay 100000
   () <- takeMVar lock
   let atomicPutStrLn str =  putStrLn str >> putMVar lock ()
   atomicPutStrLn x

randomDelay t = randomRIO (0, t) >>= threadDelay



main = do
  printer "Hello"
  printer "World"
  return ()

导入控制。并发
进口管制
导入系统。随机
import Control.Concurrent.MVar（newMVar、takeMVar、putMVar、MVar）
导入System.IO.Unsafe（unsafePerformIO）
{-#NOINLINE lock}
lock:：MVar（）
lock=unsafePerformIO$newMVar（）
打印机x=forkIO。永远$do
随机延迟100000
（）>putMVar锁（）
原子计算机
随机延迟t=randomRIO（0，t）>>=threadDelay
main=do
打印机“你好”
打印机“世界”
返回（）
如果您愿意，您实际上可以使用STM实现锁，尽管
MVar几乎肯定会执行得更好

newtype Lock = Lock (TVar Status)
data Status = Locked | Unlocked

newLocked :: IO Lock
newLocked = Lock <$> newTVarIO Locked

newUnlocked :: IO Lock
newUnlocked = Lock <$> newTVarIO Unlocked

-- | Acquire a lock.
acquire :: Lock -> IO ()
acquire (Lock tv) = atomically $
  readTVar tv >>= \case
    Locked -> retry
    Unlocked -> writeTVar tv Locked

-- | Try to acquire a lock. If the operation succeeds,
-- return `True`.
tryAcquire :: Lock -> IO Bool
tryAcquire (Lock tv) = atomically $
  readTVar tv >>= \case
    Locked -> pure False
    Unlocked -> True <$ writeTVar tv Locked

-- | Release a lock. This version throws an exception
-- if the lock is unlocked.
release :: Lock -> IO ()
release (Lock tv) = atomically $
  readTVar tv >>= \case
    Unlocked -> throwSTM DoubleRelease
    Locked -> writeTVar tv Unlocked

data DoubleRelease = DoubleRelease deriving Show
instance Exception DoubleRelease where
  displayException ~DoubleRelease = "Attempted to release an unlocked lock."

-- | Release a lock. This version does nothing if
-- the lock is unlocked.
releaseIdempotent :: Lock -> IO ()
releaseIdempotent (Lock tv) = atomically $ writeTVar tv Unlocked

-- | Get the status of a lock.
isLocked :: Lock -> IO Status
isLocked (Lock tv) = readTVarIO tv

newtype Lock=Lock（TVar状态）
数据状态=锁定|解锁
newlock:：IO锁
newLocked=锁定newTVarIO锁定
newUnlocked:：IO锁
newUnlocked=锁定NewVario解锁
--|获得一把锁。
获取：：锁定->IO（）
获取（锁定电视）=原子$
readTVar tv>>=\case
锁定->重试
解锁->写变量电视锁定
--|试着弄一把锁。如果操作成功，
--返回'True'。
tryAcquire:：Lock->IO Bool
tryAcquire（锁定电视）=原子$
readTVar tv>>=\case
锁定->纯假
解锁->真实IO（）
释放（锁定电视）=原子$
readTVar tv>>=\case
解锁->throwSTM双重释放
锁定->WriteVar tv解锁
数据双重释放=双重释放派生显示
实例异常发布在哪里
displayException~DoubleRelease=“试图释放未锁定的锁。”
--|释放锁。如果
--锁没有锁。
释放幂等元：：锁定->IO（）
releaseEmponent（Lock tv）=原子级$writeTVar tv解锁
--|获取锁的状态。
已锁定：：锁定->IO状态
isLocked（锁定电视）=readTVarIO电视

acquire
/
release
对需要仔细的屏蔽和异常处理，就像primitive
MVar
操作一样。文档建议，但实际上并未说明STM操作在重试时是可中断的；假设这是真的，那么使用MVAR的
所使用的相同方法将在这里起作用。注意：我已经打开了一个文档，用于
重试
可中断性。
谢谢，非常有用！与Petr的解决方案相比，这有什么优势？如果您不想将锁作为函数参数传递。假设这个打印机函数经常通过代码库调用，那么少一个参数会使它看起来更像本机打印函数。