MVar Problem (Concurrent Hugs)

[Dean Herington]

Andreas Gruenbacher wrote:

> Hello,
>
> I was trying to write an abstraction for bidirectional communication
> between two threads. For some reason, MVars seem to break:
>
> -----------------------------------------------
> class Cords c t u where
>     newCord :: IO (c t u)
>     listen :: c t u -> IO t
>     speak :: c t u -> u -> IO ()
>
> data Cord t u = Cord (IO (MVar t)) (IO (MVar u))
>
> instance Cords Cord t u where
>     newCord = return (Cord newEmptyMVar newEmptyMVar)
>     speak (Cord _ s) t = do s' <- s ; putMVar s' t
>     listen (Cord h s) = do h' <- h ; takeMVar h'
>
> otherEnd (Cord t u) = Cord u t
>
> showT :: Cord Int String -> IO ()
> showT cord = do
>     putStrLn "Runnning..."
>     x <- listen cord
>     putStrLn ("Heard " ++ show x)
>     speak cord (show x)
>     putStr ("Said " ++ (show x))
>     showT cord
>
> main :: IO ()
> main = do
>     cord <- newCord
>     forkIO (showT (otherEnd cord))
>     speak cord 1
>     str <- listen cord
>     putStrLn str
> -----------------------------------------------

You are creating a new MVar with each listen and speak.  As a result, the
two threads never agree on an MVar, so deadlock occurs.  Instead, you should
create the pair of MVars in newCord.  Try the code below.

> import Concurrent

> class Cords c t u where
>     newCord :: IO (c t u)
>     listen :: c t u -> IO t
>     speak :: c t u -> u -> IO ()

> data Cord t u = Cord (MVar t) (MVar u)

> instance Cords Cord t u where
>     newCord = do t <- newEmptyMVar
>                  u <- newEmptyMVar
>                  return (Cord t u)
>     listen (Cord t _) = takeMVar t
>     speak (Cord _ u) s = putMVar u s

> otherEnd (Cord t u) = Cord u t

> showT :: Cord Int String -> IO ()
> showT cord = do
>     putStrLn "Runnning..."
>     x <- listen cord
>     putStrLn ("Heard " ++ show x)
>     speak cord (show x)
>     putStrLn ("Said " ++ show x)
>     showT cord

> main :: IO ()
> main = do
>     cord <- newCord
>     forkIO (showT (otherEnd cord))
>     speak cord 1
>     str <- listen cord
>     putStrLn str


Dean