9

下面的程序创建了两个并发运行的线程，每个线程随机休眠一段时间，然后将一行文本打印到标准输出。

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 应该擅长的那种事情，但是所有的 STM 事务都必须有STM asome的类型a，而打印到屏幕上的动作有 type IO a，而且似乎没有办法嵌入IO到STM中。

4

5 回答 5

14

使用 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 ()
于 2013-12-31T10:50:14.247 回答
6

使用 . 无法锁定您所描述的方式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 语言报告的一部分（特别是，它依赖于全局变量与非多态类型在程序执行期间最多评估一次）。

于 2013-12-31T09:17:42.757 回答
4

根据Petr Pudlák 的回答进行的一些研究表明，在concurrent-extra包中有一个模块Control.Concurrent.Lock ，它提供了基于 - 的锁的抽象。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 ()
于 2013-12-31T09:57:23.833 回答
1

这是 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 ()
于 2020-12-02T12:28:45.773 回答
1

如果你愿意，你实际上可以使用 STM 来实现一个锁，尽管 anMVar几乎肯定会表现得更好。

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

acquire/release对需要仔细的屏蔽和异常处理，就像原始MVar操作一样。文档建议但实际上并未说明 STM 操作在以下情况下是可中断的retry；假设这是真的，withMVar这里使用的方法相同。注意：我已经打开了GHC 票证来记录可retry中断性。

于 2020-12-03T18:16:29.543 回答