{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE Unsafe #-}
module GHC.Internal.Weak.Finalize
(
setFinalizerExceptionHandler
, getFinalizerExceptionHandler
, printToHandleFinalizerExceptionHandler
, runFinalizerBatch
) where
import GHC.Internal.Base
import GHC.Internal.Exception
import GHC.Internal.IORef
import {-# SOURCE #-} GHC.Internal.Conc.Sync (labelThreadByteArray#, myThreadId)
import GHC.Internal.IO (catchException, unsafePerformIO)
import {-# SOURCE #-} GHC.Internal.IO.Handle.Types (Handle)
import {-# SOURCE #-} GHC.Internal.IO.Handle.Text (hPutStrLn)
import GHC.Internal.Encoding.UTF8 (utf8EncodeByteArray#)
data ByteArray = ByteArray ByteArray#
label :: ByteArray
label :: ByteArray
label = ByteArray# -> ByteArray
ByteArray (String -> ByteArray#
utf8EncodeByteArray# String
"weak finalizer thread")
runFinalizerBatch :: Int
-> Array# (State# RealWorld -> State# RealWorld)
-> IO ()
runFinalizerBatch :: Int -> Array# (State# RealWorld -> State# RealWorld) -> IO ()
runFinalizerBatch (I# Int#
n) Array# (State# RealWorld -> State# RealWorld)
arr = do
tid <- IO ThreadId
myThreadId
case label of ByteArray ByteArray#
ba# -> ThreadId -> ByteArray# -> IO ()
labelThreadByteArray# ThreadId
tid ByteArray#
ba#
go n
where
getFinalizer :: Int# -> IO ()
getFinalizer :: Int# -> IO ()
getFinalizer Int#
i =
case Array# (State# RealWorld -> State# RealWorld)
-> Int# -> (# State# RealWorld -> State# RealWorld #)
forall a. Array# a -> Int# -> (# a #)
indexArray# Array# (State# RealWorld -> State# RealWorld)
arr Int#
i of
(# State# RealWorld -> State# RealWorld
io #) -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case State# RealWorld -> State# RealWorld
io State# RealWorld
s of
State# RealWorld
s' -> (# State# RealWorld
s', () #)
go :: Int# -> IO ()
go :: Int# -> IO ()
go Int#
0# = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go Int#
i = do
let i' :: Int#
i' = Int#
i Int# -> Int# -> Int#
-# Int#
1#
let finalizer :: IO ()
finalizer = Int# -> IO ()
getFinalizer Int#
i'
IO ()
finalizer IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catchException` SomeException -> IO ()
handleExc
Int# -> IO ()
go Int#
i'
handleExc :: SomeException -> IO ()
handleExc :: SomeException -> IO ()
handleExc SomeException
se = do
handleFinalizerExc <- IO (SomeException -> IO ())
getFinalizerExceptionHandler
handleFinalizerExc se `catchException` (\(SomeException e
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
finalizerExceptionHandler :: IORef (SomeException -> IO ())
finalizerExceptionHandler :: IORef (SomeException -> IO ())
finalizerExceptionHandler = IO (IORef (SomeException -> IO ()))
-> IORef (SomeException -> IO ())
forall a. IO a -> a
unsafePerformIO (IO (IORef (SomeException -> IO ()))
-> IORef (SomeException -> IO ()))
-> IO (IORef (SomeException -> IO ()))
-> IORef (SomeException -> IO ())
forall a b. (a -> b) -> a -> b
$ (SomeException -> IO ()) -> IO (IORef (SomeException -> IO ()))
forall a. a -> IO (IORef a)
newIORef (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (IO () -> SomeException -> IO ())
-> IO () -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# NOINLINE finalizerExceptionHandler #-}
getFinalizerExceptionHandler :: IO (SomeException -> IO ())
getFinalizerExceptionHandler :: IO (SomeException -> IO ())
getFinalizerExceptionHandler = IORef (SomeException -> IO ()) -> IO (SomeException -> IO ())
forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
finalizerExceptionHandler
setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO ()
setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO ()
setFinalizerExceptionHandler = IORef (SomeException -> IO ()) -> (SomeException -> IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
finalizerExceptionHandler
printToHandleFinalizerExceptionHandler :: Handle -> SomeException -> IO ()
printToHandleFinalizerExceptionHandler :: Handle -> SomeException -> IO ()
printToHandleFinalizerExceptionHandler Handle
hdl SomeException
se =
Handle -> String -> IO ()
hPutStrLn Handle
hdl String
msg IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catchException` (\(SomeException e
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
where
msg :: String
msg = String
"Exception during weak pointer finalization (ignored): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
se String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"