Concurrent Haskell bug?

[Daniel McNeill]

{-
Hi,

Possible Concurrent Haskell bug

Here is an attempt at concurrent, data-driven assertions for Haskell.
The code has been simplified to just work for type Char:
-}

import Concurrent
import IOExts(unsafePerformIO)

assert :: (Char -> Bool) -> Char -> Char
assert p x    = unsafePerformIO $ do
            mv <- newEmptyMVar
            forkIO $ check p (listen mv)
            return (demand mv x)

check :: (a -> Bool) -> a -> IO ()
check p x
  | p x        = return ()
  | otherwise    = putStrLn "Assertion failed!"


demand :: MVar Char -> Char -> Char
demand mv c = unsafePerformIO $ do putMVar mv c; yield; return c

listen :: MVar Char -> Char
listen mv = unsafePerformIO $ takeMVar mv


main :: IO ()
main = putChar (assert (isLower) 'z')

{-

When main is evaluated, it causes evaluation of assert, which returns
the data it was called on, but also forks a "check" IO action to check
predicate p on the data.

This check is synchronised using "listen" which waits on an MVar into which
the data will be placed when available. The data is placed here by 
evaluation
of "demand" (which is returned by assert). Demand yields after putting the
data, to allow the check to be carried out before computation is continued.

In this example, the data is immediately available so the result should
simply be 'z'. However, the actual output is:

Thread raised exception: no more threads (deadlock?)

which must then be interrupted with Ctrl-C.


If listen is replaced with the following version, the printout 
"takeMVar: 'z'"
occurs after the message about the exception, but execution still halts.

listen mv = unsafePerformIO $ do val <- takeMVar mv
                 putStrLn ("takeMVar: " ++ show val)
                 return val

I've tried the code in GHC and it works fine.

Any ideas?

Cheers,
Dan
-}