Commits

Anonymous committed 8cac002

Prevent the finalizer to run early

Comments (0)

Files changed (1)

 import Control.Exception (SomeException, onException)
 import Control.Monad (forM_, forever, join, liftM2, unless, when)
 import Data.Hashable (hash)
+import Data.IORef (IORef, newIORef, mkWeakIORef)
 import Data.List (partition)
 import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)
-import System.Mem.Weak (addFinalizer)
 import qualified Control.Exception as E
 import qualified Data.Vector as V
 
     -- available.
     , localPools :: V.Vector (LocalPool a)
     -- ^ Per-capability resource pools.
+    , fin :: IORef ()
+    -- ^ empty value used to attach a finalizer to (internal)
     }
 
 instance Show (Pool a) where
   localPools <- atomically . V.replicateM numStripes $
                 liftM2 LocalPool (newTVar 0) (newTVar [])
   reaperId <- forkIO $ reaper destroy idleTime localPools
+  fin <- newIORef ()
   let p = Pool {
             create
           , destroy
           , idleTime
           , maxResources
           , localPools
+          , fin
           }
-  addFinalizer p $ killThread reaperId
+  mkWeakIORef fin $ killThread reaperId
   return p
 
 -- | Periodically go through all pools, closing any resources that