[Git][ghc/ghc][wip/T25452] 7 commits: DmdAnal: Make `prompt#` lazy (#25439)

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Thu Nov 14 00:20:09 UTC 2024



Ben Gamari pushed to branch wip/T25452 at Glasgow Haskell Compiler / GHC


Commits:
00d58ae1 by Sebastian Graf at 2024-11-13T15:21:23-05:00
DmdAnal: Make `prompt#` lazy (#25439)

This applies the same treatment to `prompt#` as for `catch#`.
See `Note [Strictness for mask/unmask/catch/prompt]`.

Fixes #25439.

- - - - -
93233a66 by Ben Gamari at 2024-11-13T15:21:59-05:00
boot: Do not attempt to update config.sub

While Apple ARM hardware was new we found that the autoconf scripts
included in some boot packages were too old. As a mitigation for this,
we introduced logic in the `boot` script to update the `config.sub`
with that from the GHC tree. However, this causes submodules which
have `config.sub` committted to appear to be dirty. This is a
considerable headache.

Now since `config.sub` with full platform support is more common we can
remove `boot`'s `config.sub` logic.

Fixes #19574.

- - - - -
1dea1376 by Ben Gamari at 2024-11-13T19:17:12-05:00
base: Label threads forked by IO operations

Addresses part of #25452.

- - - - -
0c0db09a by Ben Gamari at 2024-11-13T19:19:49-05:00
base: Label threads forked by System.Timeout

Addresses part of #25452.

- - - - -
2aeab937 by Ben Gamari at 2024-11-13T19:19:52-05:00
base: Label signal handling threads

Addresses part of #25452.

- - - - -
16a1af1f by Ben Gamari at 2024-11-13T19:19:52-05:00
base: Label Windows console event handling threads

Addresses part of #25452.

- - - - -
bade7f85 by Ben Gamari at 2024-11-13T19:19:52-05:00
ghci: Label evaluation sandbox thread

Addresses part of #25452.

- - - - -


14 changed files:

- boot
- compiler/GHC/Builtin/primops.txt.pp
- libraries/base/src/Control/Concurrent.hs
- libraries/base/src/System/Timeout.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Signal.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ConsoleEvent.hsc
- libraries/ghci/GHCi/Run.hs
- + testsuite/tests/dmdanal/should_run/T25439.hs
- + testsuite/tests/dmdanal/should_run/T25439.stdout
- testsuite/tests/dmdanal/should_run/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32


Changes:

=====================================
boot
=====================================
@@ -66,9 +66,6 @@ def autoreconf():
     for dir_ in ['.', 'rts'] + glob.glob('libraries/*/'):
         if os.path.isfile(os.path.join(dir_, 'configure.ac')):
             print("Booting %s" % dir_)
-            # Update config.sub in submodules
-            if dir_ != '.' and os.path.isfile(os.path.join(dir_, 'config.sub')):
-                shutil.copyfile('config.sub', os.path.join(dir_, 'config.sub'))
             processes[dir_] = subprocess.Popen(['sh', '-c', reconf_cmd], cwd=dir_)
 
     # Wait for all child processes to finish.


=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -2663,18 +2663,45 @@ primop  CasMutVarOp "casMutVar#" GenPrimOp
 section "Exceptions"
 ------------------------------------------------------------------------
 
--- Note [Strictness for mask/unmask/catch]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Note [Strict IO wrappers]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~
 -- Consider this example, which comes from GHC.IO.Handle.Internals:
---    wantReadableHandle3 f ma b st
+--    wantReadableHandle3 f mv b st
 --      = case ... of
---          DEFAULT -> case ma of MVar a -> ...
---          0#      -> maskAsyncExceptions# (\st -> case ma of MVar a -> ...)
+--          DEFAULT -> case mv of MVar a -> ...
+--          0#      -> maskAsyncExceptions# (\st -> case mv of MVar a -> ...)
 -- The outer case just decides whether to mask exceptions, but we don't want
--- thereby to hide the strictness in 'ma'!  Hence the use of strictOnceApply1Dmd
--- in mask and unmask. But catch really is lazy in its first argument, see
--- #11555. So for IO actions 'ma' we often use a wrapper around it that is
--- head-strict in 'ma': GHC.IO.catchException.
+-- thereby to hide the strictness in `mv`!  Hence the use of strictOnceApply1Dmd
+-- in mask#, unmask# and atomically# (where we use strictManyApply1Dmd to respect
+-- that it potentially calls its action multiple times).
+--
+-- Note [Strictness for catch-style primops]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The catch#-style primops always call their action, just like outlined
+-- in Note [Strict IO wrappers].
+-- However, it is important that we give their first arg lazyApply1Dmd and not
+-- strictOnceApply1Dmd, like for mask#. Here is why. Consider a call
+--
+--   catch# act handler s
+--
+-- If `act = raiseIO# ...`, using strictOnceApply1Dmd for `act` would mean that
+-- the call forwards the dead-end flag from `act` (see Note [Dead ends] and
+-- Note [Precise exceptions and strictness analysis]).
+-- This would cause dead code elimination to discard the continuation of the
+-- catch# call, among other things. This first came up in #11555.
+--
+-- Hence catch# uses lazyApply1Dmd in order /not/ to forward the dead-end flag
+-- from `act`. (This is a bit brutal, but the language of strictness types is
+-- not expressive enough to give it a more precise semantics that is still
+-- sound.)
+-- For perf reasons we often (but not always) choose to use a wrapper around
+-- catch# that is head-strict in `act`: GHC.IO.catchException.
+--
+-- A similar caveat applies to prompt#, which can be seen as a
+-- generalisation of catch# as explained in GHC.Prim#continuations#.
+-- The reason is that even if `act` appears dead-ending (e.g., looping)
+-- `prompt# tag ma s` might return alright due to a (higher-order) use of
+-- `control0#` in `act`. This came up in #25439.
 
 primop  CatchOp "catch#" GenPrimOp
           (State# RealWorld -> (# State# RealWorld, a_reppoly #) )
@@ -2691,7 +2718,7 @@ primop  CatchOp "catch#" GenPrimOp
    strictness  = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
                                                  , lazyApply2Dmd
                                                  , topDmd] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strictness for catch-style primops]
    out_of_line = True
    effect = ReadWriteEffect
    -- Either inner computation might potentially raise an unchecked exception,
@@ -2757,7 +2784,7 @@ primop  MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp
      in continuation-style primops\" for details. }
    with
    strictness  = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strict IO wrappers]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -2772,6 +2799,7 @@ primop  MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp
      in continuation-style primops\" for details. }
    with
    strictness  = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
+                 -- See Note [Strict IO wrappers]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -2786,7 +2814,7 @@ primop  UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp
      in continuation-style primops\" for details. }
    with
    strictness  = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strict IO wrappers]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -2972,7 +3000,8 @@ primop  PromptOp "prompt#" GenPrimOp
      -> State# RealWorld -> (# State# RealWorld, a #)
    { See "GHC.Prim#continuations". }
    with
-   strictness = { \ _arity -> mkClosedDmdSig [topDmd, strictOnceApply1Dmd, topDmd] topDiv }
+   strictness = { \ _arity -> mkClosedDmdSig [topDmd, lazyApply1Dmd, topDmd] topDiv }
+                 -- See Note [Strictness for catch-style primops]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -3000,7 +3029,7 @@ primop  AtomicallyOp "atomically#" GenPrimOp
    -> State# RealWorld -> (# State# RealWorld, a_levpoly #)
    with
    strictness  = { \ _arity -> mkClosedDmdSig [strictManyApply1Dmd,topDmd] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strict IO wrappers]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -3029,7 +3058,7 @@ primop  CatchRetryOp "catchRetry#" GenPrimOp
    strictness  = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
                                                  , lazyApply1Dmd
                                                  , topDmd ] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strictness for catch-style primops]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -3041,7 +3070,7 @@ primop  CatchSTMOp "catchSTM#" GenPrimOp
    strictness  = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
                                                  , lazyApply2Dmd
                                                  , topDmd ] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strictness for catch-style primops]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -3731,6 +3760,7 @@ primop KeepAliveOp "keepAlive#" GenPrimOp
    with
    out_of_line = True
    strictness = { \ _arity -> mkClosedDmdSig [topDmd, topDmd, strictOnceApply1Dmd] topDiv }
+                 -- See Note [Strict IO wrappers]
    effect = ReadWriteEffect
    -- The invoked computation may have side effects
 


=====================================
libraries/base/src/Control/Concurrent.hs
=====================================
@@ -265,7 +265,7 @@ threadWaitRead fd
   -- fdReady does the right thing, but we have to call it in a
   -- separate thread, otherwise threadWaitRead won't be interruptible,
   -- and this only works with -threaded.
-  | threaded  = withThread (waitFd fd False)
+  | threaded  = withThread "threadWaitRead worker" (waitFd fd False)
   | otherwise = case fd of
                   0 -> do _ <- hWaitForInput stdin (-1)
                           return ()
@@ -286,7 +286,7 @@ threadWaitRead fd
 threadWaitWrite :: Fd -> IO ()
 threadWaitWrite fd
 #if defined(mingw32_HOST_OS)
-  | threaded  = withThread (waitFd fd True)
+  | threaded  = withThread "threadWaitWrite worker" (waitFd fd True)
   | otherwise = errorWithoutStackTrace "threadWaitWrite requires -threaded on Windows"
 #else
   = Conc.threadWaitWrite fd
@@ -302,8 +302,11 @@ threadWaitReadSTM :: Fd -> IO (STM (), IO ())
 threadWaitReadSTM fd
 #if defined(mingw32_HOST_OS)
   | threaded = do v <- newTVarIO Nothing
-                  mask_ $ void $ forkIO $ do result <- try (waitFd fd False)
-                                             atomically (writeTVar v $ Just result)
+                  mask_ $ void $ forkIO $ do
+                    tid <- myThreadId
+                    labelThread tid "threadWaitReadSTM worker"
+                    result <- try (waitFd fd False)
+                    atomically (writeTVar v $ Just result)
                   let waitAction = do result <- readTVar v
                                       case result of
                                         Nothing         -> retry
@@ -326,8 +329,11 @@ threadWaitWriteSTM :: Fd -> IO (STM (), IO ())
 threadWaitWriteSTM fd
 #if defined(mingw32_HOST_OS)
   | threaded = do v <- newTVarIO Nothing
-                  mask_ $ void $ forkIO $ do result <- try (waitFd fd True)
-                                             atomically (writeTVar v $ Just result)
+                  mask_ $ void $ forkIO $ do
+                    tid <- myThreadId
+                    labelThread tid "threadWaitWriteSTM worker"
+                    result <- try (waitFd fd True)
+                    atomically (writeTVar v $ Just result)
                   let waitAction = do result <- readTVar v
                                       case result of
                                         Nothing         -> retry
@@ -343,10 +349,14 @@ threadWaitWriteSTM fd
 #if defined(mingw32_HOST_OS)
 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
 
-withThread :: IO a -> IO a
-withThread io = do
+withThread :: String -> IO a -> IO a
+withThread label io = do
   m <- newEmptyMVar
-  _ <- mask_ $ forkIO $ try io >>= putMVar m
+  _ <- mask_ $ forkIO $ do
+    tid <- myThreadId
+    labelThread tid label
+    result <- try io
+    putMVar m result
   x <- takeMVar m
   case x of
     Right a -> return a


=====================================
libraries/base/src/System/Timeout.hs
=====================================
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
 
 -------------------------------------------------------------------------------
 -- |
@@ -29,6 +29,7 @@ import GHC.Internal.Control.Exception   (Exception(..), handleJust, bracket,
                             asyncExceptionToException,
                             asyncExceptionFromException)
 import GHC.Internal.Data.Unique         (Unique, newUnique)
+import GHC.Conc (labelThread)
 import Prelude
 
 -- $setup
@@ -119,7 +120,9 @@ timeout n f
         let handleTimeout = do
                 v <- isEmptyMVar lock
                 when v $ void $ forkIOWithUnmask $ \unmask -> unmask $ do
-                    v2 <- tryPutMVar lock =<< myThreadId
+                    tid <- myThreadId
+                    labelThread tid "timeout worker"
+                    v2 <- tryPutMVar lock tid
                     when v2 $ throwTo pid ex
             cleanupTimeout key = uninterruptibleMask_ $ do
                 v <- tryPutMVar lock undefined
@@ -136,7 +139,9 @@ timeout n f
         ex  <- fmap Timeout newUnique
         handleJust (\e -> if e == ex then Just () else Nothing)
                    (\_ -> return Nothing)
-                   (bracket (forkIOWithUnmask $ \unmask ->
+                   (bracket (forkIOWithUnmask $ \unmask -> do
+                                 tid <- myThreadId
+                                 labelThread tid "timeout worker"
                                  unmask $ threadDelay n >> throwTo pid ex)
                             (uninterruptibleMask_ . killThread)
                             (\_ -> fmap Just f))


=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/Signal.hs
=====================================
@@ -19,7 +19,7 @@ import GHC.Internal.Foreign.Ptr (Ptr, castPtr)
 import GHC.Internal.Foreign.Marshal.Alloc (finalizerFree)
 import GHC.Internal.Arr (inRange)
 import GHC.Internal.Base
-import GHC.Internal.Conc.Sync (forkIO)
+import GHC.Internal.Conc.Sync (myThreadId, labelThread, forkIO)
 import GHC.Internal.IO (mask_, unsafePerformIO)
 import GHC.Internal.IOArray (IOArray, boundsIOArray, newIOArray,
                     unsafeReadIOArray, unsafeWriteIOArray)
@@ -69,7 +69,10 @@ runHandlers p_info sig = do
       else do handler <- unsafeReadIOArray arr int
               case handler of
                 Nothing -> return ()
-                Just (f,_)  -> do _ <- forkIO (f p_info)
+                Just (f,_)  -> do _ <- forkIO $ do
+                                    tid <- myThreadId
+                                    labelThread tid "signal handler"
+                                    f p_info
                                   return ()
 
 -- It is our responsibility to free the memory buffer, so we create a


=====================================
libraries/ghc-internal/src/GHC/Internal/Event/Windows/ConsoleEvent.hsc
=====================================
@@ -53,7 +53,10 @@ start_console_handler :: Word32 -> IO ()
 start_console_handler r =
   case toWin32ConsoleEvent r of
     Just x  -> withMVar win32ConsoleHandler $ \handler -> do
-                 _ <- forkIO (handler x)
+                 _ <- forkIO $ do
+                     tid <- myThreadId
+                     labelThread tid "console event handler"
+                     handler x
                  return ()
     Nothing -> return ()
 


=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -226,7 +226,10 @@ sandboxIO opts io = do
     let runIt = measureAlloc $ tryEval $ rethrow opts $ clearCCS io
     if useSandboxThread opts
        then do
-         tid <- forkIO $ do unsafeUnmask runIt >>= putMVar statusMVar
+         tid <- forkIO $ do
+           tid <- myThreadId
+           labelThread tid "GHCi sandbox"
+           unsafeUnmask runIt >>= putMVar statusMVar
                                 -- empty: can't block
          redirectInterrupts tid $ unsafeUnmask $ takeMVar statusMVar
        else


=====================================
testsuite/tests/dmdanal/should_run/T25439.hs
=====================================
@@ -0,0 +1,25 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, BlockArguments #-}
+
+import Prelude hiding (break)
+import GHC.Exts (PromptTag#, newPromptTag#, prompt#, control0#)
+import GHC.IO (IO(..), unIO)
+import Control.Monad (forever)
+
+main :: IO ()
+main = do
+  putStrLn "before"
+  broken >>= putStrLn
+  putStrLn "after"
+
+broken :: IO String
+broken = do
+  loop \l -> do
+    break l "broken"
+
+{-# NOINLINE loop #-}
+loop :: (PromptTag# a -> IO ()) -> IO a
+loop f = IO \rw0 -> case newPromptTag# rw0 of
+  (# rw1, tag #) -> prompt# tag (unIO (forever (f tag))) rw1
+
+break :: PromptTag# a -> a -> IO b
+break tag x = IO (control0# tag \_ rw1 -> (# rw1, x #))


=====================================
testsuite/tests/dmdanal/should_run/T25439.stdout
=====================================
@@ -0,0 +1,3 @@
+before
+broken
+after


=====================================
testsuite/tests/dmdanal/should_run/all.T
=====================================
@@ -33,3 +33,4 @@ test('T22475b', normal, compile_and_run, [''])
 # T22549: Do not strictify DFuns, otherwise we will <<loop>>
 test('T22549', normal, compile_and_run, ['-fdicts-strict -fno-specialise'])
 test('T23208', exit_code(1), multimod_compile_and_run, ['T23208_Lib', 'T23208'])
+test('T25439', normal, compile_and_run, [''])


=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -10612,7 +10612,7 @@ module System.Posix.Types where
 
 
 module System.Timeout where
-  -- Safety: Safe
+  -- Safety: Trustworthy
   type Timeout :: *
   newtype Timeout = ...
   timeout :: forall a. GHC.Types.Int -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -11728,7 +11728,7 @@ instance GHC.Internal.Exception.Type.Exception GHC.Internal.Control.Exception.Ba
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Data.Dynamic.Dynamic -- Defined in ‘GHC.Internal.Data.Dynamic’
 instance [safe] GHC.Internal.Exception.Type.Exception ghc-internal-9.1300.0:GHC.Internal.IO.Handle.Lock.Common.FileLockingNotSupported -- Defined in ‘ghc-internal-9.1300.0:GHC.Internal.IO.Handle.Lock.Common’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IOPort.IOPortException -- Defined in ‘GHC.Internal.IOPort’
-instance [safe] GHC.Internal.Exception.Type.Exception System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Internal.Exception.Type.Exception System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance forall a k (b :: k). GHC.Internal.Float.Floating a => GHC.Internal.Float.Floating (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
 instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Float.Floating (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Float.Floating (f (g a)) => GHC.Internal.Float.Floating (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
@@ -12541,7 +12541,7 @@ instance forall (c :: GHC.Types.Char). GHC.Internal.Show.Show (GHC.Internal.Type
 instance forall (s :: GHC.Types.Symbol). GHC.Internal.Show.Show (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
-instance [safe] GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Internal.StaticPtr.IsStatic GHC.Internal.StaticPtr.StaticPtr -- Defined in ‘GHC.Internal.StaticPtr’
@@ -12741,7 +12741,7 @@ instance forall (c :: GHC.Types.Char). GHC.Classes.Eq (GHC.Internal.TypeLits.SCh
 instance forall (s :: GHC.Types.Symbol). GHC.Classes.Eq (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Classes.Eq GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Classes.Eq GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
-instance [safe] GHC.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance GHC.Classes.Eq GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Classes.Eq GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance forall a. GHC.Classes.Ord a => GHC.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’


=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -13653,7 +13653,7 @@ module System.Posix.Types where
 
 
 module System.Timeout where
-  -- Safety: Safe
+  -- Safety: Trustworthy
   type Timeout :: *
   newtype Timeout = ...
   timeout :: forall a. GHC.Types.Int -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -14765,7 +14765,7 @@ instance [safe] GHC.Internal.Exception.Type.Exception ghc-internal-9.1100.0:GHC.
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IOPort.IOPortException -- Defined in ‘GHC.Internal.IOPort’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.JS.Prim.JSException -- Defined in ‘GHC.Internal.JS.Prim’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.JS.Prim.WouldBlockException -- Defined in ‘GHC.Internal.JS.Prim’
-instance [safe] GHC.Internal.Exception.Type.Exception System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Internal.Exception.Type.Exception System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance forall a k (b :: k). GHC.Internal.Float.Floating a => GHC.Internal.Float.Floating (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
 instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Float.Floating (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Float.Floating (f (g a)) => GHC.Internal.Float.Floating (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
@@ -15573,7 +15573,7 @@ instance forall (c :: GHC.Types.Char). GHC.Internal.Show.Show (GHC.Internal.Type
 instance forall (s :: GHC.Types.Symbol). GHC.Internal.Show.Show (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
-instance [safe] GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Internal.StaticPtr.IsStatic GHC.Internal.StaticPtr.StaticPtr -- Defined in ‘GHC.Internal.StaticPtr’
@@ -15768,7 +15768,7 @@ instance forall (c :: GHC.Types.Char). GHC.Classes.Eq (GHC.Internal.TypeLits.SCh
 instance forall (s :: GHC.Types.Symbol). GHC.Classes.Eq (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Classes.Eq GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Classes.Eq GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
-instance [safe] GHC.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance GHC.Classes.Eq GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Classes.Eq GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance forall a. GHC.Classes.Ord a => GHC.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’


=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -10880,7 +10880,7 @@ module System.Posix.Types where
 
 
 module System.Timeout where
-  -- Safety: Safe
+  -- Safety: Trustworthy
   type Timeout :: *
   newtype Timeout = ...
   timeout :: forall a. GHC.Types.Int -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -11993,7 +11993,7 @@ instance GHC.Internal.Exception.Type.Exception GHC.Internal.Control.Exception.Ba
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Data.Dynamic.Dynamic -- Defined in ‘GHC.Internal.Data.Dynamic’
 instance [safe] GHC.Internal.Exception.Type.Exception ghc-internal-9.1100.0:GHC.Internal.IO.Handle.Lock.Common.FileLockingNotSupported -- Defined in ‘ghc-internal-9.1100.0:GHC.Internal.IO.Handle.Lock.Common’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IOPort.IOPortException -- Defined in ‘GHC.Internal.IOPort’
-instance [safe] GHC.Internal.Exception.Type.Exception System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Internal.Exception.Type.Exception System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance forall a k (b :: k). GHC.Internal.Float.Floating a => GHC.Internal.Float.Floating (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
 instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Float.Floating (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Float.Floating (f (g a)) => GHC.Internal.Float.Floating (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
@@ -12819,7 +12819,7 @@ instance forall (c :: GHC.Types.Char). GHC.Internal.Show.Show (GHC.Internal.Type
 instance forall (s :: GHC.Types.Symbol). GHC.Internal.Show.Show (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
-instance [safe] GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Internal.StaticPtr.IsStatic GHC.Internal.StaticPtr.StaticPtr -- Defined in ‘GHC.Internal.StaticPtr’
@@ -13017,7 +13017,7 @@ instance forall (c :: GHC.Types.Char). GHC.Classes.Eq (GHC.Internal.TypeLits.SCh
 instance forall (s :: GHC.Types.Symbol). GHC.Classes.Eq (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Classes.Eq GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Classes.Eq GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
-instance [safe] GHC.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance GHC.Classes.Eq GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Classes.Eq GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance forall a. GHC.Classes.Ord a => GHC.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’


=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -10612,7 +10612,7 @@ module System.Posix.Types where
 
 
 module System.Timeout where
-  -- Safety: Safe
+  -- Safety: Trustworthy
   type Timeout :: *
   newtype Timeout = ...
   timeout :: forall a. GHC.Types.Int -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -11728,7 +11728,7 @@ instance GHC.Internal.Exception.Type.Exception GHC.Internal.Control.Exception.Ba
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Data.Dynamic.Dynamic -- Defined in ‘GHC.Internal.Data.Dynamic’
 instance [safe] GHC.Internal.Exception.Type.Exception ghc-internal-9.1100.0:GHC.Internal.IO.Handle.Lock.Common.FileLockingNotSupported -- Defined in ‘ghc-internal-9.1100.0:GHC.Internal.IO.Handle.Lock.Common’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IOPort.IOPortException -- Defined in ‘GHC.Internal.IOPort’
-instance [safe] GHC.Internal.Exception.Type.Exception System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Internal.Exception.Type.Exception System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance forall a k (b :: k). GHC.Internal.Float.Floating a => GHC.Internal.Float.Floating (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
 instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Float.Floating (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Float.Floating (f (g a)) => GHC.Internal.Float.Floating (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
@@ -12541,7 +12541,7 @@ instance forall (c :: GHC.Types.Char). GHC.Internal.Show.Show (GHC.Internal.Type
 instance forall (s :: GHC.Types.Symbol). GHC.Internal.Show.Show (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Internal.Show.Show GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
-instance [safe] GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Internal.Show.Show System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Internal.Show.Show GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Internal.StaticPtr.IsStatic GHC.Internal.StaticPtr.StaticPtr -- Defined in ‘GHC.Internal.StaticPtr’
@@ -12741,7 +12741,7 @@ instance forall (c :: GHC.Types.Char). GHC.Classes.Eq (GHC.Internal.TypeLits.SCh
 instance forall (s :: GHC.Types.Symbol). GHC.Classes.Eq (GHC.Internal.TypeLits.SSymbol s) -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Classes.Eq GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
 instance GHC.Classes.Eq GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
-instance [safe] GHC.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’
+instance GHC.Classes.Eq System.Timeout.Timeout -- Defined in ‘System.Timeout’
 instance GHC.Classes.Eq GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance GHC.Classes.Eq GHC.Internal.Text.Read.Lex.Number -- Defined in ‘GHC.Internal.Text.Read.Lex’
 instance forall a. GHC.Classes.Ord a => GHC.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/810101b28e70c93f47be015ad6cc5968ad8dc793...bade7f85e1fcc71c5d8e30ac2d068eeef3bd833e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/810101b28e70c93f47be015ad6cc5968ad8dc793...bade7f85e1fcc71c5d8e30ac2d068eeef3bd833e
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241113/b131efbc/attachment-0001.html>


More information about the ghc-commits mailing list