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

问题

When I test some simple cases about threaded codes,
I found some loop hang without hFlush stdout even it does not use any print things.

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"

This code hangs whether monitor sw and putStrLn "End" exist or not.

However, just uncomment hFlush stdout in wait, it works properly and ends.

This also happens with a code using 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

These two codes will run properly when running by runghc.

However, the codes below are not hanging without 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

I know that there are difference. But I couldn't find out why some codes hang.
Is stdout is related with handling thread?
Could you explain why the loops are hanging or not without hFlush stdout?

Additional:
1. I've tested this codes with GHC 7.10.2 {OS X, Windows}

回答1:

Most likely the compiler optimized the wait into non-allocating busy loop. Runtime system just doesn't have a chance to interrupt it to let the child thread to run. You can "fix" by adding any action that allocates or yields, e.g. hFlush or threadDelay. Also you can compile the code with -fno-omit-yields.

See also: https://ghc.haskell.org/trac/ghc/ticket/367 and https://ghc.haskell.org/trac/ghc/ticket/10639

来源：https://stackoverflow.com/questions/33311980/loop-thread-hangs-without-hflush-stdout-even-there-are-no-print-things

标签

multithreading

loops

haskell

hang