Teo Camarasu pushed to branch wip/T26985 at Glasgow Haskell Compiler / GHC Commits: 264ff562 by Teo Camarasu at 2026-03-04T21:55:41+00:00 ghc-internal: move parts of Weak finalizer to base We move parts of the Weak finalizer interface to `base` only the parts that the RTS needs to know about are kept in `ghc-internal`. This lets us then prune our imports somewhat and get rid of some SOURCE imports. Resolves #26985 - - - - - 9 changed files: - libraries/base/src/GHC/Weak.hs - libraries/base/src/GHC/Weak/Finalize.hs - − libraries/base/src/GHC/Weak/Finalizehs - libraries/base/src/System/Mem/Weak.hs - − libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot - − libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs-boot - libraries/ghc-internal/src/GHC/Internal/TopHandler.hs - libraries/ghc-internal/src/GHC/Internal/Weak.hs - libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs Changes: ===================================== libraries/base/src/GHC/Weak.hs ===================================== @@ -29,3 +29,5 @@ module GHC.Weak ) where import GHC.Internal.Weak +import GHC.Internal.Weak.Finalize +import GHC.Weak.Finalize ===================================== libraries/base/src/GHC/Weak/Finalize.hs ===================================== @@ -17,6 +17,14 @@ import GHC.Internal.Weak.Finalize -- These imports can be removed once runFinalizerBatch is removed, -- as can MagicHash above. import GHC.Internal.Base (Int, Array#, IO, State#, RealWorld) +import GHC.Internal.Base +import GHC.Internal.Exception +import GHC.Internal.IORef +import GHC.Internal.Conc.Sync (labelThreadByteArray#, myThreadId) +import GHC.Internal.IO (catchException, unsafePerformIO) +import GHC.Internal.IO.Handle.Types (Handle) +import GHC.Internal.IO.Handle.Text (hPutStrLn) +import GHC.Internal.Encoding.UTF8 (utf8EncodeByteArray#) {-# DEPRECATED runFinalizerBatch @@ -36,3 +44,20 @@ runFinalizerBatch :: Int -> Array# (State# RealWorld -> State# RealWorld) -> IO () runFinalizerBatch = GHC.Internal.Weak.Finalize.runFinalizerBatch + +-- | 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 = writeIORef 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 hdl se = + hPutStrLn hdl msg `catchException` (\(SomeException _) -> return ()) + where + msg = "Exception during weak pointer finalization (ignored): " ++ displayException se ++ "\n" ===================================== libraries/base/src/GHC/Weak/Finalizehs deleted ===================================== ===================================== libraries/base/src/System/Mem/Weak.hs ===================================== @@ -91,6 +91,7 @@ module System.Mem.Weak ( import Prelude import GHC.Internal.Weak +import GHC.Weak -- | A specialised version of 'mkWeak', where the key and the value are -- the same object: ===================================== libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot deleted ===================================== @@ -1,70 +0,0 @@ -{-# LANGUAGE MagicHash, NoImplicitPrelude #-} -{-# OPTIONS_HADDOCK not-home #-} - ------------------------------------------------------------------------------ --- | --- Module : GHC.Internal.Conc.Sync [boot] --- Copyright : (c) The University of Glasgow, 1994-2002 --- License : see libraries/base/LICENSE --- --- Maintainer : ghc-devs@haskell.org --- Stability : internal --- Portability : non-portable (GHC extensions) --- --- Basic concurrency stuff. --- ------------------------------------------------------------------------------ - -module GHC.Internal.Conc.Sync - ( forkIO, - ThreadId(..), - myThreadId, - showThreadId, - ThreadStatus(..), - threadStatus, - sharedCAF, - labelThreadByteArray# - ) where - -import GHC.Internal.Base -import GHC.Internal.Ptr - -forkIO :: IO () -> IO ThreadId - -data ThreadId = ThreadId ThreadId# - -data BlockReason - = BlockedOnMVar - -- ^blocked on 'MVar' - {- possibly (see 'threadstatus' below): - | BlockedOnMVarRead - -- ^blocked on reading an empty 'MVar' - -} - | BlockedOnBlackHole - -- ^blocked on a computation in progress by another thread - | BlockedOnException - -- ^blocked in 'throwTo' - | BlockedOnSTM - -- ^blocked in 'retry' in an STM transaction - | BlockedOnForeignCall - -- ^currently in a foreign call - | BlockedOnOther - -- ^blocked on some other resource. Without @-threaded@, - -- I\/O and 'threadDelay' show up as 'BlockedOnOther', with @-threaded@ - -- they show up as 'BlockedOnMVar'. - -data ThreadStatus - = ThreadRunning - -- ^the thread is currently runnable or running - | ThreadFinished - -- ^the thread has finished - | ThreadBlocked BlockReason - -- ^the thread is blocked on some resource - | ThreadDied - -- ^the thread received an uncaught exception - -myThreadId :: IO ThreadId -showThreadId :: ThreadId -> String -threadStatus :: ThreadId -> IO ThreadStatus -sharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a -labelThreadByteArray# :: ThreadId -> ByteArray# -> IO () ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs-boot deleted ===================================== @@ -1,8 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} - -module GHC.Internal.IO.Handle.Text ( hPutStrLn ) where - -import GHC.Internal.Base (String, IO) -import {-# SOURCE #-} GHC.Internal.IO.Handle.Types (Handle) - -hPutStrLn :: Handle -> String -> IO () ===================================== libraries/ghc-internal/src/GHC/Internal/TopHandler.hs ===================================== @@ -50,6 +50,8 @@ import GHC.Internal.IO.Handle import GHC.Internal.IO.StdHandles import GHC.Internal.IO.Exception import GHC.Internal.Weak +import GHC.Internal.Weak.Finalize +import GHC.Internal.IO.Handle.Types () #if defined(mingw32_HOST_OS) import GHC.Internal.ConsoleHandler as GHC.ConsoleHandler ===================================== libraries/ghc-internal/src/GHC/Internal/Weak.hs ===================================== @@ -24,19 +24,9 @@ module GHC.Internal.Weak ( mkWeak, deRefWeak, 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 ) where import GHC.Internal.Base -import GHC.Internal.Weak.Finalize {-| A weak pointer object with a key and a value. The value has type @v@. ===================================== libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs ===================================== @@ -4,26 +4,17 @@ {-# 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 + ( getFinalizerExceptionHandler , runFinalizerBatch + , finalizerExceptionHandler ) 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#) +import GHC.Internal.Conc.Sync ( labelThreadByteArray#, myThreadId ) +import GHC.Internal.Encoding.UTF8 ( utf8EncodeByteArray# ) +import GHC.Internal.Exception ( SomeException(..) ) +import GHC.Internal.IO ( catchException, unsafePerformIO ) +import GHC.Internal.IORef ( IORef, newIORef, readIORef ) data ByteArray = ByteArray ByteArray# @@ -75,20 +66,3 @@ finalizerExceptionHandler = unsafePerformIO $ newIORef (const $ return ()) -- @since base-4.18.0.0 getFinalizerExceptionHandler :: IO (SomeException -> IO ()) getFinalizerExceptionHandler = readIORef 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 = writeIORef 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 hdl se = - hPutStrLn hdl msg `catchException` (\(SomeException _) -> return ()) - where - msg = "Exception during weak pointer finalization (ignored): " ++ displayException se ++ "\n" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/264ff5627ace715d9b179bd8a1e64e63... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/264ff5627ace715d9b179bd8a1e64e63... You're receiving this email because of your account on gitlab.haskell.org.