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