为什么 readIORef 是阻塞操作

How come `readIORef` is a blocking operation

这对我来说完全是个惊喜。当 atomicModifyIORef 正在飞行时,有人可以解释 readIORef 阻塞背后的原因是什么吗?我知道假设是提供给后一个函数的修改函数应该非常快,但这不是重点。

这是一段再现我所说内容的示例代码:

{-# LANGUAGE NumericUnderscores #-}
module Main where

import Control.Concurrent
import Control.Concurrent.Async
import Control.Monad
import Data.IORef
import Say (sayString)
import Data.Time.Clock
import System.IO.Unsafe

main :: IO ()
main = do
  ref <- newIORef (10 :: Int)
  before <- getCurrentTime
  race_ (threadBusy ref 10_000_000) (threadBlock ref)
  after <- getCurrentTime
  sayString $ "Elapsed: " ++ show (diffUTCTime after before)


threadBlock :: IORef Int -> IO ()
threadBlock ref = do
  sayString "Below threads are totally blocked on a busy IORef"
  race_ (forever $ sayString "readIORef: Wating ..." >> threadDelay 500_000) $ do
    -- need to give a bit of time to ensure ref is set to busy by another thread
    threadDelay 100_000
    x <- readIORef ref
    sayString $ "Unblocked with value: " ++ show x


threadBusy :: IORef Int -> Int -> IO ()
threadBusy ref n = do
  sayString $ "Setting IORef to busy for " ++ show n ++ " μs"
  y <- atomicModifyIORef' ref (\x -> unsafePerformIO (threadDelay n) `seq` (x * 10000, x))
  -- threadDelay is not required above, a simple busy loop that takes a while works just as well
  sayString $ "Finished blocking the IORef, returned with value: " ++ show y

运行 这段代码产生:

$ stack exec --package time --package async --package say --force-dirty --resolver nightly -- ghc -O2 -threaded atomic-ref.hs && ./atomic-ref
Setting IORef to busy for 10000000 μs
Below threads are totally blocked on a busy IORef
readIORef: Wating ...
Unblocked with value: 100000
readIORef: Wating ...
Finished blocking the IORef, returned with value: 10
Elapsed: 10.003357215s

注意 readIORef: Wating ... 只打印两次,一次在阻塞之前,一次在阻塞之后。这是非常出乎意料的,因为它是在完全独立的线程中运行的操作。这意味着 IORef 上的阻塞会影响调用 readIORef 的线程以外的其他线程,这更令人惊讶。

这些语义是预期的,还是一个错误?我适合不是错误,为什么这是预期的?稍后我会打开一个 ghc bug,除非有人对我想不到的这种行为有解释。我不会对这是 ghc 运行时的一些限制感到惊讶,在这种情况下我稍后会在这里提供答案。无论结果如何,了解这种行为都非常有用。

编辑 1

我试过的不需要unsafePerformIO的忙循环在评论中被要求,所以这里是

threadBusy :: IORef Int -> Int -> IO ()
threadBusy ref n = do
  sayString $ "Setting IORef to busy for " ++ show n ++ " μs"
  y <- atomicModifyIORef ref (\x -> busyLoop 10000000000 `seq` (x * 10000, x))
  sayString $ "Finished blocking the IORef, returned with value: " ++ show y

busyLoop :: Int -> Int
busyLoop n = go 1 0
  where
    go acc i
      | i < n = go (i `xor` acc) (i + 1)
      | otherwise = acc

结果完全一样,只是运行时间略有不同。

Setting IORef to busy for 10000000 μs
Below threads are totally blocked on a busy IORef
readIORef: Wating ...
Unblocked with value: 100000
readIORef: Wating ...
Finished blocking the IORef, returned with value: 10
Elapsed: 8.545412986s

编辑 2

原来是sayString没有输出不出现的原因。这是 sayString 换成 putStrLn 时的结果:

Below threads are totally blocked on a busy IORef
Setting IORef to busy for 10000000 μs
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
readIORef: Wating ...
Finished blocking the IORef, returned with value: 10
Unblocked with value: 100000
Elapsed: 10.002272691s

这仍然没有回答问题,为什么 readIORef 阻止。事实上,我只是偶然发现了 Samuli Thomasson 在一本书 "Haskell High Performance" 中的一句话,它告诉我们不应发生阻塞:

我想我明白现在发生了什么。 TLDR,readIORef 不是阻塞操作!非常感谢所有对此问题发表评论的人。

我在心理上分解逻辑的方式是(与问题相同,但添加了线程名称):


threadBlock :: IORef Int -> IO ()
threadBlock ref = do
  race_ ({- Thread C -} forever $ sayString "readIORef: Wating ..." >> threadDelay 500_000) $ do
    {- Thread B -}
    threadDelay 100_000
    x <- readIORef ref
    sayString $ "Unblocked with value: " ++ show x

threadBusy :: IORef Int -> Int -> IO ()
threadBusy ref n = do {- Thread A -}
  sayString $ "Setting IORef to busy for " ++ show n ++ " μs"
  y <- atomicModifyIORef' ref (\x -> unsafePerformIO (threadDelay n) `seq` (x * 10000, x))
  sayString $ "Finished blocking the IORef, returned with value: " ++ show y
  • 线程 A 使用一个 thunk 更新 ref 的内容,该 thunk 将在计算完成后填充 unsafePerformIO (threadDelay n) `seq` (x * 10000, x)。重要的部分是因为 atomicModifyIORef' 很可能是用 CAS(比较和交换)实现的并且交换成功,因为预期值匹配并且新值已使用尚未评估的 thunk 更新。因为 atomicModifyIORef' 是严格的,所以它必须等到值被计算出来,这将需要 10 秒才能返回。所以线程 A 阻塞了。
  • 线程 B 使用 readIORefref 读取 thunk,但没有阻塞。现在,一旦尝试打印 thunk x 的新内容,它就必须停止并等待直到它被一个值填充,该值仍在计算过程中。因此它必须等待,因此它看起来像被阻止了。
  • 线程 C 应该每 0.5 秒用 sayString 打印一条消息,但它没有这样做,因此表现得也被阻止了。快速看一下 say 包和 GHC.IO.Handle 它看起来像 Handle for stdout 被线程 B 阻塞了,因为在 say 包中打印应该没有发生交错,因此线程 C 也无法进行任何打印,因此它看起来也被阻塞了。这就是为什么切换到 putStrLn 解锁线程 C 并允许它每 0.5 秒打印一条消息。

这绝对让我信服,但如果有人有更好的解释,我会很乐意接受另一个答案。