[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Use consistent capitalization for "GHC Proposal" in user guide

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Fri Dec 6 16:56:07 UTC 2024



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
b69a7f3c by David Binder at 2024-12-04T18:37:42-05:00
Use consistent capitalization for "GHC Proposal" in user guide

- - - - -
18d9500d by David Binder at 2024-12-04T18:37:42-05:00
Fix reference to GHC proposal 193 in user guide

- - - - -
dd959406 by Ben Gamari at 2024-12-04T18:38:18-05:00
Revert "rts/Interpreter: Assert that TEST*_P discriminators are valid"

This assertion was based on the misconception that `GET_TAG` was
returning the pointer tag whereas it is actually returning the
constructor tag.

This reverts commit 9bf3663b9970851e7b5701d68147450272823197.

Fixes #25527.

- - - - -
cad6fede by Ben Gamari at 2024-12-04T18:38:54-05:00
rts/IOManager: Drop dead code

This assignment is dead code as it occurs after all branches have
returned. Moreover, it can't possibly be relevant since the "available"
branch already sets `flag`.

Potentially fixes #25542.

- - - - -
2fd7ade3 by Ben Gamari at 2024-12-06T11:55:52-05:00
ghc-internal: Drop GHC.Internal.Data.Enum

This module consists only of reexports and consequently there is no
reason for it to exist.

- - - - -
ca1390ca by Ben Gamari at 2024-12-06T11:55:52-05:00
base: Introduce Data.Bounded

As proposed in [CLC#208] but unfortunately `Data.Enum` was already
incorrectly introduced in the `ghc-internal` refactor.

[CLC#208]: https://github.com/haskell/core-libraries-committee/issues/208

- - - - -
cbd45044 by Ben Gamari at 2024-12-06T11:55:52-05:00
base: Deprecate export of Bounded from Data.Enum

This begins the process of bringing us into compliance with
[CLC#208].

[CLC#208]: https://github.com/haskell/core-libraries-committee/issues/208

- - - - -
d73ed3ed by Ben Gamari at 2024-12-06T11:55:52-05:00
base: Mention incorrect Data.Enum addition in changelog

- - - - -
23f1e3a7 by Ben Gamari at 2024-12-06T11:55:52-05:00
base: Reintroduce {Show,Enum} IoSubSystem

These instances were dropped in !9676 but not approved by the CLC.

Addresses #25549.

- - - - -


22 changed files:

- docs/users_guide/exts/primitives.rst
- docs/users_guide/exts/rewrite_rules.rst
- docs/users_guide/exts/stolen_syntax.rst
- docs/users_guide/exts/strict.rst
- docs/users_guide/runtime_control.rst
- docs/users_guide/using-warnings.rst
- docs/users_guide/using.rst
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/Data/Enum.hs → libraries/base/src/Data/Bounded.hs
- libraries/base/src/Data/Enum.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- rts/IOManager.c
- rts/Interpreter.c
- 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
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32


Changes:

=====================================
docs/users_guide/exts/primitives.rst
=====================================
@@ -322,7 +322,7 @@ Unlifted Newtypes
     Enable the use of newtypes over types with non-lifted runtime representations.
 
 GHC implements an :extension:`UnliftedNewtypes` extension as specified in
-`the GHC proposal #98 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0098-unlifted-newtypes.rst>`_.
+`the GHC Proposal #98 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0098-unlifted-newtypes.rst>`_.
 :extension:`UnliftedNewtypes` relaxes the restrictions around what types can appear inside
 of a ``newtype``. For example, the type ::
 
@@ -397,7 +397,7 @@ Unlifted Datatypes
     result kind.
 
 GHC implements the :extension:`UnliftedDatatypes` extension as specified in
-`the GHC proposal #265 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0265-unlifted-datatypes.rst>`_.
+`the GHC Proposal #265 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0265-unlifted-datatypes.rst>`_.
 :extension:`UnliftedDatatypes` relaxes the restrictions around what result kinds
 are allowed in data declarations. For example, the type ::
 


=====================================
docs/users_guide/exts/rewrite_rules.rst
=====================================
@@ -229,7 +229,7 @@ From a semantic point of view:
    because ``y`` can match against ``0``.
 
 -  GHC implements **higher order matching** as described by
-   `GHC proposal #555 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0555-template-patterns.rst>`_.
+   `GHC Proposal #555 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0555-template-patterns.rst>`_.
    When a pattern variable is applied to distinct locally bound variables it forms
    what we call a **higher order pattern**.
    When matching, higher order patterns are treated like pattern variables, but they are


=====================================
docs/users_guide/exts/stolen_syntax.rst
=====================================
@@ -28,8 +28,8 @@ The following syntax is stolen:
        single: forall
 
     Stolen (in types) by default (see :ref:`infelicities-lexical`). ``forall`` is
-    a reserved keyword and never a type variable, in accordance with `GHC Proposal #43
-    <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0043-forall-keyword.rst>`__.
+    a reserved keyword and never a type variable, in accordance with `GHC Proposal #193
+    <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0193-forall-keyword.rst>`__.
 
 
 ``mdo``


=====================================
docs/users_guide/exts/strict.rst
=====================================
@@ -528,7 +528,7 @@ that (SPLIT-STRICT) uses a bang-pattern in the ``case`` in the desugared right-h
 
 Note that rule (CASE) applies only when any of the *binders* is unlifted;
 it is irrelevant whether the binding *itself* is unlifted (see
-`GHC proposal #35 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0035-unbanged-strict-patterns.rst>`__).
+`GHC Proposal #35 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0035-unbanged-strict-patterns.rst>`__).
 For example (see :ref:`primitives`)::
 
     let (# a::Int, b::Bool #) = e in body


=====================================
docs/users_guide/runtime_control.rst
=====================================
@@ -1391,7 +1391,7 @@ and can be controlled by the following flags.
 
     The default for this flag is currently ``--read-tix-file=yes`` but will change
     to ``-read-tix-file=no`` in a future version of GHC according to the accepted
-    `GHC proposal 612 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0612-fhpc-accumulation.md>`__.
+    `GHC Proposal 612 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0612-fhpc-accumulation.md>`__.
 
 .. rts-flag:: --write-tix-file=<yes|no>
 


=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -1546,7 +1546,7 @@ of ``-W(no-)*``.
      The use of ``*`` to denote the kind of inhabited types relies on the
      :extension:`StarIsType` extension, which in a future release will be
      turned off by default and then possibly removed. The reasons for this and
-     the deprecation schedule are described in `GHC proposal #143
+     the deprecation schedule are described in `GHC Proposal #143
      <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0143-remove-star-kind.rst>`__.
 
      This warning allows to detect such uses of ``*`` before the actual


=====================================
docs/users_guide/using.rst
=====================================
@@ -752,7 +752,7 @@ search path (see :ref:`search-path`).
 GHC Jobserver Protocol
 ~~~~~~~~~~~~~~~~~~~~~~
 
-The GHC Jobserver Protocol was specified in `GHC proposal #540 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0540-jsem.rst>`__.
+The GHC Jobserver Protocol was specified in `GHC Proposal #540 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0540-jsem.rst>`__.
 
 This protocol allows
 a server to dynamically invoke many instances of a client process,


=====================================
libraries/base/base.cabal.in
=====================================
@@ -46,8 +46,10 @@ Library
         , Data.Bifoldable1
         , Data.Bifunctor
         , Data.Bitraversable
+        , Data.Bounded
         , Data.Char
         , Data.Complex
+        , Data.Enum
         , Data.Fixed
         , Data.Foldable1
         , Data.Functor.Classes
@@ -95,7 +97,6 @@ Library
         , Data.Dynamic
         , Data.Either
         , Data.Eq
-        , Data.Enum
         , Data.Foldable
         , Data.Function
         , Data.Functor


=====================================
libraries/base/changelog.md
=====================================
@@ -7,6 +7,8 @@
   * `Data.List.NonEmpty.{init,last,tails1}` are now defined using only total functions (rather than partial ones). ([CLC proposal #293](https://github.com/haskell/core-libraries-committee/issues/293))
 
 ## 4.21.0.0 *TBA*
+  * Introduce `Data.Bounded` module exporting the `Bounded` typeclass (finishing [CLC proposal #208](https://github.com/haskell/core-libraries-committee/issues/208))
+  * Deprecate export of `Bounded` class from `Data.Enum` ([CLC proposal #208](https://github.com/haskell/core-libraries-committee/issues/208))
   * `GHC.Desugar` has been deprecated and should be removed in GHC 9.14. ([CLC proposal #216](https://github.com/haskell/core-libraries-committee/issues/216))
   * Add a `readTixFile` field to the `HpcFlags` record in `GHC.RTS.Flags` ([CLC proposal #276](https://github.com/haskell/core-libraries-committee/issues/276))
   * Add `compareLength` to `Data.List` and `Data.List.NonEmpty` ([CLC proposal #257](https://github.com/haskell/core-libraries-committee/issues/257))
@@ -51,8 +53,9 @@
           `ioError` to prevent leaking the implementation of these error functions
           into the callstack.
 
-## 4.20.0.0 May 2024
+## 4.20.0.0 *May 2024*
   * Shipped with GHC 9.10.1
+  * Introduce `Data.Enum` module exporting both `Enum` and `Bounded`. Note that the export of `Bounded` will be deprecated in a future release ([CLC proposal #208](https://github.com/haskell/core-libraries-committee/issues/208))
   * Deprecate `GHC.Pack` ([#21461](https://gitlab.haskell.org/ghc/ghc/-/issues/21461))
   * Export `foldl'` from `Prelude` ([CLC proposal #167](https://github.com/haskell/core-libraries-committee/issues/167))
   * The top-level handler for uncaught exceptions now displays the output of `displayException` rather than `show`  ([CLC proposal #198](https://github.com/haskell/core-libraries-committee/issues/198))


=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Enum.hs → libraries/base/src/Data/Bounded.hs
=====================================
@@ -1,22 +1,25 @@
+{-# LANGUAGE Safe #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -----------------------------------------------------------------------------
 -- |
--- Module      :  GHC.Internal.Data.Enum
+-- Module      :  Data.Bounded
 -- Copyright   :  (c) The University of Glasgow, 1992-2002
 -- License     :  see libraries/base/LICENSE
 --
--- Maintainer  :  ghc-devs at haskell.org
+-- Maintainer  :  cvs-ghc at haskell.org
 -- Stability   :  stable
 -- Portability :  non-portable (GHC extensions)
 --
--- The 'Enum' and 'Bounded' classes.
+-- The 'Bounded' class.
+--
+-- @since 4.22.0.0
 --
 -----------------------------------------------------------------------------
 
-module GHC.Internal.Data.Enum
+module Data.Bounded
     ( Bounded(..)
-    , Enum(..)
     ) where
 
-import GHC.Internal.Enum
+import GHC.Enum
+


=====================================
libraries/base/src/Data/Enum.hs
=====================================
@@ -1,7 +1,8 @@
 {-# LANGUAGE Safe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
+-----------------------------------------------------------------------------
 -- |
---
 -- Module      :  Data.Enum
 -- Copyright   :  (c) The University of Glasgow, 1992-2002
 -- License     :  see libraries/base/LICENSE
@@ -10,12 +11,16 @@
 -- Stability   :  stable
 -- Portability :  non-portable (GHC extensions)
 --
--- The 'Enum' and 'Bounded' classes.
+-- The 'Enum' class.
+--
+-- @since 4.20.0.0
 --
+-----------------------------------------------------------------------------
 
 module Data.Enum
-    (Bounded(..),
-     Enum(..)
-     ) where
+    ( Enum(..)
+    , {-# DEPRECATED "Bounded should be imported from Data.Bounded" #-}
+      Bounded(..)
+    ) where
 
-import GHC.Internal.Data.Enum
\ No newline at end of file
+import GHC.Internal.Enum


=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -117,7 +117,6 @@ Library
         GHC.Internal.Data.Dynamic
         GHC.Internal.Data.Either
         GHC.Internal.Data.Eq
-        GHC.Internal.Data.Enum
         GHC.Internal.Data.Foldable
         GHC.Internal.Data.Function
         GHC.Internal.Data.Functor


=====================================
libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs
=====================================
@@ -1,6 +1,7 @@
 {-# LANGUAGE Trustworthy       #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE CPP               #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -34,6 +35,8 @@ module GHC.Internal.IO.SubSystem (
  ) where
 
 import GHC.Internal.Base
+import GHC.Internal.Show
+import GHC.Internal.Enum
 
 #if defined(mingw32_HOST_OS)
 import GHC.Internal.IO.Unsafe
@@ -55,6 +58,10 @@ data IoSubSystem
               --   native APIs for I/O, including IOCP and RIO.
   deriving (Eq)
 
+-- N.B. These are currently unused by GHC but is needed for stability of @base at .
+deriving instance Enum IoSubSystem
+deriving instance Show IoSubSystem
+
 -- | Conditionally execute an action depending on the configured I/O subsystem.
 -- On POSIX systems always execute the first action.
 -- On Windows execute the second action if WINIO as active, otherwise fall back to


=====================================
libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
=====================================
@@ -18,7 +18,7 @@ import GHC.Generics (Generic)
 import GHC.Internal.Base
 import GHC.Internal.Show
 import GHC.Internal.Generics
-import GHC.Internal.Data.Enum
+import GHC.Internal.Enum
 #endif
 
 -- | The language extensions known to GHC.


=====================================
rts/IOManager.c
=====================================
@@ -110,7 +110,6 @@ parseIOManagerFlag(const char *iomgrstr, IO_MANAGER_FLAG *flag)
 #else
         return IOManagerUnavailable;
 #endif
-        *flag = IO_MNGR_FLAG_MIO;
     }
     else if (strcmp("winio", iomgrstr) == 0) {
 #if defined(IOMGR_ENABLED_WINIO)


=====================================
rts/Interpreter.c
=====================================
@@ -1785,7 +1785,6 @@ run_BCO:
         case bci_TESTLT_P: {
             unsigned int discr  = BCO_NEXT;
             int failto = BCO_GET_LARGE_ARG;
-            ASSERT(discr <= TAG_MASK);
             StgClosure* con = UNTAG_CLOSURE((StgClosure*)SpW(0));
             if (GET_TAG(con) >= discr) {
                 bciPtr = failto;
@@ -1796,7 +1795,6 @@ run_BCO:
         case bci_TESTEQ_P: {
             unsigned int discr  = BCO_NEXT;
             int failto = BCO_GET_LARGE_ARG;
-            ASSERT(discr <= TAG_MASK);
             StgClosure* con = UNTAG_CLOSURE((StgClosure*)SpW(0));
             if (GET_TAG(con) != discr) {
                 bciPtr = failto;


=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -751,6 +751,14 @@ module Data.Bool where
   otherwise :: Bool
   (||) :: Bool -> Bool -> Bool
 
+module Data.Bounded where
+  -- Safety: Safe
+  type Bounded :: * -> Constraint
+  class Bounded a where
+    minBound :: a
+    maxBound :: a
+    {-# MINIMAL minBound, maxBound #-}
+
 module Data.Char where
   -- Safety: Trustworthy
   type Char :: *
@@ -11536,10 +11544,6 @@ instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Ior a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
-instance GHC.Internal.Enum.Bounded GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
-instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k (t :: k). GHC.Internal.Enum.Bounded (GHC.Internal.Data.Proxy.Proxy t) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance GHC.Internal.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
@@ -11564,6 +11568,10 @@ instance GHC.Internal.Enum.Bounded () -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Bounded GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
+instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k (t :: k). GHC.Internal.Enum.Bounded (GHC.Internal.Data.Proxy.Proxy t) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Enum.Bounded (f (g a)) => GHC.Internal.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
 instance GHC.Internal.Enum.Bounded GHC.Internal.Int.Int16 -- Defined in ‘GHC.Internal.Int’
@@ -11618,10 +11626,6 @@ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Inter
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Ior a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
-instance GHC.Internal.Enum.Enum GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
-instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k (s :: k). GHC.Internal.Enum.Enum (GHC.Internal.Data.Proxy.Proxy s) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance GHC.Internal.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
@@ -11634,6 +11638,10 @@ instance GHC.Internal.Enum.Enum () -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
+instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k (s :: k). GHC.Internal.Enum.Enum (GHC.Internal.Data.Proxy.Proxy s) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall k (a :: k). GHC.Internal.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Enum.Enum (f (g a)) => GHC.Internal.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
@@ -11692,6 +11700,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.Generics.SourceStrictness -- Define
 instance GHC.Internal.Enum.Enum GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
 instance GHC.Internal.Enum.Enum GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
 instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
+instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoCostCentres -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoHeapProfile -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoTrace -- Defined in ‘GHC.Internal.RTS.Flags’
@@ -12514,6 +12523,7 @@ instance GHC.Internal.Show.Show GHC.Internal.IO.Handle.Types.NewlineMode -- Defi
 instance [safe] GHC.Internal.Show.Show 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.Show.Show GHC.Internal.IO.Handle.HandlePosn -- Defined in ‘GHC.Internal.IO.Handle’
 instance GHC.Internal.Show.Show GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
+instance GHC.Internal.Show.Show GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance GHC.Internal.Show.Show GHC.Internal.IOPort.IOPortException -- Defined in ‘GHC.Internal.IOPort’
 instance GHC.Internal.Show.Show GHC.Internal.InfoProv.Types.InfoProv -- Defined in ‘GHC.Internal.InfoProv.Types’
 instance GHC.Internal.Show.Show GHC.Internal.RTS.Flags.CCFlags -- Defined in ‘GHC.Internal.RTS.Flags’


=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -751,6 +751,14 @@ module Data.Bool where
   otherwise :: Bool
   (||) :: Bool -> Bool -> Bool
 
+module Data.Bounded where
+  -- Safety: Safe
+  type Bounded :: * -> Constraint
+  class Bounded a where
+    minBound :: a
+    maxBound :: a
+    {-# MINIMAL minBound, maxBound #-}
+
 module Data.Char where
   -- Safety: Trustworthy
   type Char :: *
@@ -14571,10 +14579,6 @@ instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Ior a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
-instance GHC.Internal.Enum.Bounded GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
-instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k (t :: k). GHC.Internal.Enum.Bounded (GHC.Internal.Data.Proxy.Proxy t) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance GHC.Internal.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
@@ -14599,6 +14603,10 @@ instance GHC.Internal.Enum.Bounded () -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Bounded GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
+instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k (t :: k). GHC.Internal.Enum.Bounded (GHC.Internal.Data.Proxy.Proxy t) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Enum.Bounded (f (g a)) => GHC.Internal.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
 instance GHC.Internal.Enum.Bounded GHC.Internal.Int.Int16 -- Defined in ‘GHC.Internal.Int’
@@ -14653,10 +14661,6 @@ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Inter
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Ior a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
-instance GHC.Internal.Enum.Enum GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
-instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k (s :: k). GHC.Internal.Enum.Enum (GHC.Internal.Data.Proxy.Proxy s) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance GHC.Internal.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
@@ -14669,6 +14673,10 @@ instance GHC.Internal.Enum.Enum () -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
+instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k (s :: k). GHC.Internal.Enum.Enum (GHC.Internal.Data.Proxy.Proxy s) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall k (a :: k). GHC.Internal.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Enum.Enum (f (g a)) => GHC.Internal.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
@@ -14727,6 +14735,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.Generics.SourceStrictness -- Define
 instance GHC.Internal.Enum.Enum GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
 instance GHC.Internal.Enum.Enum GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
 instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
+instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoCostCentres -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoHeapProfile -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoTrace -- Defined in ‘GHC.Internal.RTS.Flags’
@@ -15544,6 +15553,7 @@ instance GHC.Internal.Show.Show GHC.Internal.IO.Handle.Types.NewlineMode -- Defi
 instance [safe] GHC.Internal.Show.Show 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.Show.Show GHC.Internal.IO.Handle.HandlePosn -- Defined in ‘GHC.Internal.IO.Handle’
 instance GHC.Internal.Show.Show GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
+instance GHC.Internal.Show.Show GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance GHC.Internal.Show.Show GHC.Internal.IOPort.IOPortException -- Defined in ‘GHC.Internal.IOPort’
 instance GHC.Internal.Show.Show GHC.Internal.InfoProv.Types.InfoProv -- Defined in ‘GHC.Internal.InfoProv.Types’
 instance GHC.Internal.Show.Show GHC.Internal.JS.Prim.JSException -- Defined in ‘GHC.Internal.JS.Prim’


=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -751,6 +751,14 @@ module Data.Bool where
   otherwise :: Bool
   (||) :: Bool -> Bool -> Bool
 
+module Data.Bounded where
+  -- Safety: Safe
+  type Bounded :: * -> Constraint
+  class Bounded a where
+    minBound :: a
+    maxBound :: a
+    {-# MINIMAL minBound, maxBound #-}
+
 module Data.Char where
   -- Safety: Trustworthy
   type Char :: *
@@ -11800,10 +11808,6 @@ instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Ior a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
-instance GHC.Internal.Enum.Bounded GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
-instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k (t :: k). GHC.Internal.Enum.Bounded (GHC.Internal.Data.Proxy.Proxy t) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance GHC.Internal.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
@@ -11828,6 +11832,10 @@ instance GHC.Internal.Enum.Bounded () -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Bounded GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
+instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k (t :: k). GHC.Internal.Enum.Bounded (GHC.Internal.Data.Proxy.Proxy t) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Enum.Bounded (f (g a)) => GHC.Internal.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
 instance GHC.Internal.Enum.Bounded GHC.Internal.Int.Int16 -- Defined in ‘GHC.Internal.Int’
@@ -11882,10 +11890,6 @@ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Inter
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Ior a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
-instance GHC.Internal.Enum.Enum GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
-instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k (s :: k). GHC.Internal.Enum.Enum (GHC.Internal.Data.Proxy.Proxy s) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance GHC.Internal.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
@@ -11898,6 +11902,10 @@ instance GHC.Internal.Enum.Enum () -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
+instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k (s :: k). GHC.Internal.Enum.Enum (GHC.Internal.Data.Proxy.Proxy s) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall k (a :: k). GHC.Internal.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Enum.Enum (f (g a)) => GHC.Internal.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
@@ -11957,6 +11965,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.Generics.SourceStrictness -- Define
 instance GHC.Internal.Enum.Enum GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
 instance GHC.Internal.Enum.Enum GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
 instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
+instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoCostCentres -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoHeapProfile -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoTrace -- Defined in ‘GHC.Internal.RTS.Flags’
@@ -12789,6 +12798,7 @@ instance GHC.Internal.Show.Show GHC.Internal.IO.Handle.Types.NewlineMode -- Defi
 instance [safe] GHC.Internal.Show.Show 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.Show.Show GHC.Internal.IO.Handle.HandlePosn -- Defined in ‘GHC.Internal.IO.Handle’
 instance GHC.Internal.Show.Show GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
+instance GHC.Internal.Show.Show GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance GHC.Internal.Show.Show GHC.Internal.IO.Windows.Handle.CONSOLE_READCONSOLE_CONTROL -- Defined in ‘GHC.Internal.IO.Windows.Handle’
 instance GHC.Internal.Show.Show (GHC.Internal.IO.Windows.Handle.Io GHC.Internal.IO.Windows.Handle.NativeHandle) -- Defined in ‘GHC.Internal.IO.Windows.Handle’
 instance GHC.Internal.Show.Show (GHC.Internal.IO.Windows.Handle.Io GHC.Internal.IO.Windows.Handle.ConsoleHandle) -- Defined in ‘GHC.Internal.IO.Windows.Handle’


=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -751,6 +751,14 @@ module Data.Bool where
   otherwise :: Bool
   (||) :: Bool -> Bool -> Bool
 
+module Data.Bounded where
+  -- Safety: Safe
+  type Bounded :: * -> Constraint
+  class Bounded a where
+    minBound :: a
+    maxBound :: a
+    {-# MINIMAL minBound, maxBound #-}
+
 module Data.Char where
   -- Safety: Trustworthy
   type Char :: *
@@ -11536,10 +11544,6 @@ instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Ior a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
-instance GHC.Internal.Enum.Bounded GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
-instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k (t :: k). GHC.Internal.Enum.Bounded (GHC.Internal.Data.Proxy.Proxy t) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance GHC.Internal.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
@@ -11564,6 +11568,10 @@ instance GHC.Internal.Enum.Bounded () -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Bounded GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
+instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Bounded (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k (t :: k). GHC.Internal.Enum.Bounded (GHC.Internal.Data.Proxy.Proxy t) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Enum.Bounded (f (g a)) => GHC.Internal.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
 instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
 instance GHC.Internal.Enum.Bounded GHC.Internal.Int.Int16 -- Defined in ‘GHC.Internal.Int’
@@ -11618,10 +11626,6 @@ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Inter
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Ior a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
-instance GHC.Internal.Enum.Enum GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
-instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k (s :: k). GHC.Internal.Enum.Enum (GHC.Internal.Data.Proxy.Proxy s) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance GHC.Internal.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
@@ -11634,6 +11638,10 @@ instance GHC.Internal.Enum.Enum () -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Unicode’
+instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Internal.Enum.Enum (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
+instance forall k (s :: k). GHC.Internal.Enum.Enum (GHC.Internal.Data.Proxy.Proxy s) -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall k (a :: k). GHC.Internal.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
 instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Enum.Enum (f (g a)) => GHC.Internal.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
@@ -11692,6 +11700,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.Generics.SourceStrictness -- Define
 instance GHC.Internal.Enum.Enum GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
 instance GHC.Internal.Enum.Enum GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
 instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
+instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoCostCentres -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoHeapProfile -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoTrace -- Defined in ‘GHC.Internal.RTS.Flags’
@@ -12514,6 +12523,7 @@ instance GHC.Internal.Show.Show GHC.Internal.IO.Handle.Types.NewlineMode -- Defi
 instance [safe] GHC.Internal.Show.Show 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.Show.Show GHC.Internal.IO.Handle.HandlePosn -- Defined in ‘GHC.Internal.IO.Handle’
 instance GHC.Internal.Show.Show GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
+instance GHC.Internal.Show.Show GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance GHC.Internal.Show.Show GHC.Internal.IOPort.IOPortException -- Defined in ‘GHC.Internal.IOPort’
 instance GHC.Internal.Show.Show GHC.Internal.InfoProv.Types.InfoProv -- Defined in ‘GHC.Internal.InfoProv.Types’
 instance GHC.Internal.Show.Show GHC.Internal.RTS.Flags.CCFlags -- Defined in ‘GHC.Internal.RTS.Flags’


=====================================
testsuite/tests/interface-stability/ghc-experimental-exports.stdout
=====================================
@@ -10714,6 +10714,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoHeapProfile -- Defined
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoTrace -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.GiveGCStats -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.Internal.RTS.Flags’
+instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance forall a. GHC.Internal.Float.Floating a => GHC.Internal.Float.Floating (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
 instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Float.RealFloat (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
 instance forall a. GHC.Internal.Foreign.Storable.Storable a => GHC.Internal.Foreign.Storable.Storable (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
@@ -10767,6 +10768,7 @@ instance GHC.Internal.Show.Show GHC.Internal.RTS.Flags.ProfFlags -- Defined in 
 instance GHC.Internal.Show.Show GHC.Internal.RTS.Flags.RTSFlags -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Show.Show GHC.Internal.RTS.Flags.TickyFlags -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Show.Show GHC.Internal.RTS.Flags.TraceFlags -- Defined in ‘GHC.Internal.RTS.Flags’
+instance GHC.Internal.Show.Show GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance GHC.Internal.Show.Show GHC.Internal.Stats.GCDetails -- Defined in ‘GHC.Internal.Stats’
 instance GHC.Internal.Show.Show GHC.Internal.Stats.RTSStats -- Defined in ‘GHC.Internal.Stats’
 instance GHC.Classes.Eq GHC.Types.Bool -- Defined in ‘GHC.Classes’


=====================================
testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
=====================================
@@ -10717,6 +10717,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoHeapProfile -- Defined
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoTrace -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.GiveGCStats -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.Internal.RTS.Flags’
+instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance forall a. GHC.Internal.Float.Floating a => GHC.Internal.Float.Floating (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
 instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Float.RealFloat (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
 instance forall a. GHC.Internal.Foreign.Storable.Storable a => GHC.Internal.Foreign.Storable.Storable (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
@@ -10770,6 +10771,7 @@ instance GHC.Internal.Show.Show GHC.Internal.RTS.Flags.ProfFlags -- Defined in 
 instance GHC.Internal.Show.Show GHC.Internal.RTS.Flags.RTSFlags -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Show.Show GHC.Internal.RTS.Flags.TickyFlags -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Show.Show GHC.Internal.RTS.Flags.TraceFlags -- Defined in ‘GHC.Internal.RTS.Flags’
+instance GHC.Internal.Show.Show GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
 instance GHC.Internal.Show.Show GHC.Internal.Stats.GCDetails -- Defined in ‘GHC.Internal.Stats’
 instance GHC.Internal.Show.Show GHC.Internal.Stats.RTSStats -- Defined in ‘GHC.Internal.Stats’
 instance GHC.Classes.Eq GHC.Types.Bool -- Defined in ‘GHC.Classes’



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48c9283abcd713104099366b9f7f867ec8ca9299...23f1e3a71c7308bc9bcb7b9816c4daedd5d7e611

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48c9283abcd713104099366b9f7f867ec8ca9299...23f1e3a71c7308bc9bcb7b9816c4daedd5d7e611
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/20241206/90b44522/attachment-0001.html>


More information about the ghc-commits mailing list