Haskell forkIO 线程使用 putStrLn 在彼此之上写入

Question

我正在使用以下代码玩 Haskell 轻量级线程 (forkIO)：

import Control.Concurrent

beginTest :: IO ()
beginTest = go
    where
    go = do
        putStrLn "Very interesting string"
        go
        return ()

main = do
    threadID1 <- forkIO $ beginTest
    threadID2 <- forkIO $ beginTest
    threadID3 <- forkIO $ beginTest
    threadID4 <- forkIO $ beginTest
    threadID5 <- forkIO $ beginTest

    let tID1 = show threadID1
    let tID2 = show threadID2
    let tID3 = show threadID3
    let tID4 = show threadID4
    let tID5 = show threadID5

    putStrLn "Main Thread"
    putStrLn $ tID1 ++ ", " ++ tID2 ++ ", " ++ tID3 ++ ", " ++ tID4 ++ ", " ++ tID5
    getLine
    putStrLn "Done"

现在预期的输出将是一大堆这些：

Very interesting string
Very interesting string
Very interesting string
Very interesting string

其中某处有一个：

Main Thread

然而，输出（或者前几行）结果是这样的：

Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very interesting string
Very VVVViMeeeenarrrrtiyyyyen    r iiiieTnnnnshtttttreeeeierrrrnaeeeegdssss 
ttttsiiiitTnnnnrhggggir    nessssgatttt
drrrrIiiiiVdnnnne ggggr5



y1 ,VVVVi eeeenTrrrrthyyyyer    reiiiieannnnsdtttttIeeeeidrrrrn eeeeg5ssss 2tttts,iiiit nnnnrTggggih    nrssssgetttt
arrrrdiiiiVInnnnedggggr 



y5 3VVVVi,eeeen rrrrtTyyyyeh    rriiiieennnnsatttttdeeeeiIrrrrndeeeeg ssss 5tttts4iiiit,nnnnr ggggiT    nhssssgrtttt
errrraiiiiVdnnnneIggggrd



y  5VVVVi5eeeen
rrrrtyyyye    riiiiennnnsttttteeeeirrrrneeeegssss ttttsiiiitnnnnrggggi    nssssgtttt
rrrriiiiVnnnneggggr



y VVVVieeeenrrrrtyyyye    riiiiennnnsttttteeeeirrrrneeeegssss ttttsiiiitnnnnrggggi    nssssgtttt
rrrriiiiVnnnneggggr

文本每隔几行就会移动，尽管很明显 Very interesting string 最终会彼此重叠，因为不知何故同时使用 putStrLn 的线程最终会写入到彼此之上的标准输出。为什么会这样，如何（不借助消息传递、计时或其他一些过于复杂和令人费解的解决方案）克服它？

Answer 1

简单的说，putStrLn不是原子操作。每个字符都可以与来自不同线程的任何其他字符交错。

（我也不确定在 UTF8 等多字节编码中是否保证多字节字符被原子处理。）

如果你想要原子性，你可以使用共享互斥体，例如

do lock <- newMVar ()
   let atomicPutStrLn str = takeMVar lock >> putStrLn str >> putMVar lock ()
   forkIO $ forever (atomicPutStrLn "hello")
   forkIO $ forever (atomicPutStrLn "world")

正如下面评论中所建议的，我们还可以简化并使上述异常安全，如下所示：

do lock <- newMVar ()
   let atomicPutStrLn str = withMVar lock (\_ -> putStrLn str)
   forkIO $ forever (atomicPutStrLn "hello")
   forkIO $ forever (atomicPutStrLn "world")

Answer 2

使用全局锁的版本。

import Control.Concurrent.MVar  (newMVar, takeMVar, putMVar, MVar)
import System.IO.Unsafe (unsafePerformIO)


{-# NOINLINE lock #-}
lock :: MVar ()
lock = unsafePerformIO $ newMVar ()

printer :: String -> IO ()
printer x= do
   () <- takeMVar lock
   let atomicPutStrLn str =  putStrLn str >> putMVar lock ()
   atomicPutStrLn x

Haskell forkIO 线程使用 putStrLn 在彼此之上写入

Haskell forkIO threads writing on top of each other with putStrLn

io

concurrency

multithreading

haskell

stdout