Release a RefTracker even if the corresponding finaliser throws an …

…error
IntersectMBO · Dec 30, 2024 · c43a654 · c43a654
1 parent e80f7f2
commit c43a654
Showing 1 changed file with 8 additions and 2 deletions.
diff --git a/src-control/Control/RefCount.hs b/src-control/Control/RefCount.hs
@@ -249,8 +249,7 @@ releaseRef ::
   -> m ()
 releaseRef ref@Ref{refobj} = do
     assertNoDoubleRelease ref
-    decrementRefCounter (getRefCounter refobj)
-    releaseRefTracker ref
+    withReleaseRefTracker ref (decrementRefCounter (getRefCounter refobj))
 
 {-# COMPLETE DeRef #-}
 #if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
@@ -387,6 +386,10 @@ instance Exception RefException where
 releaseRefTracker :: PrimMonad m => Ref a -> m ()
 releaseRefTracker _ = return ()
 
+{-# INLINE withReleaseRefTracker #-}
+withReleaseRefTracker :: PrimMonad m => Ref a -> m () -> m ()
+withReleaseRefTracker _ref k = k
+
 {-# INLINE assertNoUseAfterRelease #-}
 assertNoUseAfterRelease :: PrimMonad m => Ref a -> m ()
 assertNoUseAfterRelease _ = return ()
@@ -438,6 +441,9 @@ releaseRefTracker Ref { reftracker =  RefTracker _refid _weak outer } =
     inner <- readIORef outer
     writeIORef inner True
 
+withReleaseRefTracker :: (PrimMonad m, MonadThrow m) => Ref a -> m () -> m ()
+withReleaseRefTracker ref k = k `finally` releaseRefTracker ref
+
 finaliserRefTracker :: IORef Bool -> RefId -> CallStack -> IO ()
 finaliserRefTracker inner refid callsite = do
     released <- readIORef inner