multithreading - Haskell: STM トランザクションでスレッドが無期限にブロックされる

Question

STM トランザクションでスレッドが無期限にブロックされたと RTS が判断する時間間隔を増やす方法はありますか? これが私のコードです：

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は、同時に実行されるマネージド スレッドの数がmaxThreadsCountを超えないようにします。高負荷まで問題なく動作します。負荷が高い場合、RTS は例外をスローします。負荷が高く、リソースの同時競合が激しい場合、一部のスレッドは STM コンテキストにアクセスする時間がないだけだと思います。したがって、RTS がこの例外をスローすることを決定したときの時間間隔を長くすると、問題が解決する可能性があると思います。