¿Hay alguna forma de aumentar un intervalo de tiempo, en base al cual el RTS decide que el hilo se ha bloqueado indefinidamente en una transacción STM? Aquí está mi código:

import Control.Concurrent (ThreadId)
import Control.Concurrent.MVar (MVar,newMVar,withMVar)
import Control.Concurrent.STM
import qualified Control.Concurrent.ThreadManager as TM

data ThreadManager = ThreadManager { tmCounter::TVar Int, tmTM::MVar TM.ThreadManager }

data Settings = Settings {
    maxThreadsCount::Int }

createThreadManager :: Settings -> IO ThreadManager
createThreadManager s = do
    counter <- atomically $ newTVar (maxThreadsCount s)
    tm <- TM.make >>= newMVar
    return $ ThreadManager counter tm

forkManaged :: ThreadManager -> IO () -> IO ThreadId
forkManaged tm fn = do
    atomically $ do
        counter <- readTVar $ tmCounter tm
        check $ counter > 0
        writeTVar (tmCounter tm) (counter - 1)
    withMVar (tmTM tm) $ \thrdmgr -> TM.fork thrdmgr $ do
        fn
        atomically $ do
            counter <- readTVar $ tmCounter tm
            writeTVar (tmCounter tm) (counter + 1)

forkManaged se asegura de que la cantidad de subprocesos administrados que se ejecutan simultáneamente no exceda maxThreadsCount. Funciona bien hasta cargas pesadas. Bajo carga pesada RTS lanza una excepción. Creo que bajo una gran carga, en una dura competencia concurrente por los recursos, algunos subprocesos simplemente no tienen tiempo para acceder al contexto STM. Entonces, creo que aumentar el intervalo de tiempo cuando RTS decide lanzar esta excepción puede resolver el problema.