Infinite loops can hang Concurrent Haskell
An infinite loop that does not allocate can hang Concurrent Haskell, becuase no thread switching occurs. Demo code below (from Koen Claessen). Bites occasionally, but not often. Simon module Main where import Control.Concurrent ( forkIO , threadDelay , killThread , newEmptyMVar , takeMVar , putMVar ) import Data.IORef import IO( hFlush, stdout ) timeout :: Int -> a -> IO (Maybe a) timeout n x = do put "Race starts ..." resV <- newEmptyMVar pidV <- newEmptyMVar let waitAndFail = do put "Waiting ..." threadDelay n put "Done waiting!" putMVar resV Nothing eval = do put "Evaluating ..." x `seq` put "Done!" putMVar resV (Just x) -- used "mfix" here before but got non-termination problems -- (not sure they had anything to do with mfix) pid1 <- forkIO $ do pid2 <- takeMVar pidV eval killThread pid2 pid2 <- forkIO $ do waitAndFail killThread pid1 putMVar pidV pid2 put "Blocking ..." takeMVar resV put s = do putStrLn s hFlush stdout main = do timeout 1 (sum (repeat 1)) <<< The above program produces the following (expected result): >>> Race starts ... Blocking ... Evaluating ... Waiting ... Done waiting! <<< If you replace 'sum (repeat 1)' by 'last (repeat 1)' the program hangs.