即使没有 `print` 东西,循环线程也会在没有 `hFlush stdout` 的情况下挂起

Loop thread hangs without `hFlush stdout` even there are no `print` things

当我测试一些关于线程代码的简单案例时,
我发现一些 loop 在没有 hFlush stdout 的情况下挂起,即使它不使用任何 print 东西。

import Control.Concurrent

import System.IO
import Data.IORef

delay :: Int -> IO ()
delay = threadDelay . (* 1000000)

wait sw = loop
  where
    loop = do
      v <- readIORef sw
      --hFlush stdout -- without this, hang
      if v
        then return()
        else loop

monitor sw = forkIO $ loop
  where
    loop = do
      v <- readIORef sw
      print v
      delay 1
      loop

main = do
  sw <- newIORef False
  forkIO $ do
    delay 4
    writeIORef sw True
  monitor sw
  wait sw
  --putStrLn "End"

无论 monitor swputStrLn "End" 是否存在,此代码都会挂起。

不过,只要在wait取消对hFlush stdout的注释,它就可以正常运行并结束。

使用 MVar 的代码也会发生这种情况。

import Control.Concurrent
import Control.Concurrent.MVar
import System.IO

delay :: Int -> IO ()
delay = threadDelay . (* 1000000)

wait :: MVar Bool -> IO ()
wait sw = loop
  where loop = do
          v <- readMVar sw
          hFlush stdout -- without this, hangs
          if v
            then return ()
            else loop

main :: IO ()
main = do
  sw <- newMVar False
  forkIO $ do
    delay 4
    modifyMVar_ sw (\_ -> return True)
  wait sw

当运行被runghc宁时,这两个代码将运行正确。

但是,下面的代码没有hFlush stdout就不会挂了。

import Control.Concurrent
import Control.Concurrent.MVar
import System.IO

delay :: Int -> IO ()
delay = threadDelay . (* 1000000)

wait :: MVar Bool -> IO ()
wait sw = loop
  where loop = do
          v <- readMVar sw
          if v
            then return ()
            else loop

main :: IO ()
main = do
  sw <- newEmptyMVar
  forkIO $ do
    delay 4
    putMVar sw True
  wait sw

import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import System.IO

delay :: Int -> IO ()
delay = threadDelay . (* 1000000)

wait :: TVar Bool -> IO ()
wait sw = atomically $ do
            v <- readTVar sw
            unless v retry

main :: IO ()
main = do
  sw <- newTVarIO False
  forkIO $ do
    delay 4
    atomically $ writeTVar sw True
  wait sw

我知道有区别。但是我找不到为什么有些代码挂起
stdout与处理线程有关吗?
你能解释一下 为什么循环在没有 hFlush stdout 的情况下挂起或不挂起吗?

附加:
1. 我用 GHC 7.10.2 {OS X, Windows}

测试了这段代码

很可能编译器将 wait 优化为非分配繁忙循环。运行时系统只是没有机会中断它让子线程运行。您可以 "fix" 通过添加任何分配或产生的操作,例如hFlushthreadDelay。您也可以使用 -fno-omit-yields.

编译代码

另请参阅:https://ghc.haskell.org/trac/ghc/ticket/367 and https://ghc.haskell.org/trac/ghc/ticket/10639