Re: Is this a concurrency bug in base?

12 Oct 2011

      Hi, 

I've continued my search for a proper workaround. Again, I did find some unexpected results. See below.

On 09.10.2011, at 17:56, wagnerdm@seas.upenn.edu wrote:
...
Quoting Jean-Marie Gaillourdet :
...
That sounds plausible. Do you see any workaround? Perhaps repeatedly evaluating typeOf?
If there's a concurrency bug, surely the workaround is to protect calls to the non-thread-safe function with a lock.
typeOfWorkaround lock v = do
     () <- takeMVar lock
     x <- evaluate (typeOf v)
     putMVar lock ()
     return x
~d
This is my previous program with your workaround, it is also attached as TypeRepEqLock.hs

import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Typeable
import System.IO.Unsafe

main :: IO ()
main =
do { fin1 <- newEmptyMVar
  ; fin2 <- newEmptyMVar

  ; forkIO $ typeOf' () >>= putMVar fin1 
  ; forkIO $ typeOf' () >>= putMVar fin2 

  ; t1 <- takeMVar fin1
  ; t2 <- takeMVar fin2
  ; if (t1 /= t2)
      then putStrLn $ "typeOf " ++ show t1 ++ " /= typeOf " ++ show t2
      else putStrLn "Ok"
  }

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

-- Ugly workaround to http://hackage.haskell.org/trac/ghc/ticket/5540
typeOf' :: Typeable a => a -> IO TypeRep
typeOf' x =
do { () <- takeMVar lock
  ; t <- evaluate $ typeOf x
  ; putMVar lock ()
  ; return t
  }

Compile and execute:

$ ghc-7.0.3 -threaded -rtsopts TypeRepEqLock.hs
<snip>
$ while true ; do ./TypeRepEqLock +RTS -N ; done
Ok
Ok
Ok
Ok
Ok
Ok
Ok
Ok
Ok
TypeRepEqLock: thread blocked indefinitely in an MVar operation
Ok
Ok
Ok
^C^C

I'm sorry but I don't see how this program could ever deadlock, unless there is some more locking in typeOf and (==) on TypeReps. 

On the other side, my admittedly ugly workaround works fine for hours and hours.

import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Typeable

main :: IO ()
main =
do { fin1 <- newEmptyMVar
  ; fin2 <- newEmptyMVar

  ; forkIO $ return (typeOf' ()) >>= evaluate >>= putMVar fin1 
  ; forkIO $ return (typeOf' ()) >>= evaluate >>= putMVar fin2 

  ; t1 <- takeMVar fin1
  ; t2 <- takeMVar fin2
  ; if (t1 /= t2)
      then putStrLn $ "typeOf " ++ show t1 ++ " /= typeOf " ++ show t2
      else putStrLn "Ok"
  }

typeOf' val
  | t1 == t2 = t1
  | otherwise = typeOf' val
where
  t1 = typeOf'' val
  t2 = typeOf''' val
{-# NOINLINE typeOf' #-}

typeOf'' x = typeOf x
{-# NOINLINE typeOf'' #-}
typeOf''' x = typeOf x
{-# NOINLINE typeOf''' #-}

$ ghc-7.0.3 -threaded -rtsopts TypeRepEq.hs
<snip>
$ while true ; do ./TypeRepEq +RTS -N ; done
Ok
Ok
Ok
Ok
Ok
Ok
…

Any hints how to avoid the "thread blocked indefinitely in an MVar operation" exception?

Cheers,
Jean