Very slow STM (observed in async package)
## Summary
Benjamin M. on Discourse found an unexpectedly slow program that uses the `async` package:
https://discourse.haskell.org/t/help-haskell-async-behavior-i-dont-understand/12061?u=jaror
Essentially, this program races a few thousand tasks and waits for the first one to finish.
## Steps to reproduce
Inlining all definitions from `async` and `stm` (I've removed some exception handling stuff, but it still reproduces the problem), we get this reproducer:
```haskell
{-# OPTIONS_GHC -threaded -O2 #-}
import GHC.Conc
forever :: IO String
forever = delay 10 >> forever
terminates :: IO String
terminates = delay 1 >> pure "terminates"
delay s = threadDelay (1000000 * s)
async :: IO a -> IO (STM a)
async a = do
var <- atomically (newTVar Nothing)
forkIO (a >>= atomically . writeTVar var . Just)
pure (readTVar var >>= maybe retry pure)
main :: IO ()
main = do
x <- mapM async $ terminates : replicate 2000 forever
r <- atomically (foldr1 orElse x)
print r
```
## Expected behavior
It should take about 1 second to terminate (plus a bit of overhead), but instead it takes more than 5 seconds.
## Environment
* GHC version used: 9.6.6
Optional:
* Operating System: NixOS
* System Architecture: X86_64
issue