unsafePerformIO in threaded applications does not work

Below is the source of a sample program:

When I run it from ghci both printJob and printJob2 run fine and write ten lines into a text file.

But when compiled with -threaded flag, the program writes only one line.

I have ghc 7.0.3 on ArchLinux

Here's the compile command:

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

What am I am doing wrong ? Why it does not work in threaded mode ?

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))

EDIT: hammar pointed out that if main application exits earlier than all spawned threads, then they will be killed and suggested to add a delay at the end of main. I did and as he predicted, it works.

The problem is that your main thread finishes too soon, and when the main thread of a Haskell program finishes, all other threads get killed automatically. Depending on how the threads get scheduled, this might happen before any of the threads have had a chance to run at all.

A quick and dirty solution is to simply add a threadDelay at the end of main, though a more robust method would be to use a synchronization primitive like an MVar to signal when it's OK for the main thread to finish.

For example:

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