@@ -3169,39 +3169,64 @@ gbracket_ bef exc aft fexc fnormal =
31693169 Skip s -> return $ Skip (GBracketException (Stream step1 s))
31703170 Stop -> return Stop
31713171
3172−-- | Create an IORef holding a finalizer that is called automatically when the
3173−-- IORef is garbage collected. The IORef can be written to with a 'Nothing'
3172+------------------------------------------------------------------------------
3173+-- Finalizers
3174+------------------------------------------------------------------------------
3175+
3176+-- | Make a finalizer from a monadic action @m a@ that can run in IO monad.
3177+mkIOFinalizer :: MonadBaseControl IO m => m b -> m (IO ())
3178+mkIOFinalizer f = do
3179+ mrun <- captureMonadState
3180+ return $
3181+ void $ do
3182+ _ <- runInIO mrun f
3183+ return ()
3184+
3185+-- | Run an IO action stored in a finalized IORef.
3186+runIORefFinalizerGC :: IORef (Maybe (IO ())) -> IO ()
3187+runIORefFinalizerGC ref = do
3188+ res <- readIORef ref
3189+ case res of
3190+ Nothing -> return ()
3191+ Just f -> f
3192+
3193+-- | Create an IORef holding a finalizer that is called automatically when
3194+-- the IORef is garbage collected. The IORef can be written to with a 'Nothing'
31743195-- value to deactivate the finalizer.
3196+--
3197+-- Note: The finalizer is always run with the state of the monad captured at
3198+-- the time of calling newFinalizedIORef. To run it on garbage collection we
3199+-- have no option but to take a snapshot of the monadic state at some point of
3200+-- time. For normal case we could run it with the current state of the monad
3201+-- but we want to keep both the cases consistent.
3202+--
31753203newFinalizedIORef :: (MonadIO m, MonadBaseControl IO m)
31763204 => m a -> m (IORef (Maybe (IO ())))
31773205newFinalizedIORef finalizer = do
3178− mrun <- captureMonadState
3179− ref <- liftIO $ newIORef $ Just $ liftIO $ void $ do
3180− _ <- runInIO mrun finalizer
3181− return ()
3182− let finalizer1 = do
3183− res <- readIORef ref
3184− case res of
3185− Nothing -> return ()
3186− Just f -> f
3187− _ <- liftIO $ mkWeakIORef ref finalizer1
3206+ f <- mkIOFinalizer finalizer
3207+ ref <- liftIO $ newIORef $ Just f
3208+ _ <- liftIO $ mkWeakIORef ref (runIORefFinalizerGC ref)
31883209 return ref
31893210
31903211-- | Run the finalizer stored in an IORef and deactivate it so that it is run
3191−-- only once.
3212+-- only once. Note, the action runs with async exceptions masked.
31923213--
31933214runIORefFinalizer :: MonadIO m => IORef (Maybe (IO ())) -> m ()
31943215runIORefFinalizer ref = liftIO $ do
31953216 res <- readIORef ref
31963217 case res of
31973218 Nothing -> return ()
3198− Just f -> writeIORef ref Nothing >> f
3219+ Just action -> do
3220+ writeIORef ref Nothing
3221+ action
31993222
32003223-- | Deactivate the finalizer stored in an IORef without running it.
32013224--
32023225clearIORefFinalizer :: MonadIO m => IORef (Maybe (IO ())) -> m ()
32033226clearIORefFinalizer ref = liftIO $ writeIORef ref Nothing
32043227
3228+------------------------------------------------------------------------------
3229+
32053230data GbracketIOState s1 s2 v wref
32063231 = GBracketIOInit
32073232 | GBracketIONormal s1 v wref