[Git][ghc/ghc][wip/clc275] 4 commits: compiler: Fix pretty printing of ticked prefix constructors (#24237)
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Wed Aug 21 12:13:30 UTC 2024
Andreas Klebinger pushed to branch wip/clc275 at Glasgow Haskell Compiler / GHC
Commits:
5f972bfb by Zubin Duggal at 2024-08-21T03:18:15-04:00
compiler: Fix pretty printing of ticked prefix constructors (#24237)
- - - - -
ef0a08e7 by Mike Pilgrem at 2024-08-21T03:18:57-04:00
Fix #15773 Clarify further -rtsopts 'defaults' in docs
- - - - -
05a4be58 by Sebastian Graf at 2024-08-21T03:19:33-04:00
Improve efficiency of `assertError` (#24625)
... by moving `lazy` to the exception-throwing branch.
It's all documented in `Note [Strictness of assertError]`.
- - - - -
226c631c by Ben Gamari at 2024-08-21T14:13:06+02:00
base: Add `HasCallStack` constraint to `ioError`
As proposed in core-libraries-committee#275.
- - - - -
27 changed files:
- compiler/GHC/Iface/Type.hs
- docs/users_guide/phases.rst
- libraries/base/changelog.md
- libraries/base/tests/IO/T21336/T21336b.stderr
- libraries/base/tests/IO/T4808.stderr
- libraries/base/tests/IO/mkdirExists.stderr
- libraries/base/tests/IO/openFile002.stderr
- libraries/base/tests/IO/openFile002.stderr-mingw32
- libraries/base/tests/IO/withBinaryFile001.stderr
- libraries/base/tests/IO/withBinaryFile002.stderr
- libraries/base/tests/IO/withFile001.stderr
- libraries/base/tests/IO/withFile002.stderr
- libraries/base/tests/IO/withFileBlocking001.stderr
- libraries/base/tests/IO/withFileBlocking002.stderr
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- 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/printer/T24237.hs
- + testsuite/tests/printer/T24237.stderr
- testsuite/tests/printer/all.T
- testsuite/tests/runghc/T7859.stderr-mingw32
- + testsuite/tests/simplCore/should_compile/T24625.hs
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
Changes:
=====================================
compiler/GHC/Iface/Type.hs
=====================================
@@ -1847,17 +1847,16 @@ ppr_iface_tc_app pp ctxt_prec tc tys =
| tc `ifaceTyConHasKey` liftedTypeKindTyConKey
-> ppr_kind_type ctxt_prec
- | not (isSymOcc (nameOccName (ifaceTyConName tc)))
- -> pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)
+ | isSymOcc (nameOccName (ifaceTyConName tc))
- | [ ty1@(_, Required), ty2@(_, Required) ] <- tys
+ , [ ty1@(_, Required), ty2@(_, Required) ] <- tys
-- Infix, two visible arguments (we know nothing of precedence though).
-- Don't apply this special case if one of the arguments is invisible,
-- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).
- -> pprIfaceInfixApp ctxt_prec (ppr tc) (pp opPrec ty1) (pp opPrec ty2)
+ -> pprIfaceInfixApp ctxt_prec (pprIfaceTyCon tc) (pp opPrec ty1) (pp opPrec ty2)
| otherwise
- -> pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)
+ -> pprIfacePrefixApp ctxt_prec (pprParendIfaceTyCon tc) (map (pp appPrec) tys)
data TupleOrSum = IsSum | IsTuple TupleSort
deriving (Eq)
@@ -2070,7 +2069,18 @@ instance Outputable IfLclName where
ppr = ppr . ifLclNameFS
instance Outputable IfaceTyCon where
- ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)
+ ppr = pprIfaceTyCon
+
+-- | Print an `IfaceTyCon` with a promotion tick if needed, without parens,
+-- suitable for use in infix contexts
+pprIfaceTyCon :: IfaceTyCon -> SDoc
+pprIfaceTyCon tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)
+
+-- | Print an `IfaceTyCon` with a promotion tick if needed, possibly with parens,
+-- suitable for use in prefix contexts
+pprParendIfaceTyCon :: IfaceTyCon -> SDoc
+pprParendIfaceTyCon tc = pprPromotionQuote tc <> pprPrefixVar (isSymOcc (nameOccName tc_name)) (ppr tc_name)
+ where tc_name = ifaceTyConName tc
instance Outputable IfaceTyConInfo where
ppr (IfaceTyConInfo { ifaceTyConIsPromoted = prom
=====================================
docs/users_guide/phases.rst
=====================================
@@ -1151,8 +1151,9 @@ for example).
:shortdesc: Control whether the RTS behaviour can be tweaked via command-line
flags and the ``GHCRTS`` environment variable. Using ``none``
means no RTS flags can be given; ``some`` means only a minimum
- of safe options can be given (the default); ``all`` (or no
- argument at all) means that all RTS flags are permitted; ``ignore``
+ of safe options can be given (the default, if ``-rtsopts`` is
+ not passed); ``all`` means that all RTS flags are permitted (the
+ default, if ``-rtsopts`` is passed with no argument); ``ignore``
means RTS flags can be given, but are treated as regular arguments and
passed to the Haskell program as arguments; ``ignoreAll`` is the same as
``ignore``, but ``GHCRTS`` is also ignored. ``-rtsopts`` does not
@@ -1161,11 +1162,12 @@ for example).
:type: dynamic
:category: linking
- :default: some
+ :default: ``some``, if ``-rtsopts`` is not passed; ``all``, if ``-rtsopts``
+ is passed with no argument.
This option affects the processing of RTS control options given
either on the command line or via the :envvar:`GHCRTS` environment
- variable. There are five possibilities:
+ variable. There are six possibilities:
``-rtsopts=none``
Disable all processing of RTS options. If ``+RTS`` appears
@@ -1181,18 +1183,22 @@ for example).
``GHCRTS`` options will be processed normally.
``-rtsopts=ignoreAll``
- Same as ``ignore`` but also ignores ``GHCRTS``.
+ Same as ``ignore`` with the exception of ``GHCRTS`` options, which are
+ also ignored.
``-rtsopts=some``
- [this is the default setting] Enable only the "safe" RTS
- options: (Currently only ``-?`` and ``--info``.) Any other RTS
- options on the command line or in the ``GHCRTS`` environment
- variable causes the program with to abort with an error message.
+ [this is the default setting, if ``-rtsopts`` is not passed] Enable only
+ the "safe" RTS options: (Currently only ``-?`` and ``--info``.) Any
+ other RTS options on the command line or in the ``GHCRTS`` environment
+ variable causes the program to abort with an error message.
- ``-rtsopts=all`` or just ``-rtsopts``
+ ``-rtsopts=all``
Enable *all* RTS option processing, both on the command line and
through the ``GHCRTS`` environment variable.
+ ``-rtsopts``
+ Equivalent to ``-rtsopts=all``.
+
In GHC 6.12.3 and earlier, the default was to process all RTS
options. However, since RTS options can be used to write logging
data to arbitrary files under the security context of the running
=====================================
libraries/base/changelog.md
=====================================
@@ -14,6 +14,7 @@
* Add `inits1` and `tails1` to `Data.List`, factored from the corresponding functions in `Data.List.NonEmpty` ([CLC proposal #252](https://github.com/haskell/core-libraries-committee/issues/252))
* Add `firstA` and `secondA` to `Data.Bitraversable`. ([CLC proposal #172](https://github.com/haskell/core-libraries-committee/issues/172))
* Deprecate `GHC.TypeNats.Internal`, `GHC.TypeLits.Internal`, `GHC.ExecutionStack.Internal` ([CLC proposal #217](https://github.com/haskell/core-libraries-committee/issues/217))
+ * `System.IO.Error.ioError` and `Control.Exception.ioError` now both carry `HasCallStack` constraints ([CLC proposal #275](https://github.com/haskell/core-libraries-committee/issues/275))
* Define `Eq1`, `Ord1`, `Show1` and `Read1` instances for basic `Generic` representation types. ([CLC proposal #273](https://github.com/haskell/core-libraries-committee/issues/273))
* Add exception type metadata to default exception handler output.
([CLC proposal #231](https://github.com/haskell/core-libraries-committee/issues/231)
=====================================
libraries/base/tests/IO/T21336/T21336b.stderr
=====================================
@@ -5,10 +5,10 @@ Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
-
+ collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs:187:13 in ghc-internal:GHC.Internal.IO.Handle.Internals
=====================================
libraries/base/tests/IO/T4808.stderr
=====================================
@@ -7,10 +7,10 @@ Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
-
+ collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs:187:13 in ghc-internal:GHC.Internal.IO.Handle.Internals
=====================================
libraries/base/tests/IO/mkdirExists.stderr
=====================================
@@ -7,10 +7,10 @@ Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
-
+ collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries/unix/System/Posix/PosixPath/FilePath.hsc:106:5 in unix-2.8.5.1-inplace:System.Posix.PosixPath.FilePath
=====================================
libraries/base/tests/IO/openFile002.stderr
=====================================
@@ -7,10 +7,10 @@ Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
-
+ collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs:156:12 in ghc-internal:GHC.Internal.IO.Handle.FD
=====================================
libraries/base/tests/IO/openFile002.stderr-mingw32
=====================================
@@ -1,13 +1,15 @@
-openFile002: Exception:
+openFile002.exe: Exception:
-nonexistent: openFile: does not exist (The system cannot find the file specified.)
+nonexistent: openFile: does not exist (No such file or directory)
Package: ghc-internal
Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:<line>:<column> in <package-id>:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.IO.Exception
+ collectBacktraces, called at libraries\ghc-internal\src\GHC\Internal\Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries\ghc-internal\src\GHC\Internal\IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries\ghc-internal\src\GHC\Internal\IO\Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries\ghc-internal\src\GHC\Internal\IO\Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries\ghc-internal\src\GHC\Internal\IO\Handle\FD.hs:156:12 in ghc-internal:GHC.Internal.IO.Handle.FD
+
=====================================
libraries/base/tests/IO/withBinaryFile001.stderr
=====================================
@@ -7,10 +7,10 @@ Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
-
+ collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs:239:12 in ghc-internal:GHC.Internal.IO.Handle.FD
=====================================
libraries/base/tests/IO/withBinaryFile002.stderr
=====================================
@@ -7,10 +7,10 @@ Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
-
+ collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs:240:16 in ghc-internal:GHC.Internal.IO.Handle.FD
=====================================
libraries/base/tests/IO/withFile001.stderr
=====================================
@@ -7,10 +7,10 @@ Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
-
+ collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs:171:12 in ghc-internal:GHC.Internal.IO.Handle.FD
=====================================
libraries/base/tests/IO/withFile002.stderr
=====================================
@@ -7,10 +7,10 @@ Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
-
+ collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs:172:16 in ghc-internal:GHC.Internal.IO.Handle.FD
=====================================
libraries/base/tests/IO/withFileBlocking001.stderr
=====================================
@@ -7,10 +7,10 @@ Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
-
+ collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs:207:12 in ghc-internal:GHC.Internal.IO.Handle.FD
=====================================
libraries/base/tests/IO/withFileBlocking002.stderr
=====================================
@@ -7,10 +7,10 @@ Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
-
+ collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs:208:16 in ghc-internal:GHC.Internal.IO.Handle.FD
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
=====================================
@@ -315,8 +315,8 @@ ioException :: HasCallStack => IOException -> IO a
ioException err = throwIO err
-- | Raise an 'IOError' in the 'IO' monad.
-ioError :: IOError -> IO a
-ioError = ioException
+ioError :: HasCallStack => IOError -> IO a
+ioError err = ioException err
-- ---------------------------------------------------------------------------
-- IOError type
@@ -438,13 +438,10 @@ instance Show IOException where
"" -> id
_ -> showString " (" . showString s . showString ")")
--- Note the use of "lazy". This means that
--- assert False (throw e)
--- will throw the assertion failure rather than e. See trac #5561.
assertError :: (?callStack :: CallStack) => Bool -> a -> a
assertError predicate v
- | predicate = lazy v
- | otherwise = unsafeDupablePerformIO $ do
+ | predicate = v
+ | otherwise = lazy $ unsafeDupablePerformIO $ do -- lazy: See Note [Strictness of assertError]
ccsStack <- currentCallStack
let
implicitParamCallStack = prettyCallStackLines ?callStack
@@ -452,6 +449,44 @@ assertError predicate v
stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack
throwIO (AssertionFailed ("Assertion failed\n" ++ stack))
+{- Note [Strictness of assertError]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It is vital that Demand Analysis does not see `assertError p e` as strict in e.
+#5561 details what happens otherwise, tested by libraries/base/tests/assert.hs:
+
+ let e1 i = throw Overflow
+ in assertError False (e1 5)
+
+This should *not* throw the Overflow exception; rather it should throw an
+AssertionError.
+Hence we use GHC.Exts.lazy to make assertError appear lazy in e, so that it
+is not called by-value.
+(Note that the reason we need `lazy` in the first place is that error has a
+bottoming result, which is strict in all free variables.)
+The way we achieve this is a bit subtle; before #24625 we defined it as
+
+ assertError p e | p = lazy e
+ | otherwise = error "assertion"
+
+but this means that in the following example (full code in T24625) we cannot
+cancel away the allocation of `Just x` because of the intervening `lazy`:
+
+ case assertError False (Just x) of Just y -> y
+ ==> { simplify }
+ case lazy (Just x) of Just y -> y
+
+Instead, we put `lazy` in the otherwise branch, thus
+
+ assertError p e | p = e
+ | otherwise = lazy $ error "assertion"
+
+The effect on #5561 is the same: since the otherwise branch appears lazy in e,
+the overall demand on `e` must be lazy as well.
+Furthermore, since there is no intervening `lazy` on the expected code path,
+the Simplifier may perform case-of-case on e and simplify the `Just x` example
+to `x`.
+-}
+
unsupportedOperation :: IOError
unsupportedOperation =
(IOError Nothing UnsupportedOperation ""
@@ -480,4 +515,3 @@ untangle coded message
_ -> (loc, "")
}
not_bar c = c /= '|'
-
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -286,7 +286,7 @@ module Control.Exception where
handle :: forall e a. Exception e => (e -> GHC.Types.IO a) -> GHC.Types.IO a -> GHC.Types.IO a
handleJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> (b -> GHC.Types.IO a) -> GHC.Types.IO a -> GHC.Types.IO a
interruptible :: forall a. GHC.Types.IO a -> GHC.Types.IO a
- ioError :: forall a. GHC.Internal.IO.Exception.IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.IO.Exception.IOError -> GHC.Types.IO a
mapException :: forall e1 e2 a. (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
mask :: forall b. ((forall a. GHC.Types.IO a -> GHC.Types.IO a) -> GHC.Types.IO b) -> GHC.Types.IO b
mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
@@ -394,7 +394,7 @@ module Control.Exception.Base where
handleJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> (b -> GHC.Types.IO a) -> GHC.Types.IO a -> GHC.Types.IO a
impossibleConstraintError :: forall (q :: GHC.Types.RuntimeRep) (a :: GHC.Prim.CONSTRAINT q). GHC.Prim.Addr# -=> a
impossibleError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
- ioError :: forall a. GHC.Internal.IO.Exception.IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.IO.Exception.IOError -> GHC.Types.IO a
mapException :: forall e1 e2 a. (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
mask :: forall b. ((forall a. GHC.Types.IO a -> GHC.Types.IO a) -> GHC.Types.IO b) -> GHC.Types.IO b
mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
@@ -7800,7 +7800,7 @@ module GHC.IO.Exception where
cannotCompactMutable :: GHC.Internal.Exception.Type.SomeException
cannotCompactPinned :: GHC.Internal.Exception.Type.SomeException
heapOverflow :: GHC.Internal.Exception.Type.SomeException
- ioError :: forall a. IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOError -> GHC.Types.IO a
ioException :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOException -> GHC.Types.IO a
stackOverflow :: GHC.Internal.Exception.Type.SomeException
unsupportedOperation :: IOError
@@ -10142,7 +10142,7 @@ module Prelude where
id :: forall a. a -> a
init :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
interact :: (String -> String) -> IO ()
- ioError :: forall a. IOError -> IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOError -> IO a
iterate :: forall a. (a -> a) -> a -> [a]
last :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
lcm :: forall a. Integral a => a -> a -> a
@@ -10381,7 +10381,7 @@ module System.IO.Error where
eofErrorType :: IOErrorType
fullErrorType :: IOErrorType
illegalOperationErrorType :: IOErrorType
- ioError :: forall a. IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOError -> GHC.Types.IO a
ioeGetErrorString :: IOError -> GHC.Internal.Base.String
ioeGetErrorType :: IOError -> IOErrorType
ioeGetFileName :: IOError -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.FilePath
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -7769,7 +7769,7 @@ module GHC.IO.Exception where
cannotCompactMutable :: GHC.Internal.Exception.Type.SomeException
cannotCompactPinned :: GHC.Internal.Exception.Type.SomeException
heapOverflow :: GHC.Internal.Exception.Type.SomeException
- ioError :: forall a. IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOError -> GHC.Types.IO a
ioException :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOException -> GHC.Types.IO a
stackOverflow :: GHC.Internal.Exception.Type.SomeException
unsupportedOperation :: IOError
@@ -13423,7 +13423,7 @@ module System.IO.Error where
eofErrorType :: IOErrorType
fullErrorType :: IOErrorType
illegalOperationErrorType :: IOErrorType
- ioError :: forall a. IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOError -> GHC.Types.IO a
ioeGetErrorString :: IOError -> GHC.Internal.Base.String
ioeGetErrorType :: IOError -> IOErrorType
ioeGetFileName :: IOError -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.FilePath
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -234,7 +234,7 @@ module Control.Exception where
type ErrorCall :: *
data ErrorCall = ErrorCallWithLocation GHC.Internal.Base.String GHC.Internal.Base.String
type Exception :: * -> Constraint
- class (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
+ class (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
displayException :: e -> GHC.Internal.Base.String
@@ -286,7 +286,7 @@ module Control.Exception where
handle :: forall e a. Exception e => (e -> GHC.Types.IO a) -> GHC.Types.IO a -> GHC.Types.IO a
handleJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> (b -> GHC.Types.IO a) -> GHC.Types.IO a -> GHC.Types.IO a
interruptible :: forall a. GHC.Types.IO a -> GHC.Types.IO a
- ioError :: forall a. GHC.Internal.IO.Exception.IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.IO.Exception.IOError -> GHC.Types.IO a
mapException :: forall e1 e2 a. (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
mask :: forall b. ((forall a. GHC.Types.IO a -> GHC.Types.IO a) -> GHC.Types.IO b) -> GHC.Types.IO b
mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
@@ -303,7 +303,7 @@ module Control.Exception where
module Control.Exception.Annotation where
-- Safety: None
type ExceptionAnnotation :: * -> Constraint
- class ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable a => ExceptionAnnotation a where
+ class ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable a => ExceptionAnnotation a where
displayExceptionAnnotation :: a -> GHC.Internal.Base.String
default displayExceptionAnnotation :: GHC.Internal.Show.Show a => a -> GHC.Internal.Base.String
{-# MINIMAL #-}
@@ -345,7 +345,7 @@ module Control.Exception.Base where
type ErrorCall :: *
data ErrorCall = ErrorCallWithLocation GHC.Internal.Base.String GHC.Internal.Base.String
type Exception :: * -> Constraint
- class (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
+ class (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
displayException :: e -> GHC.Internal.Base.String
@@ -394,7 +394,7 @@ module Control.Exception.Base where
handleJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> (b -> GHC.Types.IO a) -> GHC.Types.IO a -> GHC.Types.IO a
impossibleConstraintError :: forall (q :: GHC.Types.RuntimeRep) (a :: GHC.Prim.CONSTRAINT q). GHC.Prim.Addr# -=> a
impossibleError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
- ioError :: forall a. GHC.Internal.IO.Exception.IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.IO.Exception.IOError -> GHC.Types.IO a
mapException :: forall e1 e2 a. (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
mask :: forall b. ((forall a. GHC.Types.IO a -> GHC.Types.IO a) -> GHC.Types.IO b) -> GHC.Types.IO b
mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
@@ -850,11 +850,11 @@ module Data.Data where
type TyCon :: *
data TyCon = ...
type TypeRep :: *
- type TypeRep = ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep
+ type TypeRep = ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep
type Typeable :: forall k. k -> Constraint
class Typeable a where
...
- {-# MINIMAL ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.typeRep# #-}
+ {-# MINIMAL ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.typeRep# #-}
cast :: forall a b. (Typeable a, Typeable b) => a -> GHC.Internal.Maybe.Maybe b
constrFields :: Constr -> [GHC.Internal.Base.String]
constrFixity :: Constr -> Fixity
@@ -897,7 +897,7 @@ module Data.Data where
showConstr :: Constr -> GHC.Internal.Base.String
showsTypeRep :: TypeRep -> GHC.Internal.Show.ShowS
splitTyConApp :: TypeRep -> (TyCon, [TypeRep])
- trLiftedRep :: ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.TypeRep GHC.Types.LiftedRep
+ trLiftedRep :: ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.TypeRep GHC.Types.LiftedRep
tyConFingerprint :: TyCon -> GHC.Internal.Fingerprint.Type.Fingerprint
tyConModule :: TyCon -> GHC.Internal.Base.String
tyConName :: TyCon -> GHC.Internal.Base.String
@@ -921,14 +921,14 @@ module Data.Dynamic where
-- Safety: Safe
type Dynamic :: *
data Dynamic where
- Dynamic :: forall a. ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.TypeRep a -> a -> Dynamic
+ Dynamic :: forall a. ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.TypeRep a -> a -> Dynamic
type Typeable :: forall k. k -> Constraint
class Typeable a where
...
- {-# MINIMAL ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.typeRep# #-}
+ {-# MINIMAL ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.typeRep# #-}
dynApp :: Dynamic -> Dynamic -> Dynamic
dynApply :: Dynamic -> Dynamic -> GHC.Internal.Maybe.Maybe Dynamic
- dynTypeRep :: Dynamic -> ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep
+ dynTypeRep :: Dynamic -> ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep
fromDyn :: forall a. Typeable a => Dynamic -> a -> a
fromDynamic :: forall a. Typeable a => Dynamic -> GHC.Internal.Maybe.Maybe a
toDyn :: forall a. Typeable a => a -> Dynamic
@@ -1815,11 +1815,11 @@ module Data.Typeable where
type TyCon :: *
data TyCon = ...
type TypeRep :: *
- type TypeRep = ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep
+ type TypeRep = ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep
type Typeable :: forall k. k -> Constraint
class Typeable a where
...
- {-# MINIMAL ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.typeRep# #-}
+ {-# MINIMAL ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.typeRep# #-}
cast :: forall a b. (Typeable a, Typeable b) => a -> GHC.Internal.Maybe.Maybe b
decT :: forall {k} (a :: k) (b :: k). (Typeable a, Typeable b) => GHC.Internal.Data.Either.Either ((a :~: b) -> GHC.Internal.Base.Void) (a :~: b)
eqT :: forall {k} (a :: k) (b :: k). (Typeable a, Typeable b) => GHC.Internal.Maybe.Maybe (a :~: b)
@@ -1834,7 +1834,7 @@ module Data.Typeable where
rnfTypeRep :: TypeRep -> ()
showsTypeRep :: TypeRep -> GHC.Internal.Show.ShowS
splitTyConApp :: TypeRep -> (TyCon, [TypeRep])
- trLiftedRep :: ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.TypeRep GHC.Types.LiftedRep
+ trLiftedRep :: ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.TypeRep GHC.Types.LiftedRep
tyConFingerprint :: TyCon -> GHC.Internal.Fingerprint.Type.Fingerprint
tyConModule :: TyCon -> GHC.Internal.Base.String
tyConName :: TyCon -> GHC.Internal.Base.String
@@ -5299,9 +5299,9 @@ module GHC.Event.TimeOut where
type TimeoutEdit :: *
type TimeoutEdit = TimeoutQueue -> TimeoutQueue
type TimeoutKey :: *
- newtype TimeoutKey = TK ghc-internal-0.1.0.0:GHC.Internal.Event.Unique.Unique
+ newtype TimeoutKey = TK ghc-internal-9.1001.0:GHC.Internal.Event.Unique.Unique
type TimeoutQueue :: *
- type TimeoutQueue = ghc-internal-0.1.0.0:GHC.Internal.Event.PSQ.PSQ TimeoutCallback
+ type TimeoutQueue = ghc-internal-9.1001.0:GHC.Internal.Event.PSQ.PSQ TimeoutCallback
module GHC.Event.Windows where
-- Safety: None
@@ -5312,7 +5312,7 @@ module GHC.Event.Windows where
type ConsoleEvent :: *
data ConsoleEvent = ControlC | Break | Close | Logoff | Shutdown
type HandleData :: *
- data HandleData = HandleData {tokenKey :: {-# UNPACK #-}HandleKey, tokenEvents :: ! {-# UNPACK #-}(ghc-internal-0.1.0.0:GHC.Internal.Event.Internal.Types.N:EventLifetime[0])ghc-internal-0.1.0.0:GHC.Internal.Event.Internal.Types.EventLifetime, _handleCallback :: !GHC.Internal.Event.Windows.EventCallback}
+ data HandleData = HandleData {tokenKey :: {-# UNPACK #-}HandleKey, tokenEvents :: ! {-# UNPACK #-}(ghc-internal-9.1001.0:GHC.Internal.Event.Internal.Types.N:EventLifetime[0])ghc-internal-9.1001.0:GHC.Internal.Event.Internal.Types.EventLifetime, _handleCallback :: !GHC.Internal.Event.Windows.EventCallback}
type HandleKey :: *
data HandleKey = GHC.Internal.Event.Windows.HandleKey {handleValue :: {-# UNPACK #-}GHC.Internal.Windows.HANDLE, ...}
type IOResult :: * -> *
@@ -5340,7 +5340,7 @@ module GHC.Event.Windows where
ioFailedAny :: forall a b. GHC.Internal.Real.Integral a => a -> GHC.Types.IO (IOResult b)
ioSuccess :: forall a. a -> GHC.Types.IO (IOResult a)
processRemoteCompletion :: GHC.Types.IO ()
- registerHandle :: Manager -> GHC.Internal.Event.Windows.EventCallback -> GHC.Internal.Windows.HANDLE -> ghc-internal-0.1.0.0:GHC.Internal.Event.Internal.Types.Event -> ghc-internal-0.1.0.0:GHC.Internal.Event.Internal.Types.Lifetime -> GHC.Types.IO HandleKey
+ registerHandle :: Manager -> GHC.Internal.Event.Windows.EventCallback -> GHC.Internal.Windows.HANDLE -> ghc-internal-9.1001.0:GHC.Internal.Event.Internal.Types.Event -> ghc-internal-9.1001.0:GHC.Internal.Event.Internal.Types.Lifetime -> GHC.Types.IO HandleKey
registerTimeout :: Manager -> GHC.Types.Int -> TimeoutCallback -> GHC.Types.IO TimeoutKey
start_console_handler :: GHC.Internal.Word.Word32 -> GHC.Types.IO ()
toWin32ConsoleEvent :: forall a. (GHC.Classes.Eq a, GHC.Internal.Num.Num a) => a -> GHC.Internal.Maybe.Maybe ConsoleEvent
@@ -5399,7 +5399,7 @@ module GHC.Event.Windows.FFI where
cancelIoEx :: GHC.Internal.Windows.HANDLE -> LPOVERLAPPED -> GHC.Types.IO ()
cancelIoEx' :: GHC.Internal.Windows.HANDLE -> LPOVERLAPPED -> GHC.Types.IO GHC.Types.Bool
getOverlappedResult :: GHC.Internal.Windows.HANDLE -> GHC.Internal.Ptr.Ptr OVERLAPPED -> GHC.Internal.Windows.BOOL -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Windows.DWORD)
- getQueuedCompletionStatusEx :: IOCP -> ghc-internal-0.1.0.0:GHC.Internal.Event.Array.Array OVERLAPPED_ENTRY -> GHC.Internal.Windows.DWORD -> GHC.Types.IO GHC.Types.Int
+ getQueuedCompletionStatusEx :: IOCP -> ghc-internal-9.1001.0:GHC.Internal.Event.Array.Array OVERLAPPED_ENTRY -> GHC.Internal.Windows.DWORD -> GHC.Types.IO GHC.Types.Int
getTickCount64 :: GHC.Types.IO GHC.Internal.Word.Word64
newIOCP :: GHC.Types.IO IOCP
overlappedIONumBytes :: LPOVERLAPPED -> GHC.Types.IO GHC.Internal.Event.Windows.FFI.ULONG_PTR
@@ -5424,8 +5424,8 @@ module GHC.Event.Windows.ManagedThreadPool where
thrCallBack :: GHC.Internal.Event.Windows.ManagedThreadPool.WorkerJob,
thrActiveThreads :: GHC.Internal.MVar.MVar GHC.Types.Int,
thrMonitor :: GHC.Internal.MVar.MVar (),
- thrThreadIds :: ! {-# UNPACK #-}(ghc-internal-0.1.0.0:GHC.Internal.Event.Array.N:Array[0] <GHC.Internal.Conc.Sync.ThreadId>_P
- ; GHC.Internal.IORef.N:IORef[0] <ghc-internal-0.1.0.0:GHC.Internal.Event.Array.AC GHC.Internal.Conc.Sync.ThreadId>_N)(ghc-internal-0.1.0.0:GHC.Internal.Event.Array.Array GHC.Internal.Conc.Sync.ThreadId)}
+ thrThreadIds :: ! {-# UNPACK #-}(ghc-internal-9.1001.0:GHC.Internal.Event.Array.N:Array[0] <GHC.Internal.Conc.Sync.ThreadId>_P
+ ; GHC.Internal.IORef.N:IORef[0] <ghc-internal-9.1001.0:GHC.Internal.Event.Array.AC GHC.Internal.Conc.Sync.ThreadId>_N)(ghc-internal-9.1001.0:GHC.Internal.Event.Array.Array GHC.Internal.Conc.Sync.ThreadId)}
monitorThreadPool :: GHC.Internal.MVar.MVar () -> GHC.Types.IO ()
notifyRunning :: GHC.Internal.Maybe.Maybe ThreadPool -> GHC.Types.IO ()
notifyWaiting :: GHC.Internal.Maybe.Maybe ThreadPool -> GHC.Types.IO ()
@@ -5448,7 +5448,7 @@ module GHC.Exception where
type ErrorCall :: *
data ErrorCall = ErrorCallWithLocation GHC.Internal.Base.String GHC.Internal.Base.String
type Exception :: * -> Constraint
- class (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
+ class (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
displayException :: e -> GHC.Internal.Base.String
@@ -5477,7 +5477,7 @@ module GHC.Exception.Type where
type ArithException :: *
data ArithException = Overflow | Underflow | LossOfPrecision | DivideByZero | Denormal | RatioZeroDenominator
type Exception :: * -> Constraint
- class (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
+ class (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
displayException :: e -> GHC.Internal.Base.String
@@ -7970,7 +7970,7 @@ module GHC.IO.Exception where
cannotCompactMutable :: GHC.Internal.Exception.Type.SomeException
cannotCompactPinned :: GHC.Internal.Exception.Type.SomeException
heapOverflow :: GHC.Internal.Exception.Type.SomeException
- ioError :: forall a. IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOError -> GHC.Types.IO a
ioException :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOException -> GHC.Types.IO a
stackOverflow :: GHC.Internal.Exception.Type.SomeException
unsupportedOperation :: IOError
@@ -8054,8 +8054,8 @@ module GHC.IO.Handle where
hTryLock :: Handle -> LockMode -> GHC.Types.IO GHC.Types.Bool
hWaitForInput :: Handle -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Bool
isEOF :: GHC.Types.IO GHC.Types.Bool
- mkDuplexHandle :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> NewlineMode -> GHC.Types.IO Handle
- mkFileHandle :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.IO.IOMode.IOMode -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> NewlineMode -> GHC.Types.IO Handle
+ mkDuplexHandle :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> NewlineMode -> GHC.Types.IO Handle
+ mkFileHandle :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.IO.IOMode.IOMode -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> NewlineMode -> GHC.Types.IO Handle
nativeNewline :: Newline
nativeNewlineMode :: NewlineMode
noNewlineTranslation :: NewlineMode
@@ -8105,11 +8105,11 @@ module GHC.IO.Handle.Internals where
ioe_notReadable :: forall a. GHC.Types.IO a
ioe_notWritable :: forall a. GHC.Types.IO a
ioe_semiclosedHandle :: forall a. GHC.Types.IO a
- mkDuplexHandle :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Internal.IO.Handle.Types.NewlineMode -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
- mkDuplexHandleNoFinalizer :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Internal.IO.Handle.Types.NewlineMode -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
- mkFileHandle :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.IO.IOMode.IOMode -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Internal.IO.Handle.Types.NewlineMode -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
- mkFileHandleNoFinalizer :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.IO.IOMode.IOMode -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Internal.IO.Handle.Types.NewlineMode -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
- mkHandle :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.IO.Handle.Types.HandleType -> GHC.Types.Bool -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Internal.IO.Handle.Types.NewlineMode -> GHC.Internal.Maybe.Maybe HandleFinalizer -> GHC.Internal.Maybe.Maybe (GHC.Internal.MVar.MVar GHC.Internal.IO.Handle.Types.Handle__) -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
+ mkDuplexHandle :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Internal.IO.Handle.Types.NewlineMode -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
+ mkDuplexHandleNoFinalizer :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Internal.IO.Handle.Types.NewlineMode -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
+ mkFileHandle :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.IO.IOMode.IOMode -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Internal.IO.Handle.Types.NewlineMode -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
+ mkFileHandleNoFinalizer :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.IO.IOMode.IOMode -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Internal.IO.Handle.Types.NewlineMode -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
+ mkHandle :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.FilePath -> GHC.Internal.IO.Handle.Types.HandleType -> GHC.Types.Bool -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Internal.IO.Handle.Types.NewlineMode -> GHC.Internal.Maybe.Maybe HandleFinalizer -> GHC.Internal.Maybe.Maybe (GHC.Internal.MVar.MVar GHC.Internal.IO.Handle.Types.Handle__) -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
openTextEncoding :: forall a. GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Internal.IO.Handle.Types.HandleType -> (forall es ds. GHC.Internal.Maybe.Maybe (GHC.Internal.IO.Encoding.Types.TextEncoder es) -> GHC.Internal.Maybe.Maybe (GHC.Internal.IO.Encoding.Types.TextDecoder ds) -> GHC.Types.IO a) -> GHC.Types.IO a
readTextDevice :: GHC.Internal.IO.Handle.Types.Handle__ -> GHC.Internal.IO.Buffer.CharBuffer -> GHC.Types.IO GHC.Internal.IO.Buffer.CharBuffer
readTextDeviceNonBlocking :: GHC.Internal.IO.Handle.Types.Handle__ -> GHC.Internal.IO.Buffer.CharBuffer -> GHC.Types.IO GHC.Internal.IO.Buffer.CharBuffer
@@ -8173,7 +8173,7 @@ module GHC.IO.Handle.Types where
type Handle__ :: *
data Handle__
= forall dev enc_state dec_state.
- (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) =>
+ (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) =>
Handle__ {haDevice :: !dev,
haType :: HandleType,
haByteBuffer :: ! {-# UNPACK #-}(GHC.Internal.IORef.N:IORef[0] <GHC.Internal.IO.Buffer.Buffer GHC.Internal.Word.Word8>_N)(GHC.Internal.IORef.IORef (GHC.Internal.IO.Buffer.Buffer GHC.Internal.Word.Word8)),
@@ -8205,7 +8205,7 @@ module GHC.IO.Handle.Types where
module GHC.IO.Handle.Windows where
-- Safety: Safe-Inferred
handleToHANDLE :: GHC.Internal.IO.Handle.Types.Handle -> GHC.Types.IO GHC.Internal.Windows.HANDLE
- mkHandleFromHANDLE :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.Device.IODeviceType -> GHC.Internal.IO.FilePath -> GHC.Internal.IO.IOMode.IOMode -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
+ mkHandleFromHANDLE :: forall dev. (GHC.Internal.IO.Device.RawIO dev, GHC.Internal.IO.Device.IODevice dev, GHC.Internal.IO.BufferedIO.BufferedIO dev, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable dev) => dev -> GHC.Internal.IO.Device.IODeviceType -> GHC.Internal.IO.FilePath -> GHC.Internal.IO.IOMode.IOMode -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
openBinaryFile :: GHC.Internal.IO.FilePath -> GHC.Internal.IO.IOMode.IOMode -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
openFile :: GHC.Internal.IO.FilePath -> GHC.Internal.IO.IOMode.IOMode -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
openFileBlocking :: GHC.Internal.IO.FilePath -> GHC.Internal.IO.IOMode.IOMode -> GHC.Types.IO GHC.Internal.IO.Handle.Types.Handle
@@ -9650,7 +9650,7 @@ module GHC.StaticPtr where
-- Safety: None
type IsStatic :: (* -> *) -> Constraint
class IsStatic p where
- fromStaticPtr :: forall a. ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable a => StaticPtr a -> p a
+ fromStaticPtr :: forall a. ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable a => StaticPtr a -> p a
{-# MINIMAL fromStaticPtr #-}
type StaticKey :: *
type StaticKey = GHC.Internal.Fingerprint.Type.Fingerprint
@@ -10428,7 +10428,7 @@ module Prelude where
id :: forall a. a -> a
init :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
interact :: (String -> String) -> IO ()
- ioError :: forall a. IOError -> IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOError -> IO a
iterate :: forall a. (a -> a) -> a -> [a]
last :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
lcm :: forall a. Integral a => a -> a -> a
@@ -10667,7 +10667,7 @@ module System.IO.Error where
eofErrorType :: IOErrorType
fullErrorType :: IOErrorType
illegalOperationErrorType :: IOErrorType
- ioError :: forall a. IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOError -> GHC.Types.IO a
ioeGetErrorString :: IOError -> GHC.Internal.Base.String
ioeGetErrorType :: IOError -> IOErrorType
ioeGetFileName :: IOError -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.FilePath
@@ -11090,8 +11090,8 @@ module Type.Reflection where
data (:~~:) a b where
HRefl :: forall {k1} (a :: k1). (:~~:) a a
pattern App :: forall k2 (t :: k2). () => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b) => TypeRep a -> TypeRep b -> TypeRep t
- pattern Con :: forall k (a :: k). () => ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.NotApplication a => TyCon -> TypeRep a
- pattern Con' :: forall k (a :: k). () => ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.NotApplication a => TyCon -> [SomeTypeRep] -> TypeRep a
+ pattern Con :: forall k (a :: k). () => ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.NotApplication a => TyCon -> TypeRep a
+ pattern Con' :: forall k (a :: k). () => ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.NotApplication a => TyCon -> [SomeTypeRep] -> TypeRep a
pattern Fun :: forall k (fun :: k). () => forall (r1 :: GHC.Types.RuntimeRep) (r2 :: GHC.Types.RuntimeRep) (arg :: TYPE r1) (res :: TYPE r2). (k ~ *, fun ~~ (arg -> res)) => TypeRep arg -> TypeRep res -> TypeRep fun
type Module :: *
data Module = ...
@@ -11108,7 +11108,7 @@ module Type.Reflection where
type Typeable :: forall k. k -> Constraint
class Typeable a where
...
- {-# MINIMAL ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.typeRep# #-}
+ {-# MINIMAL ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.typeRep# #-}
decTypeRep :: forall k1 k2 (a :: k1) (b :: k2). TypeRep a -> TypeRep b -> GHC.Internal.Data.Either.Either ((a :~~: b) -> GHC.Internal.Base.Void) (a :~~: b)
eqTypeRep :: forall k1 k2 (a :: k1) (b :: k2). TypeRep a -> TypeRep b -> GHC.Internal.Maybe.Maybe (a :~~: b)
moduleName :: Module -> GHC.Internal.Base.String
@@ -11143,9 +11143,9 @@ module Type.Reflection.Unsafe where
data TypeRep a where
...
mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). TypeRep a -> TypeRep b -> TypeRep (a b)
- mkTrCon :: forall k (a :: k). TyCon -> [ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep] -> TypeRep a
+ mkTrCon :: forall k (a :: k). TyCon -> [ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep] -> TypeRep a
mkTyCon :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> GHC.Internal.Base.String -> GHC.Types.Int -> KindRep -> TyCon
- someTypeRepFingerprint :: ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep -> GHC.Internal.Fingerprint.Type.Fingerprint
+ someTypeRepFingerprint :: ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep -> GHC.Internal.Fingerprint.Type.Fingerprint
tyConFingerprint :: TyCon -> GHC.Internal.Fingerprint.Type.Fingerprint
tyConKindArgs :: TyCon -> GHC.Types.Int
tyConKindRep :: TyCon -> KindRep
@@ -11665,20 +11665,20 @@ instance GHC.Internal.Control.Monad.Fix.MonadFix Data.Semigroup.Last -- Defined
instance GHC.Internal.Control.Monad.Fix.MonadFix Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Control.Monad.Fix.MonadFix Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Control.Monad.IO.Class.MonadIO GHC.Types.IO -- Defined in ‘GHC.Internal.Control.Monad.IO.Class’
-instance forall (a :: * -> * -> *) b c. (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable b, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable c, GHC.Internal.Data.Data.Data (a b c)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedArrow a b c) -- Defined in ‘Control.Applicative’
-instance forall (m :: * -> *) a. (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable m, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Data.Data.Data (m a)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedMonad m a) -- Defined in ‘Control.Applicative’
+instance forall (a :: * -> * -> *) b c. (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable b, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable c, GHC.Internal.Data.Data.Data (a b c)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedArrow a b c) -- Defined in ‘Control.Applicative’
+instance forall (m :: * -> *) a. (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable m, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Data.Data.Data (m a)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedMonad m a) -- Defined in ‘Control.Applicative’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’
instance GHC.Internal.Data.Data.Data Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
-instance forall s. ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable s => GHC.Internal.Data.Data.Data (Data.Array.Byte.MutableByteArray s) -- Defined in ‘Data.Array.Byte’
+instance forall s. ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable s => GHC.Internal.Data.Data.Data (Data.Array.Byte.MutableByteArray s) -- Defined in ‘Data.Array.Byte’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
-instance forall i j (a :: i) (b :: j). (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable i, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable j, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable b, a ~~ b) => GHC.Internal.Data.Data.Data (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Data’
+instance forall i j (a :: i) (b :: j). (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable i, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable j, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable b, a ~~ b) => GHC.Internal.Data.Data.Data (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Data.Semigroup.Internal.All -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Data.Semigroup.Internal.Any -- Defined in ‘GHC.Internal.Data.Data’
instance forall a b. (GHC.Internal.Data.Data.Data a, GHC.Internal.Data.Data.Data b, GHC.Internal.Ix.Ix a) => GHC.Internal.Data.Data.Data (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.Associativity -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Types.Bool -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Types.Char -- Defined in ‘GHC.Internal.Data.Data’
-instance forall k a (b :: k). (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data a, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable b) => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Data’
+instance forall k a (b :: k). (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data a, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable b) => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Data’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Foreign.C.ConstPtr.ConstPtr a) -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.DecidedStrictness -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Types.Double -- Defined in ‘GHC.Internal.Data.Data’
@@ -11726,10 +11726,10 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word32 -- Defined in ‘G
instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word64 -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word8 -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Data.Data’
-instance forall k (a :: k). (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable k, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable a) => GHC.Internal.Data.Data.Data (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
-instance forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2). (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable k1, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable k2, GHC.Internal.Data.Data.Data (f (g a))) => GHC.Internal.Data.Data.Data (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
-instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Product.Product f g a) -- Defined in ‘Data.Functor.Product’
-instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Sum.Sum f g a) -- Defined in ‘Data.Functor.Sum’
+instance forall k (a :: k). (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable k, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable a) => GHC.Internal.Data.Data.Data (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
+instance forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2). (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable k1, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable k2, GHC.Internal.Data.Data.Data (f (g a))) => GHC.Internal.Data.Data.Data (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
+instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Product.Product f g a) -- Defined in ‘Data.Functor.Product’
+instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Sum.Sum f g a) -- Defined in ‘Data.Functor.Sum’
instance forall a b. (GHC.Internal.Data.Data.Data a, GHC.Internal.Data.Data.Data b) => GHC.Internal.Data.Data.Data (Data.Semigroup.Arg a b) -- Defined in ‘Data.Semigroup’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.First a) -- Defined in ‘Data.Semigroup’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Last a) -- Defined in ‘Data.Semigroup’
@@ -11795,7 +11795,7 @@ instance GHC.Internal.Data.Type.Equality.TestEquality GHC.Internal.TypeLits.SCha
instance GHC.Internal.Data.Type.Equality.TestEquality GHC.Internal.TypeLits.SSymbol -- Defined in ‘GHC.Internal.TypeLits’
instance forall k (a :: k). GHC.Internal.Data.Type.Equality.TestEquality ((GHC.Internal.Data.Type.Equality.:~:) a) -- Defined in ‘GHC.Internal.Data.Type.Equality’
instance forall k1 k (a :: k1). GHC.Internal.Data.Type.Equality.TestEquality ((GHC.Internal.Data.Type.Equality.:~~:) a) -- Defined in ‘GHC.Internal.Data.Type.Equality’
-instance forall k. GHC.Internal.Data.Type.Equality.TestEquality ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.TypeRep -- Defined in ‘ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal’
+instance forall k. GHC.Internal.Data.Type.Equality.TestEquality ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.TypeRep -- Defined in ‘ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal’
instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1). GHC.Internal.Data.Type.Equality.TestEquality f => GHC.Internal.Data.Type.Equality.TestEquality (Data.Functor.Compose.Compose f g) -- Defined in ‘Data.Functor.Compose’
instance forall a k (b :: k). GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’
@@ -11993,7 +11993,7 @@ instance GHC.Internal.Exception.Type.Exception GHC.Internal.Control.Exception.Ba
instance GHC.Internal.Exception.Type.Exception GHC.Internal.Control.Exception.Base.RecUpdError -- Defined in ‘GHC.Internal.Control.Exception.Base’
instance GHC.Internal.Exception.Type.Exception GHC.Internal.Control.Exception.Base.TypeError -- Defined in ‘GHC.Internal.Control.Exception.Base’
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-0.1.0.0:GHC.Internal.IO.Handle.Lock.Common.FileLockingNotSupported -- Defined in ‘ghc-internal-0.1.0.0:GHC.Internal.IO.Handle.Lock.Common’
+instance [safe] GHC.Internal.Exception.Type.Exception ghc-internal-9.1001.0:GHC.Internal.IO.Handle.Lock.Common.FileLockingNotSupported -- Defined in ‘ghc-internal-9.1001.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 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’
@@ -12677,8 +12677,8 @@ instance GHC.Internal.Show.Show GHC.Internal.Data.Data.DataRep -- Defined in ‘
instance GHC.Internal.Show.Show GHC.Internal.Data.Data.DataType -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Show.Show GHC.Internal.Data.Data.Fixity -- Defined in ‘GHC.Internal.Data.Data’
instance forall k (s :: k). GHC.Internal.Show.Show (GHC.Internal.Data.Proxy.Proxy s) -- Defined in ‘GHC.Internal.Data.Proxy’
-instance GHC.Internal.Show.Show ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep -- Defined in ‘ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal’
-instance forall k (a :: k). GHC.Internal.Show.Show (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.TypeRep a) -- Defined in ‘ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal’
+instance GHC.Internal.Show.Show ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep -- Defined in ‘ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal’
+instance forall k (a :: k). GHC.Internal.Show.Show (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.TypeRep a) -- Defined in ‘ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal’
instance GHC.Internal.Show.Show GHC.Internal.Data.Dynamic.Dynamic -- Defined in ‘GHC.Internal.Data.Dynamic’
instance forall a b. (GHC.Internal.Show.Show a, GHC.Internal.Show.Show b) => GHC.Internal.Show.Show (GHC.Internal.Data.Either.Either a b) -- Defined in ‘GHC.Internal.Data.Either’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Show.Show (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
@@ -12786,7 +12786,7 @@ instance GHC.Internal.Show.Show GHC.Internal.IO.Handle.Types.Handle -- Defined i
instance GHC.Internal.Show.Show GHC.Internal.IO.Handle.Types.HandleType -- Defined in ‘GHC.Internal.IO.Handle.Types’
instance GHC.Internal.Show.Show GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
instance GHC.Internal.Show.Show GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance [safe] GHC.Internal.Show.Show ghc-internal-0.1.0.0:GHC.Internal.IO.Handle.Lock.Common.FileLockingNotSupported -- Defined in ‘ghc-internal-0.1.0.0:GHC.Internal.IO.Handle.Lock.Common’
+instance [safe] GHC.Internal.Show.Show ghc-internal-9.1001.0:GHC.Internal.IO.Handle.Lock.Common.FileLockingNotSupported -- Defined in ‘ghc-internal-9.1001.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.Windows.Handle.CONSOLE_READCONSOLE_CONTROL -- Defined in ‘GHC.Internal.IO.Windows.Handle’
@@ -12886,8 +12886,8 @@ instance GHC.Classes.Eq GHC.Internal.Data.Data.ConstrRep -- Defined in ‘GHC.In
instance GHC.Classes.Eq GHC.Internal.Data.Data.DataRep -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Classes.Eq GHC.Internal.Data.Data.Fixity -- Defined in ‘GHC.Internal.Data.Data’
instance forall k (s :: k). GHC.Classes.Eq (GHC.Internal.Data.Proxy.Proxy s) -- Defined in ‘GHC.Internal.Data.Proxy’
-instance GHC.Classes.Eq ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep -- Defined in ‘ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal’
-instance forall k (a :: k). GHC.Classes.Eq (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.TypeRep a) -- Defined in ‘ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal’
+instance GHC.Classes.Eq ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep -- Defined in ‘ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal’
+instance forall k (a :: k). GHC.Classes.Eq (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.TypeRep a) -- Defined in ‘ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal’
instance forall a b. (GHC.Classes.Eq a, GHC.Classes.Eq b) => GHC.Classes.Eq (GHC.Internal.Data.Either.Either a b) -- Defined in ‘GHC.Internal.Data.Either’
instance forall k (a :: k). GHC.Classes.Eq (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Classes.Eq (f (g a)) => GHC.Classes.Eq (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
@@ -13063,8 +13063,8 @@ instance GHC.Classes.Ord GHC.Internal.Unicode.GeneralCategory -- Defined in ‘G
instance forall k (a :: k) (b :: k). GHC.Classes.Ord (a GHC.Internal.Data.Type.Equality.:~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
instance forall k1 k2 (a :: k1) (b :: k2). GHC.Classes.Ord (a GHC.Internal.Data.Type.Equality.:~~: b) -- Defined in ‘GHC.Internal.Data.Type.Equality’
instance forall k (s :: k). GHC.Classes.Ord (GHC.Internal.Data.Proxy.Proxy s) -- Defined in ‘GHC.Internal.Data.Proxy’
-instance GHC.Classes.Ord ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep -- Defined in ‘ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal’
-instance forall k (a :: k). GHC.Classes.Ord (ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal.TypeRep a) -- Defined in ‘ghc-internal-0.1.0.0:GHC.Internal.Data.Typeable.Internal’
+instance GHC.Classes.Ord ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.SomeTypeRep -- Defined in ‘ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal’
+instance forall k (a :: k). GHC.Classes.Ord (ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal.TypeRep a) -- Defined in ‘ghc-internal-9.1001.0:GHC.Internal.Data.Typeable.Internal’
instance forall a b. (GHC.Classes.Ord a, GHC.Classes.Ord b) => GHC.Classes.Ord (GHC.Internal.Data.Either.Either a b) -- Defined in ‘GHC.Internal.Data.Either’
instance forall k (a :: k). GHC.Classes.Ord (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Classes.Ord (f (g a)) => GHC.Classes.Ord (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -7800,7 +7800,7 @@ module GHC.IO.Exception where
cannotCompactMutable :: GHC.Internal.Exception.Type.SomeException
cannotCompactPinned :: GHC.Internal.Exception.Type.SomeException
heapOverflow :: GHC.Internal.Exception.Type.SomeException
- ioError :: forall a. IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOError -> GHC.Types.IO a
ioException :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOException -> GHC.Types.IO a
stackOverflow :: GHC.Internal.Exception.Type.SomeException
unsupportedOperation :: IOError
@@ -10381,7 +10381,7 @@ module System.IO.Error where
eofErrorType :: IOErrorType
fullErrorType :: IOErrorType
illegalOperationErrorType :: IOErrorType
- ioError :: forall a. IOError -> GHC.Types.IO a
+ ioError :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOError -> GHC.Types.IO a
ioeGetErrorString :: IOError -> GHC.Internal.Base.String
ioeGetErrorType :: IOError -> IOErrorType
ioeGetFileName :: IOError -> GHC.Internal.Maybe.Maybe GHC.Internal.IO.FilePath
=====================================
testsuite/tests/printer/T24237.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE DataKinds #-}
+{-# OPTIONS_GHC -fprint-redundant-promotion-ticks #-}
+module T24237 where
+
+import Data.Proxy
+
+foo :: Proxy '(:)
+foo = ()
=====================================
testsuite/tests/printer/T24237.stderr
=====================================
@@ -0,0 +1,7 @@
+T24237.hs:8:7: error: [GHC-83865]
+ • Couldn't match expected type ‘Proxy '(:)’ with actual type ‘()’
+ • In the expression: ()
+ In an equation for ‘foo’: foo = ()
+ • Relevant bindings include
+ foo :: Proxy '(:) (bound at T24237.hs:8:1)
+
=====================================
testsuite/tests/printer/all.T
=====================================
@@ -210,3 +210,5 @@ test('Test24753', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24753'])
test('Test24771', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24771'])
test('Test24159', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24159'])
test('Test25132', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25132'])
+
+test('T24237', normal, compile_fail, [''])
=====================================
testsuite/tests/runghc/T7859.stderr-mingw32
=====================================
@@ -7,7 +7,9 @@ Module: GHC.Internal.IO.Exception
Type: IOException
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:<line>:<column> in <package-id>:GHC.Internal.IO
- throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.IO.Exception
- ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.IO.Exception
+ collectBacktraces, called at libraries\ghc-internal\src\GHC\Internal\Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries\ghc-internal\src\GHC\Internal\IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+ throwIO, called at libraries\ghc-internal\src\GHC\Internal\IO\Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+ ioException, called at libraries\ghc-internal\src\GHC\Internal\IO\Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+ ioError, called at libraries\process\System\Process\Common.hs:227:16 in process-1.6.18.0-inplace:System.Process.Common
+
=====================================
testsuite/tests/simplCore/should_compile/T24625.hs
=====================================
@@ -0,0 +1,14 @@
+module T24625 where
+
+import GHC.IO.Exception
+import GHC.Exts
+
+data Foo = Foo !Int !Int String
+
+true :: Bool
+true = True
+{-# NOINLINE true #-}
+
+function :: Int -> Int -> String -> Int
+function !a !b c = case assertError true (Foo a b c) of
+ Foo a b c -> a + b
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -526,5 +526,6 @@ test('T24808', [ grep_errmsg(r'myFunction') ], compile, ['-O -ddump-simpl'])
# T24944 needs -O2 because it's about SpecConstr
test('T24944', [extra_files(['T24944a.hs'])], multimod_compile, ['T24944', '-v0 -O2'])
+test('T24625', [ grep_errmsg(r'case lazy') ], compile, ['-O -fno-ignore-asserts -ddump-simpl -dsuppress-uniques'])
test('T24725a', [ grep_errmsg(r'testedRule')], compile, ['-O -ddump-rule-firings'])
test('T25033', normal, compile, ['-O'])
=====================================
testsuite/tests/typecheck/should_compile/holes.stderr
=====================================
@@ -1,4 +1,3 @@
-
holes.hs:3:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: p
Where: ‘p’ is a rigid type variable bound by
@@ -92,7 +91,9 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
asTypeOf :: forall a. a -> a -> a
id :: forall a. a -> a
until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
- ioError :: forall a. IOError -> IO a
+ ioError :: forall a.
+ GHC.Internal.Stack.Types.HasCallStack =>
+ IOError -> IO a
(!!) :: forall a.
GHC.Internal.Stack.Types.HasCallStack =>
[a] -> Int -> a
@@ -204,3 +205,4 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
flip :: forall a b c. (a -> b -> c) -> b -> a -> c
zipWith3 :: forall a b c d.
(a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
+
=====================================
testsuite/tests/typecheck/should_compile/holes3.stderr
=====================================
@@ -1,4 +1,3 @@
-
holes3.hs:3:5: error: [GHC-88464]
• Found hole: _ :: p
Where: ‘p’ is a rigid type variable bound by
@@ -95,7 +94,9 @@ holes3.hs:11:15: error: [GHC-88464]
asTypeOf :: forall a. a -> a -> a
id :: forall a. a -> a
until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
- ioError :: forall a. IOError -> IO a
+ ioError :: forall a.
+ GHC.Internal.Stack.Types.HasCallStack =>
+ IOError -> IO a
(!!) :: forall a.
GHC.Internal.Stack.Types.HasCallStack =>
[a] -> Int -> a
@@ -207,3 +208,4 @@ holes3.hs:11:15: error: [GHC-88464]
flip :: forall a b c. (a -> b -> c) -> b -> a -> c
zipWith3 :: forall a b c d.
(a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bcc71f73171b9e05290058cb5c957fce7f373a2...226c631c6af668a53f88d11b514d817f5fa46ab3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bcc71f73171b9e05290058cb5c957fce7f373a2...226c631c6af668a53f88d11b514d817f5fa46ab3
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/20240821/e9dfbe34/attachment-0001.html>
More information about the ghc-commits
mailing list