Faster concurrently

[basvandijk]

trafficstars

I was wondering if the following implementation of concurrently has been considered before:

concurrently :: IO a -> IO b -> IO (a,b)
concurrently left right = do
  mv <- newEmptyMVar
  myTid <- myThreadId
  mask $ \restore -> do
    tid <- forkIO $
             (restore right `catchAll`
                (\e -> throwTo myTid e >> return undefined)) >>= putMVar mv
    l <- restore left `onException` killThread tid
    r <- takeMVar mv
    return (l, r)

This implementation forks one thread instead of two.

It's 50% faster than the current concurrently in the concasync benchmark.

I expect to also see a significant efficiency boost of the traverse method of Concurrently which is used by mapConcurrently. Currently mapConcurrently forks 2n threads for a list of lengh n. Using this concurrently it only forks n threads.

The only thing I'm not yet sure about (and the reason I haven't created a pull request yet) is what happens when both left and right throw an exception.

[simonmar]

It is tempting. One small difference in behaviour with this version is when the current thread receives an async exception from another thread: with your version, left will get the thrown exception whereas right will get ThreadKilled. In the current version, both threads get ThreadKilled. Probably most applications don't care, but the asymmetry worries me.

[basvandijk]

Arguably what makes most sense is that when an asynchronous exception gets thrown to one of the threads then it should also be thrown to the other. So what about:

concurrently :: IO a -> IO b -> IO (a,b)
concurrently left right = do
  mv <- newEmptyMVar
  myTid <- myThreadId
  mask $ \restore -> do
    tid <- forkIO $
             (restore right `catchAll`
                (\e -> throwTo myTid e >> return undefined)) >>= putMVar mv
    l <- restore left `catchAll` (\e -> throwTo tid e >> throwIO e)
    r <- takeMVar mv
    return (l, r)

[basvandijk]

There's some common code that can be abstracted:

concurrently :: IO a -> IO b -> IO (a,b)
concurrently left right = do
  mv <- newEmptyMVar
  myTid <- myThreadId
  mask $ \restore -> do
    tid <- forkIO $ restore right `throwAllExceptionsTo` myTid >>= putMVar mv
    l <- restore left `throwAllExceptionsTo` tid
    r <- takeMVar mv
    return (l, r)
  where
    m `throwAllExceptionsTo` tid = m `catchAll` (\e -> throwTo tid e >> throwIO e)

[simonmar]

The remaining problem is that this still doesn't match the spec, namely

concurrently left right =
  withAsync left $ \a ->
  withAsync right $ \b ->
  waitBoth a b

and I rather like this as a definition. We don't want to change withAsync so that it throws the exception to the child thread, because then synchronous exceptions raised in the parent thread will also get thrown to the child, and I don't think that's the behaviour we want. On the other hand, an asynchronous exception thrown from another thread should arguably be thrown to the whole tree of threads, which is what your version of concurrently does.

So as it stands I can't accept your version of concurrently: although I agree the semantics is reasonable, it doesn't match the existing specification of concurrently, and we can't easily make it do so.

[basvandijk]

So as it stands I can't accept your version of concurrently: although I agree the semantics is reasonable, it doesn't match the existing specification of concurrently, and we can't easily make it do so.

Agreed, I will close the issue. It's just unfortunate that the current version is so much slower than my version. If this becomes an issue in the future we might consider adding this function besides the existing function.

[simonmar]

I've been thinking about this, and I'd really like to have the more efficient concurrently. Suppose withAsync was changed so that if it catches an AsyncException then it propagates it to the child thread, otherwise it uses cancel as before. Then I think we could justify using the more efficient concurrently, which has the same behaviour as the version using withAsync so long as people only use throwTo with AsyncExceptions.

[basvandijk]

What if we just change the spec to:

concurrently left right =
  withAsync left $ \a ->
  withAsync right $ \b ->
  link2 a b
  waitBoth a b

that has the same semantics as my faster concurrently right?

[basvandijk]

Hi Simon, what do you think about my patch?

[simonmar]

I've been trying to put my finger on what I'm uneasy about here. I think it is this: I don't like synchronous exceptions (e.g. IOException) being re-thrown asynchronously in another thread. It's ok in the case of wait where we are synchronously waiting for the result, but in link2 we aren't. If we throw an exception asynchronously, it should be an asynchronous exception. Perhaps the type of throwTo should be

throwTo :: AsyncException e => ThreadId -> e -> IO ()

[simonmar]

Here's what I want to do instead:

• change the behaviour of withAsync: if it catches an AsyncException, then throw it to the async thread, but otherwise cancel the async thread. Update the docs to say this.
• keep the existing spec for concurrently (ie. don't add link2)
• implement concurrently the fast way, but matching the new spec.

feel free to submit a pull request to do this, otherwise I'll try to get around to it sometime...

[snoyberg]

Recommendation: instead of catching just an AsyncException, check if the type casts to SomeAsyncException, e.g.:

isAsyncException :: Exception e => e -> Bool
isAsyncException e =
    case fromException (toException e) of
        Just (SomeAsyncException _) -> True
        Nothing -> False

This requires base 4.7 or later. If support for earlier base is desired, I'd say use CPP to provide a fallback to just using AsyncException, or consider using a much more exhaustive test such as:

https://www.stackage.org/haddock/lts-6.4/unexceptionalio-0.3.0/src/UnexceptionalIO.html#syncIO

Though looking at that source, I'm not convinced that list is correct.

[simonmar]

Yes, I'd pretty much decided to do that, just hadn't got around to it.

[basvandijk]

Yes, I also do that in #21.