    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE UnboxedTuples #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE Unsafe #-}

    module GHC.Internal.Weak.Finalize
        ( -- * Handling exceptions
          -- | When an exception is thrown by a finalizer called by the
          -- garbage collector, GHC calls a global handler which can be set with
          -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by
          -- this handler will be ignored.
          setFinalizerExceptionHandler
        , getFinalizerExceptionHandler
        , printToHandleFinalizerExceptionHandler
          -- * Internal
        , 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#

    -- | The label we use for finalization threads. We manually float this to the
    -- top-level to ensure that the ByteArray# can be shared.
    label :: ByteArray
    label :: ByteArray
    label = ByteArray# -> ByteArray
    ByteArray (String -> ByteArray#
    utf8EncodeByteArray# String
    "weak finalizer thread")

    -- | Run a batch of finalizers from the garbage collector.  We're given
    -- an array of finalizers and the length of the array, and we just
    -- call each one in turn.
    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 ())

    -- See Note [Handling exceptions during Handle finalization] for the
    -- motivation for this mechanism.
    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 #-}

    -- | Get the global action called to report exceptions thrown by weak pointer
    -- finalizers to the user.
    --
    -- @since base-4.18.0.0
    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

    -- | Set the global action called to report exceptions thrown by weak pointer
    -- finalizers to the user.
    --
    -- @since base-4.18.0.0
    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

    -- | An exception handler for 'Handle' finalization that prints the error to
    -- the given 'Handle', but doesn't rethrow it.
    --
    -- @since base-4.18.0.0
    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"