TMQueue vs Chan

Main.hs

module Main where

import Control.Applicative
import Control.Concurrent (yield)
import Control.Concurrent.Async
import Control.Concurrent.Chan
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TMQueue
import Control.Monad (replicateM, forM_, forever)
import Data.Function (fix)
import Data.Maybe (catMaybes)
import System.IO (withFile, IOMode(..), hPutStrLn, hGetLine)
import System.IO.Error (catchIOError)

input  = "data.dat"
output = "out.dat"
batch = 100 :: Int

useTMQueue = do
  q <- atomically newTMQueue
  thread <- async $ do
    withFile output WriteMode $ \fh -> fix $ \loop -> do
      items <- catMaybes <$> replicateM batch (atomically $ readTMQueue q)
      forM_ items $ hPutStrLn fh
      if length items < batch
        then return ()
        else loop

  withFile input ReadMode $ \fh ->
    (forever $ hGetLine fh >>= atomically . writeTMQueue q)
    `catchIOError` const (atomically (closeTMQueue q) >> putStrLn "Done")

  wait thread

useChan = do
  q <- newChan
  thread <- async $ withFile output WriteMode $ \fh ->
    fix $ \loop -> do
      items <- catMaybes <$> replicateM batch (readChan q)
      forM_ items $ hPutStrLn fh
      if length items < batch
        then return ()
        else loop

  withFile input ReadMode $ \fh ->
    (forever $ hGetLine fh >>= writeChan q . Just)
    `catchIOError` const (writeChan q Nothing >> putStrLn "Done")

  wait thread

main = useTMQueue

When built without -threaded, the TMQueue version is about 2x as fast as Chan, but with -threaded, the results are almost exactly the opposite! Why?

To get data.dat: writeFile "out.dat" $ unlines (map show [1.10000000])