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, wagne...@seas.upenn.edu wrote:
> Quoting Jean-Marie Gaillourdet <j...@gaillourdet.net>:
>
>> 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
TypeRepEqLock.hs
Description: Binary data
TypeRepEq.hs
Description: Binary data
_______________________________________________ Glasgow-haskell-users mailing list Glasgow-haskell-users@haskell.org http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
