[Haskell-cafe] TMVar's are great but fail under ghc 6.10.1 windows

[Bertram Felgenhauer]

Alberto G. Corona  wrote:
> however, It happens that fails in my windows box with ghc 6.10.1  , single
> core
> 
> here is the code and the results:
> 
> -----------begin code:
> module Main where
> 
> import Control.Concurrent.STM
> 
> import Control.Concurrent
> import System.IO.Unsafe
> import GHC.Conc
> 
> 
> 
> mtxs=  unsafePerformIO $ mapM newTMVarIO $ take 5 $ repeat  0
> 
> proc i= atomically $ do
>  unsafeIOToSTM $ putStr $ "init of process "++ show i++"\n"

As Sterling points out, unsafeIOToSTM is really unsafe. A fundamental
restriction is that the IO action used with unsafeIOToSTM may not block.
However, putStr may block.

It's actually possible to do the logging without blocking:

>>> cut here >>>
module Main where

import Control.Concurrent
import Control.Concurrent.STM
import GHC.Conc
import Control.Concurrent.MVar
import Data.IORef
import Control.Monad

data Logger = Logger (IORef [String]) (MVar ())

newLogger :: IO Logger
newLogger = do
    ref  <- newIORef []
    wake <- newEmptyMVar
    return $ Logger ref wake

logLogger :: Logger -> String -> IO ()
logLogger (Logger ref wake) msg = do
    atomicModifyIORef ref $ \msgs -> (msg:msgs, ())
    tryPutMVar wake ()
    return ()

dumpLogger :: Logger -> IO ()
dumpLogger (Logger ref wake) = forever $ do
    takeMVar wake
    msgs <- atomicModifyIORef ref $ \msgs -> ([], msgs)
    putStr $ unlines . reverse $ msgs

proc log mtxs i = do
 let logSTM = unsafeIOToSTM . log
 xs' <- atomically $ do
   logSTM $ "init of process " ++ show i
   xs <- mapM takeTMVar mtxs
   mapM (\(mtx, x) -> putTMVar mtx (x+1)) $ zip mtxs xs
   xs' <- mapM readTMVar mtxs
   logSTM $ "End of processs " ++ show i ++ " result = " ++ show xs'
   return xs'
 log $ "Final result of process " ++ show i ++ " = " ++ show xs'

main = do
  log <- newLogger
  forkIO $ dumpLogger log
  mtxs <- replicateM 5 $ newTMVarIO 0
  mapM (forkIO . proc (logLogger log) mtxs) [1..5]
  threadDelay 1000000
<<<

And that gives reasonable results, for example:

init of process 1
End of processs 1 result= [1,1,1,1,1]
Final result of process 1 = [1,1,1,1,1]
init of process 2
End of processs 2 result= [2,2,2,2,2]
Final result of process 2 = [2,2,2,2,2]
init of process 3
init of process 4
End of processs 4 result= [3,3,3,3,3]
Final result of process 4 = [3,3,3,3,3]
init of process 5
End of processs 5 result= [4,4,4,4,4]
Final result of process 5 = [4,4,4,4,4]
End of processs 3 result= [3,3,3,3,3]
init of process 3
End of processs 3 result= [5,5,5,5,5]
Final result of process 3 = [5,5,5,5,5]

HTH,

Bertram