deadlock with race

[lehins]

This simple code results in a deadlock. Solution is to stick a yield inside the otherwise clause of the check function, but that's not always possible, since check can be pure function with a loop in it.

import Control.Concurrent.Async

someFunc :: IO ()
someFunc = do
  w <- pooledCheck 2
  if w == 2
    then putStrLn "Success"
    else putStrLn "Bug in implementation"

check :: Int -> Int -> IO Int
check step = go
  where go n | even n = return n
             | otherwise = go (n + step)

pooledCheck :: Int -> IO Int
pooledCheck step = do
  let f = check step
  either id id <$> race (f 1) (f 2)

Here is a repo that can be used to reproduce the issue: https://github.com/lehins/async-bug-repro running stack run should result in a deadlock

[simonmar]

Yes, this is a known limitation in GHC's concurrency implementation. The workaround is to use -fno-omit-yields.

[chrisdone]

@simonmar So, is this because normally there is a preemptive timer that is supposed to introduce yielding in non-allocating, non-I/O-doing threads? But -fomit-yields turns that off by default? Is that an efficiency trade-off?

[simonmar]

Not quite - GHC's concurrency implementation is quasi-cooperative, that is, threads must voluntarily yield to the scheduler. The voluntary nature is normally invisible to the programmer because it happens at every heap allocation, and those normally happen often enough for it to look like preemption. But if you happen to write a loop that runs for a long time without allocating any memory, it won't be preempted at all - indeed the GC won't be able to run, and all the other threads in the system will be blocked (even when using +RTS -N). The -fno-omit-yields flag inserts yield points in enough places that this can't happen, at the expense of some performance.

One thing we haven't done is try to optimise -fno-omit-yields to reduce the overhead, that would be a nice project for someone.

[chrisdone]

@simonmar Thanks for the explanation!