为什么`readIORef` 是一个阻塞操作

Question

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

这是一段示例代码，它重现了我所说的内容：

{-# 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 ...它只打印两次，一次在阻塞之前，一次在阻塞之后。这是非常出乎意料的，因为它是在完全独立的线程中运行的操作。这意味着阻塞 onIORef会影响调用的线程之外的其他线程readIORef，这更令人惊讶。

这些语义是预期的，还是一个错误？我适合不是错误，为什么这是预期的？稍后我会打开一个 ghc 错误，除非有人对这种行为有我想不到的解释。我不会对这是 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是没有输出没有出现的原因。下面是 out 是什么时候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》一书中的一句话，它告诉我们不应该发生阻塞：

Answer 1

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

\n\n

我在心理上分解逻辑的方式是（与问题相同，但添加了线程名称）：

\n\n

\nthreadBlock :: IORef Int -> IO ()\nthreadBlock ref = do\n  race_ ({- Thread C -} forever $ sayString "readIORef: Wating ..." >> threadDelay 500_000) $ do\n    {- Thread B -}\n    threadDelay 100_000\n    x <- readIORef ref\n    sayString $ "Unblocked with value: " ++ show x\n\nthreadBusy :: IORef Int -> Int -> IO ()\nthreadBusy ref n = do {- Thread A -}\n  sayString $ "Setting IORef to busy for " ++ show n ++ " \xce\xbcs"\n  y <- atomicModifyIORef\' ref (\\x -> unsafePerformIO (threadDelay n) `seq` (x * 10000, x))\n  sayString $ "Finished blocking the IORef, returned with value: " ++ show y\n

\n\n

\n
• 线程 A 使用 thunk 更新 a 的内容，ref该计算完成后将填充该 thunk unsafePerformIO (threadDelay n) `seq` (x * 10000, x)。重要的是，因为atomicModifyIORef\'很可能是用 CAS（比较和交换）实现的，并且交换成功，因为预期值匹配，并且新值已使用尚未评估的 thunk 进行了更新。因为atomicModifyIORef\'它是严格的，所以必须等到计算出值，这将需要 10 秒才能返回。所以线程A会阻塞。
\n
• ref线程 B 从with读取 thunk，而readIORef不会阻塞。现在，一旦尝试打印 thunk 的新内容，x它就必须停止并等待，直到它填充了一个仍在计算过程中的值。因此它必须等待，因此看起来像是被阻塞了。
\n
• 线程 C 应该每 0.5 秒打印一条消息sayString，但它没有这样做，因此表现得也被阻止了。从快速查看say包来看， forGHC.IO.Handle似乎被线程 B 阻塞，因为包中的打印应该在没有交错的情况下进行，因此线程 C 也无法执行任何打印，因此看起来它也被阻塞了。这就是为什么切换到未阻塞的线程 C 并允许它每 0.5 秒打印一条消息。HandlestdoutsayputStrLn
\n

\n\n

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

\n