MVar Problem (Concurrent Hugs)

[Andreas Gruenbacher]

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
-----------------------------------------------

Hugs writes:

Main> main
Runnning...

Program error: no more threads (deadlock?)
(131 reductions, 307 cells)


Any ideas?

Thanks,
Andreas.

------------------------------------------------------------------------
 Andreas Gruenbacher                  gruenbacher@geoinfo.tuwien.ac.at
 Research Assistant                       Phone      +43(1)58801-12723
 Institute for Geoinformation             Fax        +43(1)58801-12799
 Technical University of Vienna           Cell phone   +43(664)4064789