multithreading - 线程应用程序中的unsafePerformIO无法正常工作

Question

以下是示例程序的来源:

当我从ghci运行它时，printJob和printJob2都可以正常运行并将十行写入文本文件。

但是，当使用-threaded标志进行编译时，该程序仅写一行。

我在ArchLinux上拥有ghc 7.0.3

这是编译命令:

ghc -threaded -Wall -O2 -rtsopts -with-rtsopts=-N -o testmvar testmvar.hs

我做错了什么？为什么它在线程模式下不起作用？

import Control.Concurrent.MVar
import Control.Concurrent (forkIO)
import Control.Exception (bracket)
import Control.Monad (forM_)
import System.IO.Unsafe (unsafePerformIO)
import System.IO (hPutStrLn, stderr)


{-# NOINLINE p #-}
p :: MVar Int
p = unsafePerformIO $ newMVar (1::Int)


{-# NOINLINE printJob #-}
printJob x = bracket (takeMVar p) (putMVar p . (+ 1))
                   (\a -> do
                       appendFile "mvarlog.txt" $ "Input: " ++ x ++ "; Counter: " ++ show a ++ "\n"
                       )


{-# NOINLINE printJob2 #-}
printJob2 = unsafePerformIO $ do
   p2 <- newEmptyMVar
   return $ (\x -> bracket (putMVar p2 True) (\_ -> takeMVar p2)
                   (\_ -> do
                       appendFile "mvarlog.txt" $ "preformed " ++ x ++ "\n"
                   ))

main = do
  forM_ [1..10]
    (\x -> forkIO $ printJob (show x))

编辑:hammar指出，如果主应用程序比所有产生的线程更早退出，那么它们将被杀死并建议在主线程末尾添加一个延迟。
我做到了，而且正如他预言的那样，它奏效了。

Answer 1

问题是您的主线程完成得太早，并且当Haskell程序的主线程完成时，所有其他线程都会自动终止。根据线程的调度方式，这可能在任何线程都没有机会运行之前发生。

一个快速而肮脏的解决方案是在threadDelay的末尾简单地添加一个main，尽管更健壮的方法是使用一个像MVar这样的同步原语来表示何时可以完成主线程。

例如:

main = do
  vars <- forM [1..10] $ \x -> do
    done <- newEmptyMVar -- Each thread gets an MVar to signal when it's done
    forkIO $ printJob (show x) >> putMVar done ()
    return done

  -- Wait for all threads to finish before exiting
  mapM_ takeMVar vars