Teo Camarasu pushed to branch wip/T26985 at Glasgow Haskell Compiler / GHC

Commits:

9 changed files:

Changes:

  • libraries/base/src/GHC/Weak.hs
    ... ... @@ -29,3 +29,5 @@ module GHC.Weak
    29 29 
          ) where
    30 30
    31 31 
     import GHC.Internal.Weak
    32 
    +import GHC.Internal.Weak.Finalize
    33 
    +import GHC.Weak.Finalize

  • libraries/base/src/GHC/Weak/Finalize.hs
    ... ... @@ -14,9 +14,14 @@ module GHC.Weak.Finalize
    14 14
    15 15 
     import GHC.Internal.Weak.Finalize
    16 16
    17 
    --- These imports can be removed once runFinalizerBatch is removed,
    18 
    --- as can MagicHash above.
    19 
    -import GHC.Internal.Base (Int, Array#, IO, State#, RealWorld)
    17 
    +import GHC.Internal.Base
    18 
    +import GHC.Internal.Exception
    19 
    +import GHC.Internal.IORef
    20 
    +import GHC.Internal.Conc.Sync (labelThreadByteArray#, myThreadId)
    21 
    +import GHC.Internal.IO (catchException, unsafePerformIO)
    22 
    +import GHC.Internal.IO.Handle.Types (Handle)
    23 
    +import GHC.Internal.IO.Handle.Text (hPutStrLn)
    24 
    +import GHC.Internal.Encoding.UTF8 (utf8EncodeByteArray#)
    20 25
    21 26
    22 27 
     {-# DEPRECATED runFinalizerBatch
    ... ... @@ -36,3 +41,13 @@ runFinalizerBatch :: Int
    36 41 
                       -> Array# (State# RealWorld -> State# RealWorld)
    37 42 
                       -> IO ()
    38 43 
     runFinalizerBatch = GHC.Internal.Weak.Finalize.runFinalizerBatch
    44 
    +
    45 
    +-- | An exception handler for 'Handle' finalization that prints the error to
    46 
    +-- the given 'Handle', but doesn't rethrow it.
    47 
    +--
    48 
    +-- @since base-4.18.0.0
    49 
    +printToHandleFinalizerExceptionHandler :: Handle -> SomeException -> IO ()
    50 
    +printToHandleFinalizerExceptionHandler hdl se =
    51 
    +    hPutStrLn hdl msg `catchException` (\(SomeException _) -> return ())
    52 
    +  where
    53 
    +    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 (
    91 91
    92 92 
     import Prelude
    93 93 
     import GHC.Internal.Weak
    94 
    +import GHC.Weak
    94 95
    95 96 
     -- | A specialised version of 'mkWeak', where the key and the value are
    96 97 
     -- the same object:

  • libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot deleted
    1 
    -{-# LANGUAGE MagicHash, NoImplicitPrelude #-}
    2 
    -{-# OPTIONS_HADDOCK not-home #-}
    3 
    -
    4 
    ------------------------------------------------------------------------------
    5 
    --- |
    6 
    --- Module      :  GHC.Internal.Conc.Sync [boot]
    7 
    --- Copyright   :  (c) The University of Glasgow, 1994-2002
    8 
    --- License     :  see libraries/base/LICENSE
    9 
    ---
    10 
    --- Maintainer  :  ghc-devs@haskell.org
    11 
    --- Stability   :  internal
    12 
    --- Portability :  non-portable (GHC extensions)
    13 
    ---
    14 
    --- Basic concurrency stuff.
    15 
    ---
    16 
    ------------------------------------------------------------------------------
    17 
    -
    18 
    -module GHC.Internal.Conc.Sync
    19 
    -        ( forkIO,
    20 
    -          ThreadId(..),
    21 
    -          myThreadId,
    22 
    -          showThreadId,
    23 
    -          ThreadStatus(..),
    24 
    -          threadStatus,
    25 
    -          sharedCAF,
    26 
    -          labelThreadByteArray#
    27 
    -        ) where
    28 
    -
    29 
    -import GHC.Internal.Base
    30 
    -import GHC.Internal.Ptr
    31 
    -
    32 
    -forkIO :: IO () -> IO ThreadId
    33 
    -
    34 
    -data ThreadId = ThreadId ThreadId#
    35 
    -
    36 
    -data BlockReason
    37 
    -        = BlockedOnMVar
    38 
    -              -- ^blocked on 'MVar'
    39 
    -        {- possibly (see 'threadstatus' below):
    40 
    -        | BlockedOnMVarRead
    41 
    -              -- ^blocked on reading an empty 'MVar'
    42 
    -        -}
    43 
    -        | BlockedOnBlackHole
    44 
    -              -- ^blocked on a computation in progress by another thread
    45 
    -        | BlockedOnException
    46 
    -              -- ^blocked in 'throwTo'
    47 
    -        | BlockedOnSTM
    48 
    -              -- ^blocked in 'retry' in an STM transaction
    49 
    -        | BlockedOnForeignCall
    50 
    -              -- ^currently in a foreign call
    51 
    -        | BlockedOnOther
    52 
    -              -- ^blocked on some other resource.  Without @-threaded@,
    53 
    -              -- I\/O and 'threadDelay' show up as 'BlockedOnOther', with @-threaded@
    54 
    -              -- they show up as 'BlockedOnMVar'.
    55 
    -
    56 
    -data ThreadStatus
    57 
    -        = ThreadRunning
    58 
    -              -- ^the thread is currently runnable or running
    59 
    -        | ThreadFinished
    60 
    -              -- ^the thread has finished
    61 
    -        | ThreadBlocked  BlockReason
    62 
    -              -- ^the thread is blocked on some resource
    63 
    -        | ThreadDied
    64 
    -        -- ^the thread received an uncaught exception
    65 
    -
    66 
    -myThreadId :: IO ThreadId
    67 
    -showThreadId :: ThreadId -> String
    68 
    -threadStatus :: ThreadId -> IO ThreadStatus
    69 
    -sharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a
    70 
    -labelThreadByteArray# :: ThreadId -> ByteArray# -> IO ()

  • libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs-boot deleted
    1 
    -{-# LANGUAGE NoImplicitPrelude #-}
    2 
    -
    3 
    -module GHC.Internal.IO.Handle.Text ( hPutStrLn ) where
    4 
    -
    5 
    -import GHC.Internal.Base (String, IO)
    6 
    -import {-# SOURCE #-} GHC.Internal.IO.Handle.Types (Handle)
    7 
    -
    8 
    -hPutStrLn :: Handle -> String -> IO ()

  • libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
    ... ... @@ -50,6 +50,8 @@ import GHC.Internal.IO.Handle
    50 50 
     import GHC.Internal.IO.StdHandles
    51 51 
     import GHC.Internal.IO.Exception
    52 52 
     import GHC.Internal.Weak
    53 
    +import GHC.Internal.Weak.Finalize
    54 
    +import GHC.Internal.IO.Handle.Types ()
    53 55
    54 56 
     #if defined(mingw32_HOST_OS)
    55 57 
     import GHC.Internal.ConsoleHandler as GHC.ConsoleHandler

  • libraries/ghc-internal/src/GHC/Internal/Weak.hs
    ... ... @@ -24,19 +24,9 @@ module GHC.Internal.Weak (
    24 24 
             mkWeak,
    25 25 
             deRefWeak,
    26 26 
             finalize,
    27 
    -
    28 
    -        -- * Handling exceptions
    29 
    -        -- | When an exception is thrown by a finalizer called by the
    30 
    -        -- garbage collector, GHC calls a global handler which can be set with
    31 
    -        -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by
    32 
    -        -- this handler will be ignored.
    33 
    -        setFinalizerExceptionHandler,
    34 
    -        getFinalizerExceptionHandler,
    35 
    -        printToHandleFinalizerExceptionHandler
    36 27 
         ) where
    37 28
    38 29 
     import GHC.Internal.Base
    39 
    -import GHC.Internal.Weak.Finalize
    40 30
    41 31 
     {-|
    42 32 
     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 @@
    4 4 
     {-# LANGUAGE Unsafe #-}
    5 5
    6 6 
     module GHC.Internal.Weak.Finalize
    7 
    -    ( -- * Handling exceptions
    8 
    -      -- | When an exception is thrown by a finalizer called by the
    9 
    -      -- garbage collector, GHC calls a global handler which can be set with
    10 
    -      -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by
    11 
    -      -- this handler will be ignored.
    12 
    -      setFinalizerExceptionHandler
    13 
    -    , getFinalizerExceptionHandler
    14 
    -    , printToHandleFinalizerExceptionHandler
    15 
    -      -- * Internal
    7 
    +    ( getFinalizerExceptionHandler
    8 
    +    , setFinalizerExceptionHandler
    16 9 
         , runFinalizerBatch
    17 10 
         ) where
    18 11
    19 12 
     import GHC.Internal.Base
    20 
    -import GHC.Internal.Exception
    21 
    -import GHC.Internal.IORef
    22 
    -import {-# SOURCE #-} GHC.Internal.Conc.Sync (labelThreadByteArray#, myThreadId)
    23 
    -import GHC.Internal.IO (catchException, unsafePerformIO)
    24 
    -import {-# SOURCE #-} GHC.Internal.IO.Handle.Types (Handle)
    25 
    -import {-# SOURCE #-} GHC.Internal.IO.Handle.Text (hPutStrLn)
    26 
    -import GHC.Internal.Encoding.UTF8 (utf8EncodeByteArray#)
    13 
    +import GHC.Internal.Conc.Sync ( labelThreadByteArray#, myThreadId )
    14 
    +import GHC.Internal.Encoding.UTF8 ( utf8EncodeByteArray# )
    15 
    +import GHC.Internal.Exception ( SomeException(..) )
    16 
    +import GHC.Internal.IO ( catchException, unsafePerformIO )
    17 
    +import GHC.Internal.IORef ( IORef, newIORef, readIORef, writeIORef )
    27 18
    28 19 
     data ByteArray = ByteArray ByteArray#
    29 20
    ... ... @@ -82,13 +73,3 @@ getFinalizerExceptionHandler = readIORef finalizerExceptionHandler
    82 73 
     -- @since base-4.18.0.0
    83 74 
     setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO ()
    84 75 
     setFinalizerExceptionHandler = writeIORef finalizerExceptionHandler
    85 
    -
    86 
    --- | An exception handler for 'Handle' finalization that prints the error to
    87 
    --- the given 'Handle', but doesn't rethrow it.
    88 
    ---
    89 
    --- @since base-4.18.0.0
    90 
    -printToHandleFinalizerExceptionHandler :: Handle -> SomeException -> IO ()
    91 
    -printToHandleFinalizerExceptionHandler hdl se =
    92 
    -    hPutStrLn hdl msg `catchException` (\(SomeException _) -> return ())
    93 
    -  where
    94 
    -    msg = "Exception during weak pointer finalization (ignored): " ++ displayException se ++ "\n"

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help