[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: ghc-internal: Move STM utilities out of GHC.Internal.Conc.Sync
by Marge Bot (＠marge-bot) 10 Jan '26
by Marge Bot (＠marge-bot) 10 Jan '26
10 Jan '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
234d0d7f by Ben Gamari at 2026-01-09T13:50:38-05:00
ghc-internal: Move STM utilities out of GHC.Internal.Conc.Sync
This is necessary to avoid an import cycle on Windows when importing
`GHC.Internal.Exception.Context` in `GHC.Internal.Conc.Sync`.
On the road to address #25365.
- - - - -
c6db2f5c by Ben Gamari at 2026-01-09T13:50:38-05:00
base: Capture backtrace from throwSTM
Implements core-libraries-committee#297.
Fixes #25365.
- - - - -
5f7932c3 by Ben Gamari at 2026-01-09T13:50:38-05:00
base: Annotate rethrown exceptions in catchSTM with WhileHandling
Implements core-libraries-committee#298
- - - - -
03955b0c by Cheng Shao at 2026-01-09T13:50:40-05:00
compiler: make getPrim eagerly evaluate its result
This commit makes `GHC.Utils.Binary.getPrim` eagerly evaluate its
result, to avoid accidental laziness when future patches build other
binary parsers using `getPrim`.
- - - - -
ae27222f by Cheng Shao at 2026-01-09T13:50:40-05:00
compiler: implement fast get/put for Word16/Word32/Word64
Previously, `GHC.Utils.Binary` contains `get`/`put` functions for
`Word16`/`Word32`/`Word64` which always loads and stores them as
big-endian words at a potentially unaligned address. The previous
implementation is based on loads/stores of individual bytes and
concatenating bytes with bitwise operations, which currently cannot be
fused to a single load/store operation by GHC.
This patch implements fast `get`/`put` functions for
`Word16`/`Word32`/`Word64` based on a single memory load/store, with
an additional `byteSwap` operation on little-endian hosts. It is based
on unaligned load/store primops added since GHC 9.10, and we already
require booting with at least 9.10, so it's about time to switch to
this faster path.
- - - - -
3b420ff3 by Simon Peyton Jones at 2026-01-09T13:50:46-05:00
Fix scoping errors in specialisation
Using -fspecialise-aggressively in #26682 showed up a couple of
subtle errors in the type-class specialiser.
* dumpBindUDs failed to call `deleteCallsMentioning`, resulting in a
call that mentioned a dictionary that was not in scope. This call
has been missing since 2009!
commit c43c981705ec33da92a9ce91eb90f2ecf00be9fe
Author: Simon Peyton Jones <simonpj(a)microsoft.com>
Date: Fri Oct 23 16:15:51 2009 +0000
Fixed by re-combining `dumpBindUDs` and `dumpUDs`.
* I think there was another bug involving the quantified type
variables in polymorphic specialisation. In any case I refactored
`specHeader` and `spec_call` so that the former looks for the
extra quantified type variables rather than the latter. This
is quite a worthwhile simplification: less code, easier to grok.
Test case in simplCore/should_compile/T26682,
brilliantly minimised by @sheaf.
- - - - -
ccd40d2c by Cheng Shao at 2026-01-09T13:50:47-05:00
compiler: change sectionProtection to take SectionType argument
This commit changes `sectionProtection` to only take `SectionType`
argument instead of whole `Section`, since it doesn't need the Cmm
section content anyway, and it can then be called in parts of NCG
where we only have a `SectionType` in scope.
- - - - -
cb7fd0db by Cheng Shao at 2026-01-09T13:50:47-05:00
compiler: change isInitOrFiniSection to take SectionType argument
This commit changes `isInitOrFiniSection` to only take `SectionType`
argument instead of whole `Section`, since it doesn't need the Cmm
section content anyway, and it can then be called in parts of NCG
where we only have a `SectionType` in scope. Also marks it as
exported.
- - - - -
74728086 by Cheng Shao at 2026-01-09T13:50:47-05:00
compiler: fix split sections on windows
This patch fixes split sections on windows by emitting the right
COMDAT section header in NCG, see added comment for more explanation.
Fix #26696 #26494.
-------------------------
Metric Decrease:
LargeRecord
T9675
size_hello_artifact
size_hello_artifact_gzip
size_hello_unicode
size_hello_unicode_gzip
Metric Increase:
T13035
-------------------------
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
b67bcca2 by Cheng Shao at 2026-01-09T13:50:48-05:00
iserv: add comment about -fkeep-cafs
- - - - -
f2077450 by Matthew Craven at 2026-01-09T13:50:49-05:00
Account for "stupid theta" in demand sig for DataCon wrappers
Fixes #26748.
- - - - -
34 changed files:
- compiler/GHC/Cmm.hs
- compiler/GHC/Cmm/InitFini.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/Ppr.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToC.hs
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Utils/Binary.hs
- libraries/base/changelog.md
- libraries/base/src/GHC/Conc.hs
- libraries/base/src/GHC/Conc/Sync.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
- + libraries/ghc-internal/src/GHC/Internal/STM.hs
- + testsuite/tests/dmdanal/should_run/T26748.hs
- + testsuite/tests/dmdanal/should_run/T26748.stdout
- testsuite/tests/dmdanal/should_run/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/simplCore/should_compile/T26682.hs
- + testsuite/tests/simplCore/should_compile/T26682a.hs
- testsuite/tests/simplCore/should_compile/all.T
- utils/iserv/iserv.cabal.in
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7354cc11de89cea0a69b36c7ef551…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7354cc11de89cea0a69b36c7ef551…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
09 Jan '26
Cheng Shao pushed new branch wip/rts-linker-in-hs at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/rts-linker-in-hs
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26615] 41 commits: [#26183] Associated Type Iface Fix
by Simon Peyton Jones (＠simonpj) 09 Jan '26
by Simon Peyton Jones (＠simonpj) 09 Jan '26
09 Jan '26
Simon Peyton Jones pushed to branch wip/T26615 at Glasgow Haskell Compiler / GHC
Commits:
8a317b6f by Aaron Allen at 2026-01-01T03:05:15-05:00
[#26183] Associated Type Iface Fix
When determining "extras" for class decl interface entries, axioms for
the associated types need to included so that dependent modules will be
recompiled if those axioms change.
resolves #26183
- - - - -
ae1aeaab by Cheng Shao at 2026-01-01T03:06:32-05:00
testsuite: run numeric tests with optasm when available
This patch adds the `optasm` extra way to nueric tests when NCG is
available. Some numeric bugs only surface with optimization, omitting
this can hide these bugs and even make them slip into release! (e.g. #26711)
- - - - -
6213bb57 by maralorn at 2026-01-02T16:30:32+01:00
GHC.Internal.Exception.Context: Fix comment
on addExceptionAnnotation
- - - - -
b820ff50 by Janis Voigtlaender at 2026-01-05T02:43:18-05:00
GHC.Internal.Control.Monad.replicateM: Fix comment
- - - - -
a8a94aad by Cheng Shao at 2026-01-05T16:24:04-05:00
hadrian: drops unused PE linker script for windows
This patch drops unused PE linker script for windows in the
`MergeObjects` builder of hadrian. The linker script is used for
merging object files into a single `HS*.o` object file and undoing the
effect of split sections, when building the "ghci library" object
file. However, we don't build the ghci library on windows, and this
code path is actually unreachable.
- - - - -
53038ea9 by Cheng Shao at 2026-01-05T16:24:04-05:00
hadrian: drop unused logic for building ghci libraries
This patch drops the unused logic for building ghci libraries in
hadrian:
- The term "ghci library" refers to an optional object file per
library `HS*.o`, which is merged from multiple object files in that
library using the `MergeObjects` builder in hadrian.
- The original rationale of having a ghci library object, in addition
to normal archives, was to speedup ghci loading, since the combined
object is linked with a linker script to undo the effects of
`-fsplit-sections` to reduce section count and make it easier for
the RTS linker to handle.
- However, most GHC builds enable `dynamicGhcPrograms` by default, in
such cases the ghci library would already not be built.
- `dynamicGhcPrograms` is disabled on Windows, but still we don't
build the ghci library due to lack of functioning merge objects
command.
- The only case that we actually build ghci library objects, are
alpine fully static bindists. However, for other reasons, split
sections is already disabled for fully static builds anyway!
- There will not be any regression if the ghci library objects are
absent from a GHC global libdir when `dynamicGhcPrograms` is
disabled. The RTS linker can already load the archives without any
issue.
Hence the removal. We now forcibly disable ghci libraries for all
Cabal components, and rip out all logic related to `MergeObjects` and
ghci libraries in hadrian. This also nicely cleans up some old todos
and fixmes that are no longer relevant.
Note that MergeObjects in hadrian is not the same thing as merge
objects in the GHC driver. The latter is not affected by this patch.
-------------------------
Metric Decrease:
libdir
-------------------------
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
8f209336 by Simon Jakobi at 2026-01-05T16:24:48-05:00
User's guide: Fix link to language extensions
Instead of linking to haddocks, it seemed more useful to link
to the extension overview in the user's guide.
Closes #26614.
- - - - -
0b7df6db by Simon Peyton Jones at 2026-01-06T09:32:23-05:00
Improved fundeps for closed type families
The big payload of this commit is to execute the plan suggested
in #23162, by improving the way that we generate functional
dependencies for closed type families.
It is all described in Note [Exploiting closed type families]
Most of the changes are in GHC.Tc.Solver.FunDeps
Other small changes
* GHC.Tc.Solver.bumpReductionDepth. This function brings together the code that
* Bumps the depth
* Checks for overflow
Previously the two were separated, sometimes quite widely.
* GHC.Core.Unify.niFixSubst: minor improvement, removing an unnecessary
itraetion in the base case.
* GHC.Core.Unify: no need to pass an InScopeSet to
tcUnifyTysForInjectivity. It can calculate one for itself; and it is
never inspected anyway so it's free to do so.
* GHC.Tc.Errors.Ppr: slight impovement to the error message for
reduction-stack overflow, when a constraint (rather than a type) is
involved.
* GHC.Tc.Solver.Monad.wrapUnifier: small change to the API
- - - - -
fde8bd88 by Simon Peyton Jones at 2026-01-06T09:32:23-05:00
Add missing (KK4) to kick-out criteria
There was a missing case in kick-out that meant we could fail
to solve an eminently-solvable constraint.
See the new notes about (KK4)
- - - - -
00082844 by Simon Peyton Jones at 2026-01-06T09:32:23-05:00
Some small refactorings of error reporting in the typechecker
This is just a tidy-up commit.
* Add ei_insoluble to ErrorItem, to cache insolubility.
Small tidy-up.
* Remove `is_ip` and `mkIPErr` from GHC.Tc.Errors; instead enhance mkDictErr
to handle implicit parameters. Small refactor.
- - - - -
fe4cb252 by Simon Peyton Jones at 2026-01-06T09:32:24-05:00
Improve recording of insolubility for fundeps
This commit addresses #22652, by recording when the fundeps for
a constraint are definitely insoluble. That in turn improves the
perspicacity of the pattern-match overlap checker.
See Note [Insoluble fundeps]
- - - - -
df0ffaa5 by Simon Peyton Jones at 2026-01-06T09:32:24-05:00
Fix a buglet in niFixSubst
The MR of which this is part failed an assertion check extendTvSubst
because we extended the TvSubst with a CoVar. Boo.
This tiny patch fixes it, and adds the regression test from #13882
that showed it up.
- - - - -
3d6aba77 by konsumlamm at 2026-01-06T09:33:16-05:00
Fix changelog formatting
- - - - -
69e0ab59 by Cheng Shao at 2026-01-06T19:37:56-05:00
compiler: add targetHasRTSWays function
This commit adds a `targetHasRTSWays` util function in
`GHC.Driver.Session` to query if the target RTS has a given Ways (e.g.
WayThreaded).
- - - - -
25a0ab94 by Cheng Shao at 2026-01-06T19:37:56-05:00
compiler: link on-demand external interpreter with threaded RTS
This commit makes the compiler link the on-demand external interpreter
program with threaded RTS if it is available in the target RTS ways.
This is a better default than the previous single-threaded RTS, and it
enables the external interpreter to benefit from parallelism when
deserializing CreateBCOs messages.
- - - - -
92404a2b by Cheng Shao at 2026-01-06T19:37:56-05:00
hadrian: link iserv with threaded RTS
This commit makes hadrian link iserv with threaded RTS if it's
available in the RTS ways. Also cleans up the iserv main C program
which can be replaced by the `-fkeep-cafs` link-time option.
- - - - -
a20542d2 by Cheng Shao at 2026-01-06T19:38:38-05:00
ghc-internal: remove unused GMP macros
This patch removes unused GMP related macros from `ghc-internal`. The
in-tree GMP version was hard coded and outdated, but it was not used
anywhere anyway.
- - - - -
4079dcd6 by Cheng Shao at 2026-01-06T19:38:38-05:00
hadrian: fix in-tree gmp configure error on newer c compilers
Building in-tree gmp on newer c compilers that default to c23 fails at
configure stage, this patch fixes it, see added comment for
explanation.
- - - - -
414d1fe1 by Cheng Shao at 2026-01-06T19:39:20-05:00
compiler: fix LLVM backend pdep/pext handling for i386 target
This patch fixes LLVM backend's pdep/pext handling for i386 target,
and also removes non-existent 128/256/512 bit hs_pdep/hs_pext callees.
See amended note for more explanation. Fixes #26450.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
c7f6fba3 by Cheng Shao at 2026-01-06T19:39:20-05:00
ci: remove allow_failure flag for i386 alpine job
The LLVM codegen issue for i386 has been fixed, and the i386 alpine
job should pass now. This commit removes the allow_failure flag so
that other i386 regressions in the future are signaled more timely.
- - - - -
52d00c05 by Simon Peyton Jones at 2026-01-07T10:24:21-05:00
Add missing InVar->OutVar lookup in SetLevels
As #26681 showed, the SetLevels pass was failing to map an InVar to
an OutVar. Very silly! I'm amazed it hasn't broken before now.
I have improved the type singatures (to mention InVar and OutVar)
so it's more obvious what needs to happen.
- - - - -
ab0a5594 by Cheng Shao at 2026-01-07T10:25:04-05:00
hadrian: drop deprecated pkgHashSplitObjs code path
This patch drops deprecated `pkgHashSplitObjs` code path from hadrian,
since GHC itself has removed split objs support many versions ago and
this code path is unused.
- - - - -
bb3a2ba1 by Cheng Shao at 2026-01-07T10:25:44-05:00
hadrian: remove linting/assertion in quick-validate flavour
The `quick-validate` flavour is meant for testing ghc and passing the
testsuite locally with similar settings to `validate` but faster. This
patch removes the linting/assertion overhead in `quick-validate` to
improve developer experience. I also took the chance to simplify
redundant logic of rts/library way definition in `validate` flavour.
- - - - -
7971f5dd by Cheng Shao at 2026-01-07T10:26:26-05:00
deriveConstants: clean up unused constants
This patch cleans up unused constants from `deriveConstants`, they are
not used by C/Cmm code in the RTS, nor compiler-generated code.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
4df96993 by Cheng Shao at 2026-01-07T10:27:08-05:00
hadrian: pass -fno-omit-frame-pointer with +debug_info
This patch adds `-fno-omit-frame-pointer` as C/C++ compilation flag
when compiling with `+debug_info` flavour transformer. It's a sane
default when you care about debugging and reliable backtraces, and
makes debugging/profiling with bpf easier.
- - - - -
8a3900a3 by Aaron Allen at 2026-01-07T10:27:57-05:00
[26705] Include TyCl instances in data fam iface entry
Ensures dependent modules are recompiled when the class instances for a
data family instance change.
resolves #26705
- - - - -
a0b980af by Cheng Shao at 2026-01-07T10:28:38-05:00
hadrian: remove unused Hp2Ps/Hpc builders
This patch removes the Hp2Ps/Hpc builders from hadrian, they are
unused in the build system. Note that the hp2ps/hpc programs are still
built and not affected.
- - - - -
50a58757 by Cheng Shao at 2026-01-07T10:29:20-05:00
hadrian: only install js files to libdir for wasm/js targets
There are certain js files required for wasm/js targets to work, and
previously hadrian would install those js files to libdir
unconditionally on other targets as well. This could be a minor
annoyance for packagers especially when the unused js files contain
shebangs that interfere with the packaging process. This patch makes
hadrian only selectively install the right js files for the right
targets.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
da40e553 by Simon Peyton Jones at 2026-01-07T10:30:00-05:00
Add flavour transformer assertions_stage1
This allows us to enable -DDEBUG assertions in the stage1 compiler
- - - - -
ec3cf767 by Cheng Shao at 2026-01-08T06:24:31-05:00
make: remove unused Makefiles from legacy make build system
This patch removes unused Makefiles from legacy make build system; now
they are never used by hadrian in any way, and they already include
common boilerplate mk files that are long gone in the make build
system removal, hence the housecleaning.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
04ea3f83 by Cheng Shao at 2026-01-08T06:25:13-05:00
compiler: use -O3 as LLVM optimization level for ghc -O2
The GHC driver clamps LLVM optimization level to `-O2` due to LLVM
crashes, but those were historical issues many years ago that are no
longer relevant for LLVM versions we support today. This patch changes
the driver to use `-O3` as LLVM optimization level when compiling with
`-O2`, which is a better default when we're willing to trade
compilation time for faster generated code.
- - - - -
472df471 by Peter Trommler at 2026-01-08T13:28:54-05:00
Use half-word literals in info tables
With this commit info tables are mapped to the same assembler code
on big-endian and little-endian platforms.
Fixes #26579.
- - - - -
393f9c51 by Simon Peyton Jones at 2026-01-08T13:29:35-05:00
Refactor srutOkForBinderSwap
This MR does a small refactor:
* Moves `scrutOkForBinderSwap` and `BinderSwapDecision`
to GHC.Core.Utils
* Inverts the sense of the coercion it returns, which makes
more sense
No effect on behaviour
- - - - -
ad76fb0f by Simon Peyton Jones at 2026-01-08T13:29:36-05:00
Improve case merging
This small MR makes case merging happen a bit more often than
it otherwise could, by getting join points out of the way.
See #26709 and GHC.Core.Utils
Note [Floating join points out of DEFAULT alternatives]
- - - - -
4c9395f5 by Cheng Shao at 2026-01-08T13:30:16-05:00
hadrian: remove broken hsc2hs flag when cross compiling to windows
This patch removes the `--via-asm` hsc2hs flag when cross compiling to
windows. With recent llvm-mingw toolchain, it would fail with:
```
x86_64-w64-mingw32-hsc2hs: Cannot combine instructions: [Quad 8,Long 4,Long 241,Ref ".Ltmp1-.Ltmp0"]
```
The hsc2hs default `--cross-compile` logic is slower but works.
- - - - -
71fdef55 by Simon Peyton Jones at 2026-01-08T13:30:57-05:00
Try harder to keep the substitution empty
Avoid unnecessary cloning of variables in the Simplifier.
Addresses #26724,
See Note [Keeping the substitution empty]
We get some big wins in compile time
Metrics: compile_time/bytes allocated
-------------------------------------
Baseline
Test Metric value New value Change
----------------------------------------------------------------------------
CoOpt_Singletons(normal) ghc/alloc 721,544,088 692,174,216 -4.1% GOOD
LargeRecord(normal) ghc/alloc 1,268,031,157 1,265,168,448 -0.2%
T14766(normal) ghc/alloc 918,218,533 688,432,296 -25.0% GOOD
T15703(normal) ghc/alloc 318,103,629 306,638,016 -3.6% GOOD
T17836(normal) ghc/alloc 419,174,584 418,400,824 -0.2%
T18478(normal) ghc/alloc 471,042,976 470,261,376 -0.2%
T20261(normal) ghc/alloc 573,387,162 563,663,336 -1.7%
T24984(normal) ghc/alloc 87,832,666 87,636,168 -0.2%
T25196(optasm) ghc/alloc 1,103,284,040 1,101,376,992 -0.2%
hard_hole_fits(normal) ghc/alloc 224,981,413 224,608,208 -0.2%
geo. mean -0.3%
minimum -25.0%
maximum +0.1%
Metric Decrease:
CoOpt_Singletons
T14766
T15703
- - - - -
30341168 by Simon Peyton Jones at 2026-01-08T13:31:38-05:00
Add regression test for #24867
- - - - -
1ac1a541 by Julian Ospald at 2026-01-09T02:48:53-05:00
Support statically linking executables properly
Fixes #26434
In detail, this does a number of things:
* Makes GHC aware of 'extra-libraries-static' (this changes the package
database format).
* Adds a switch '-static-external' that will honour 'extra-libraries-static'
to link external system dependencies statically.
* Adds a new field to settings/targets: "ld supports verbatim namespace".
This field is used by '-static-external' to conditionally use '-l:foo.a'
syntax during linking, which is more robust than trying to find the
absolute path to an archive on our own.
* Adds a switch '-fully-static' that is meant as a high-level interface
for e.g. cabal. This also honours 'extra-libraries-static'.
This also attempts to clean up the confusion around library search directories.
At the moment, we have 3 types of directories in the package database
format:
* library-dirs
* library-dirs-static
* dynamic-library-dirs
However, we only have two types of linking: dynamic or static. Given the
existing logic in 'mungeDynLibFields', this patch assumes that
'library-dirs' is really just nothing but a fallback and always
prefers the more specific variants if they exist and are non-empty.
Conceptually, we should be ok with even just one search dirs variant.
Haskell libraries are named differently depending on whether they're
static or dynamic, so GHC can conveniently pick the right one depending
on the linking needs. That means we don't really need to play tricks
with search paths to convince the compiler to do linking as we want it.
For system C libraries, the convention has been anyway to place static and
dynamic libs next to each other, so we need to deal with that issue
anyway and it is outside of our control. But this is out of the scope
of this patch.
This patch is backwards compatible with cabal. Cabal should however
be patched to use the new '-fully-static' switch.
- - - - -
ad3c808d by Julian Ospald at 2026-01-09T02:48:53-05:00
Warn when "-dynamic" is mixed with "-staticlib"
- - - - -
322dd672 by Matthew Pickering at 2026-01-09T02:49:35-05:00
rts: Use INFO_TABLE_CONSTR for stg_dummy_ret_closure
Since the closure type is CONSTR_NOCAF, we need to use INFO_TABLE_CONSTR
to populate the constructor description field (this crashes ghc-debug
when decoding AP_STACK frames sometimes)
Fixes #26745
- - - - -
3888f0d9 by Simon Peyton Jones at 2026-01-09T17:42:50+00:00
Make SpecContr rules fire a bit later
See #26615 and Note [SpecConstr rule activation]
- - - - -
212 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC.hs
- compiler/GHC/Cmm/Info.hs
- compiler/GHC/Cmm/Utils.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Config/Interpreter.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Linker/Dynamic.hs
- compiler/GHC/Linker/Executable.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Unit.hs
- compiler/GHC/Runtime/Interpreter/C.hs
- compiler/GHC/Runtime/Interpreter/Init.hs
- compiler/GHC/Settings.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/StgToJS/Linker/Utils.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/FunDeps.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/CtLoc.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Types/TyThing.hs
- compiler/GHC/Unit/Info.hs
- compiler/GHC/Unit/State.hs
- configure.ac
- distrib/configure.ac.in
- − docs/Makefile
- − docs/storage-mgt/Makefile
- docs/users_guide/9.16.1-notes.rst
- − docs/users_guide/Makefile
- docs/users_guide/exts/pragmas.rst
- docs/users_guide/exts/table.rst
- docs/users_guide/phases.rst
- − driver/Makefile
- − driver/ghc/Makefile
- − driver/ghci/Makefile
- − driver/haddock/Makefile
- − driver/utils/merge_sections.ld
- − driver/utils/merge_sections_pe.ld
- ghc/Main.hs
- − ghc/Makefile
- hadrian/cfg/default.host.target.in
- hadrian/cfg/default.target.in
- hadrian/doc/flavours.md
- hadrian/hadrian.cabal
- hadrian/src/Base.hs
- hadrian/src/Builder.hs
- hadrian/src/Context.hs
- hadrian/src/Flavour.hs
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Hadrian/Haskell/Cabal/Type.hs
- hadrian/src/Hadrian/Haskell/Hash.hs
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Packages.hs
- hadrian/src/Rules.hs
- hadrian/src/Rules/Gmp.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Builders/Hsc2Hs.hs
- − hadrian/src/Settings/Builders/MergeObjects.hs
- hadrian/src/Settings/Builders/SplitSections.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Flavours/Validate.hs
- hadrian/src/Settings/Packages.hs
- − libraries/Makefile
- libraries/base/changelog.md
- − libraries/doc/Makefile
- libraries/ghc-boot/GHC/Unit/Database.hs
- libraries/ghc-internal/configure.ac
- libraries/ghc-internal/ghc-internal.buildinfo.in
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/include/HsIntegerGmp.h.in
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs
- linters/lint-codes/LintCodes/Static.hs
- − linters/lint-codes/Makefile
- − linters/lint-notes/Makefile
- llvm-passes
- + m4/fp_linker_supports_verbatim.m4
- m4/prep_target_file.m4
- mk/system-cxx-std-lib-1.0.conf.in
- − rts/Makefile
- rts/StgMiscClosures.cmm
- rts/configure.ac
- − rts/include/Makefile
- rts/rts.buildinfo.in
- rts/rts.cabal
- + testsuite/driver/_elffile.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/ghc-config/ghc-config.hs
- + testsuite/tests/driver/fully-static/Hello.hs
- + testsuite/tests/driver/fully-static/Makefile
- + testsuite/tests/driver/fully-static/all.T
- + testsuite/tests/driver/fully-static/fully-static.stdout
- + testsuite/tests/driver/fully-static/test/Test.hs
- + testsuite/tests/driver/fully-static/test/test.pkg
- + testsuite/tests/driver/mostly-static/Hello.hs
- + testsuite/tests/driver/mostly-static/Makefile
- + testsuite/tests/driver/mostly-static/all.T
- + testsuite/tests/driver/mostly-static/mostly-static.stdout
- + testsuite/tests/driver/mostly-static/test/test.c
- + testsuite/tests/driver/mostly-static/test/test.h
- + testsuite/tests/driver/mostly-static/test/test.pkg
- + testsuite/tests/driver/recomp26183/M.hs
- + testsuite/tests/driver/recomp26183/M2A.hs
- + testsuite/tests/driver/recomp26183/M2B.hs
- + testsuite/tests/driver/recomp26183/Makefile
- + testsuite/tests/driver/recomp26183/all.T
- + testsuite/tests/driver/recomp26183/recomp26183.stderr
- + testsuite/tests/driver/recomp26705/M.hs
- + testsuite/tests/driver/recomp26705/M2A.hs
- + testsuite/tests/driver/recomp26705/M2B.hs
- + testsuite/tests/driver/recomp26705/Makefile
- + testsuite/tests/driver/recomp26705/all.T
- + testsuite/tests/driver/recomp26705/recomp26705.stderr
- testsuite/tests/indexed-types/should_compile/CEqCanOccursCheck.hs
- testsuite/tests/indexed-types/should_fail/T12522a.hs
- testsuite/tests/indexed-types/should_fail/T26176.stderr
- testsuite/tests/numeric/should_run/all.T
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr
- testsuite/tests/parser/should_fail/T20654a.stderr
- testsuite/tests/pmcheck/should_compile/T15753c.hs
- + testsuite/tests/pmcheck/should_compile/T15753c.stderr
- testsuite/tests/pmcheck/should_compile/T15753d.hs
- + testsuite/tests/pmcheck/should_compile/T15753d.stderr
- + testsuite/tests/pmcheck/should_compile/T22652.hs
- + testsuite/tests/pmcheck/should_compile/T22652a.hs
- + testsuite/tests/pmcheck/should_compile/T24867.hs
- + testsuite/tests/pmcheck/should_compile/T24867.stderr
- testsuite/tests/pmcheck/should_compile/all.T
- + testsuite/tests/polykinds/T13882.hs
- testsuite/tests/polykinds/all.T
- testsuite/tests/quantified-constraints/T15316A.stderr
- testsuite/tests/quantified-constraints/T17267.stderr
- testsuite/tests/quantified-constraints/T17267a.stderr
- testsuite/tests/quantified-constraints/T17267b.stderr
- testsuite/tests/quantified-constraints/T17267c.stderr
- testsuite/tests/quantified-constraints/T17267e.stderr
- testsuite/tests/quantified-constraints/T17458.stderr
- + testsuite/tests/simplCore/should_compile/T26615.hs
- + testsuite/tests/simplCore/should_compile/T26615a.hs
- + testsuite/tests/simplCore/should_compile/T26681.hs
- + testsuite/tests/simplCore/should_compile/T26709.hs
- + testsuite/tests/simplCore/should_compile/T26709.stderr
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/typecheck/should_compile/T16188.hs
- testsuite/tests/typecheck/should_fail/ContextStack1.stderr
- testsuite/tests/typecheck/should_fail/FD3.stderr
- testsuite/tests/typecheck/should_fail/FDsFromGivens2.stderr
- testsuite/tests/typecheck/should_fail/FunDepOrigin1b.stderr
- testsuite/tests/typecheck/should_fail/T13506.stderr
- testsuite/tests/typecheck/should_fail/T15767.stderr
- testsuite/tests/typecheck/should_fail/T19415.stderr
- testsuite/tests/typecheck/should_fail/T19415b.stderr
- testsuite/tests/typecheck/should_fail/T22924b.stderr
- + testsuite/tests/typecheck/should_fail/T23162b.hs
- + testsuite/tests/typecheck/should_fail/T23162b.stderr
- + testsuite/tests/typecheck/should_fail/T23162c.hs
- + testsuite/tests/typecheck/should_fail/T23162d.hs
- testsuite/tests/typecheck/should_fail/T25325.stderr
- testsuite/tests/typecheck/should_fail/T5236.stderr
- testsuite/tests/typecheck/should_fail/T5246.stderr
- testsuite/tests/typecheck/should_fail/T5978.stderr
- testsuite/tests/typecheck/should_fail/T9612.stderr
- testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_fail/tcfail143.stderr
- utils/deriveConstants/Main.hs
- utils/ghc-pkg/Main.hs
- utils/ghc-toolchain/exe/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- − utils/iserv/cbits/iservmain.c
- utils/iserv/iserv.cabal.in
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e552b7fc831bae5d70a0c3db57703a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e552b7fc831bae5d70a0c3db57703a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/dcoutts/windows-dlls] Try using response files for hadrian linking with ghc.
by Duncan Coutts (＠dcoutts) 09 Jan '26
by Duncan Coutts (＠dcoutts) 09 Jan '26
09 Jan '26
Duncan Coutts pushed to branch wip/dcoutts/windows-dlls at Glasgow Haskell Compiler / GHC
Commits:
0e08233b by Duncan Coutts at 2026-01-09T14:25:42+00:00
Try using response files for hadrian linking with ghc.
On windows, the link command line for ghc-internal is well over 32kb.
We did not encounter this before for static libs, since we already use
ar's @file feature (if available, which it is for the llvm toolchain).
We encounter this now on windows for linking dll files (which uses ghc
calling (l)ld rather than ar).
- - - - -
1 changed file:
- hadrian/src/Builder.hs
Changes:
=====================================
hadrian/src/Builder.hs
=====================================
@@ -356,6 +356,9 @@ instance H.Builder Builder where
Ghc FindHsDependencies _ -> do
runGhcWithResponse path buildArgs buildInputs
+ Ghc LinkHs _ -> do
+ runGhcWithResponse path buildArgs buildInputs
+
HsCpp -> captureStdout
Make dir -> cmd' buildOptions path ["-C", dir] buildArgs
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e08233b138793c733797ba7bdebff0…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e08233b138793c733797ba7bdebff0…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: ghc-internal: Move STM utilities out of GHC.Internal.Conc.Sync
by Marge Bot (＠marge-bot) 09 Jan '26
by Marge Bot (＠marge-bot) 09 Jan '26
09 Jan '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
00e17eee by Ben Gamari at 2026-01-09T08:45:52-05:00
ghc-internal: Move STM utilities out of GHC.Internal.Conc.Sync
This is necessary to avoid an import cycle on Windows when importing
`GHC.Internal.Exception.Context` in `GHC.Internal.Conc.Sync`.
On the road to address #25365.
- - - - -
f8c0aa39 by Ben Gamari at 2026-01-09T08:45:52-05:00
base: Capture backtrace from throwSTM
Implements core-libraries-committee#297.
Fixes #25365.
- - - - -
a43f07b2 by Ben Gamari at 2026-01-09T08:45:52-05:00
base: Annotate rethrown exceptions in catchSTM with WhileHandling
Implements core-libraries-committee#298
- - - - -
fe7f0b67 by Cheng Shao at 2026-01-09T08:45:53-05:00
compiler: make getPrim eagerly evaluate its result
This commit makes `GHC.Utils.Binary.getPrim` eagerly evaluate its
result, to avoid accidental laziness when future patches build other
binary parsers using `getPrim`.
- - - - -
5cbb00db by Cheng Shao at 2026-01-09T08:45:53-05:00
compiler: implement fast get/put for Word16/Word32/Word64
Previously, `GHC.Utils.Binary` contains `get`/`put` functions for
`Word16`/`Word32`/`Word64` which always loads and stores them as
big-endian words at a potentially unaligned address. The previous
implementation is based on loads/stores of individual bytes and
concatenating bytes with bitwise operations, which currently cannot be
fused to a single load/store operation by GHC.
This patch implements fast `get`/`put` functions for
`Word16`/`Word32`/`Word64` based on a single memory load/store, with
an additional `byteSwap` operation on little-endian hosts. It is based
on unaligned load/store primops added since GHC 9.10, and we already
require booting with at least 9.10, so it's about time to switch to
this faster path.
- - - - -
b46639e3 by Simon Peyton Jones at 2026-01-09T08:45:54-05:00
Fix scoping errors in specialisation
Using -fspecialise-aggressively in #26682 showed up a couple of
subtle errors in the type-class specialiser.
* dumpBindUDs failed to call `deleteCallsMentioning`, resulting in a
call that mentioned a dictionary that was not in scope. This call
has been missing since 2009!
commit c43c981705ec33da92a9ce91eb90f2ecf00be9fe
Author: Simon Peyton Jones <simonpj(a)microsoft.com>
Date: Fri Oct 23 16:15:51 2009 +0000
Fixed by re-combining `dumpBindUDs` and `dumpUDs`.
* I think there was another bug involving the quantified type
variables in polymorphic specialisation. In any case I refactored
`specHeader` and `spec_call` so that the former looks for the
extra quantified type variables rather than the latter. This
is quite a worthwhile simplification: less code, easier to grok.
Test case in simplCore/should_compile/T26682,
brilliantly minimised by @sheaf.
- - - - -
c7354cc1 by Matthew Craven at 2026-01-09T08:45:55-05:00
Account for "stupid theta" in demand sig for DataCon wrappers
Fixes #26748.
- - - - -
25 changed files:
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Utils/Binary.hs
- libraries/base/changelog.md
- libraries/base/src/GHC/Conc.hs
- libraries/base/src/GHC/Conc/Sync.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
- + libraries/ghc-internal/src/GHC/Internal/STM.hs
- + testsuite/tests/dmdanal/should_run/T26748.hs
- + testsuite/tests/dmdanal/should_run/T26748.stdout
- testsuite/tests/dmdanal/should_run/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/simplCore/should_compile/T26682.hs
- + testsuite/tests/simplCore/should_compile/T26682a.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -654,9 +654,7 @@ specProgram guts@(ModGuts { mg_module = this_mod
-- Easiest thing is to do it all at once, as if all the top-level
-- decls were mutually recursive
; let top_env = SE { se_subst = Core.mkEmptySubst $
- mkInScopeSetBndrs binds
- -- mkInScopeSetList $
- -- bindersOfBinds binds
+ mkInScopeSetBndrs binds
, se_module = this_mod
, se_rules = rule_env
, se_dflags = dflags }
@@ -816,9 +814,12 @@ spec_imports env callers dict_binds calls
go :: SpecEnv -> [CallInfoSet] -> CoreM (SpecEnv, [CoreRule], [CoreBind])
go env [] = return (env, [], [])
go env (cis : other_calls)
- = do { -- debugTraceMsg (text "specImport {" <+> ppr cis)
+ = do {
+-- debugTraceMsg (text "specImport {" <+> vcat [ ppr cis
+-- , text "callers" <+> ppr callers
+-- , text "dict_binds" <+> ppr dict_binds ])
; (env, rules1, spec_binds1) <- spec_import env callers dict_binds cis
- ; -- debugTraceMsg (text "specImport }" <+> ppr cis)
+-- ; debugTraceMsg (text "specImport }" <+> ppr cis)
; (env, rules2, spec_binds2) <- go env other_calls
; return (env, rules1 ++ rules2, spec_binds1 ++ spec_binds2) }
@@ -835,13 +836,18 @@ spec_import :: SpecEnv -- Passed in so that all top-level Ids are
, [CoreBind] ) -- Specialised bindings
spec_import env callers dict_binds cis@(CIS fn _)
| isIn "specImport" fn callers
- = return (env, [], []) -- No warning. This actually happens all the time
- -- when specialising a recursive function, because
- -- the RHS of the specialised function contains a recursive
- -- call to the original function
+ = do {
+-- debugTraceMsg (text "specImport1-bad" <+> (ppr fn $$ text "callers" <+> ppr callers))
+ ; return (env, [], []) }
+ -- No warning. This actually happens all the time
+ -- when specialising a recursive function, because
+ -- the RHS of the specialised function contains a recursive
+ -- call to the original function
| null good_calls
- = return (env, [], [])
+ = do {
+-- debugTraceMsg (text "specImport1-no-good" <+> (ppr cis $$ text "dict_binds" <+> ppr dict_binds))
+ ; return (env, [], []) }
| Just rhs <- canSpecImport dflags fn
= do { -- Get rules from the external package state
@@ -890,7 +896,10 @@ spec_import env callers dict_binds cis@(CIS fn _)
; return (env, rules2 ++ rules1, final_binds) }
| otherwise
- = do { tryWarnMissingSpecs dflags callers fn good_calls
+ = do {
+-- debugTraceMsg (hang (text "specImport1-missed")
+-- 2 (vcat [ppr cis, text "can-spec" <+> ppr (canSpecImport dflags fn)]))
+ ; tryWarnMissingSpecs dflags callers fn good_calls
; return (env, [], [])}
where
@@ -1455,7 +1464,9 @@ specBind top_lvl env (NonRec fn rhs) do_body
; (fn4, spec_defns, body_uds1) <- specDefn env body_uds fn3 rhs
- ; let (free_uds, dump_dbs, float_all) = dumpBindUDs [fn4] body_uds1
+ ; let can_float_this_one = exprIsTopLevelBindable rhs (idType fn)
+ -- exprIsTopLevelBindable: see Note [Care with unlifted bindings]
+ (free_uds, dump_dbs, float_all) = dumpBindUDs can_float_this_one [fn4] body_uds1
all_free_uds = free_uds `thenUDs` rhs_uds
pairs = spec_defns ++ [(fn4, rhs')]
@@ -1471,10 +1482,8 @@ specBind top_lvl env (NonRec fn rhs) do_body
= [mkDB $ NonRec b r | (b,r) <- pairs]
++ fromOL dump_dbs
- can_float_this_one = exprIsTopLevelBindable rhs (idType fn)
- -- exprIsTopLevelBindable: see Note [Care with unlifted bindings]
- ; if float_all && can_float_this_one then
+ ; if float_all then
-- Rather than discard the calls mentioning the bound variables
-- we float this (dictionary) binding along with the others
return ([], body', all_free_uds `snocDictBinds` final_binds)
@@ -1509,7 +1518,7 @@ specBind top_lvl env (Rec pairs) do_body
<- specDefns rec_env uds2 (bndrs2 `zip` rhss)
; return (bndrs3, spec_defns3 ++ spec_defns2, uds3) }
- ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs bndrs1 uds3
+ ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs True bndrs1 uds3
final_bind = recWithDumpedDicts (spec_defns3 ++ zip bndrs3 rhss')
dumped_dbs
@@ -1630,7 +1639,6 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
dflags = se_dflags env
this_mod = se_module env
subst = se_subst env
- in_scope = Core.substInScopeSet subst
-- Figure out whether the function has an INLINE pragma
-- See Note [Inline specialisations]
@@ -1646,9 +1654,6 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
| otherwise
= inl_prag
- not_in_scope :: InterestingVarFun
- not_in_scope v = isLocalVar v && not (v `elemInScopeSet` in_scope)
-
----------------------------------------------------------
-- Specialise to one particular call pattern
spec_call :: SpecInfo -- Accumulating parameter
@@ -1662,47 +1667,34 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
mk_extra_dfun_arg bndr | isTyVar bndr = UnspecType
| otherwise = UnspecArg
- -- Find qvars, the type variables to add to the binders for the rule
- -- Namely those free in `ty` that aren't in scope
- -- See (MP2) in Note [Specialising polymorphic dictionaries]
- ; let poly_qvars = scopedSort $ fvVarList $ specArgsFVs not_in_scope call_args
- subst' = subst `Core.extendSubstInScopeList` poly_qvars
- -- Maybe we should clone the poly_qvars telescope?
-
- -- Any free Ids will have caused the call to be dropped
- ; massertPpr (all isTyCoVar poly_qvars)
- (ppr fn $$ ppr all_call_args $$ ppr poly_qvars)
-
- ; (useful, subst'', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args)
- <- specHeader subst' rhs_bndrs all_call_args
- ; let all_rule_bndrs = poly_qvars ++ rule_bndrs
- env' = env { se_subst = subst'' }
+ ; (useful, subst', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args)
+ <- specHeader subst rhs_bndrs all_call_args
+ ; let env' = env { se_subst = subst' }
-- Check for (a) usefulness and (b) not already covered
-- See (SC1) in Note [Specialisations already covered]
; let all_rules = rules_acc ++ existing_rules
-- all_rules: we look both in the rules_acc (generated by this invocation
-- of specCalls), and in existing_rules (passed in to specCalls)
- already_covered = alreadyCovered env' all_rule_bndrs fn
+ already_covered = alreadyCovered env' rule_bndrs fn
rule_lhs_args is_active all_rules
-{- ; pprTrace "spec_call" (vcat
- [ text "fun: " <+> ppr fn
- , text "call info: " <+> ppr _ci
- , text "useful: " <+> ppr useful
- , text "already_covered:" <+> ppr already_covered
- , text "poly_qvars: " <+> ppr poly_qvars
- , text "useful: " <+> ppr useful
- , text "all_rule_bndrs:" <+> ppr all_rule_bndrs
- , text "rule_lhs_args:" <+> ppr rule_lhs_args
- , text "spec_bndrs:" <+> ppr spec_bndrs
- , text "dx_binds:" <+> ppr dx_binds
- , text "spec_args: " <+> ppr spec_args
- , text "rhs_bndrs" <+> ppr rhs_bndrs
- , text "rhs_body" <+> ppr rhs_body
- , text "subst''" <+> ppr subst'' ]) $
- return ()
--}
+-- ; pprTrace "spec_call" (vcat
+-- [ text "fun: " <+> ppr fn
+-- , text "call info: " <+> ppr _ci
+-- , text "useful: " <+> ppr useful
+-- , text "already_covered:" <+> ppr already_covered
+-- , text "useful: " <+> ppr useful
+-- , text "rule_bndrs:" <+> ppr (sep (map (pprBndr LambdaBind) rule_bndrs))
+-- , text "rule_lhs_args:" <+> ppr rule_lhs_args
+-- , text "spec_bndrs:" <+> ppr (sep (map (pprBndr LambdaBind) spec_bndrs))
+-- , text "dx_binds:" <+> ppr dx_binds
+-- , text "spec_args: " <+> ppr spec_args
+-- , text "rhs_bndrs" <+> ppr (sep (map (pprBndr LambdaBind) rhs_bndrs))
+-- , text "rhs_body" <+> ppr rhs_body
+-- , text "subst'" <+> ppr subst'
+-- ]) $ return ()
+
; if not useful -- No useful specialisation
|| already_covered -- Useful, but done already
@@ -1716,23 +1708,15 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
-- Run the specialiser on the specialised RHS
; (rhs_body', rhs_uds) <- specExpr env'' rhs_body
-{- ; pprTrace "spec_call2" (vcat
- [ text "fun:" <+> ppr fn
- , text "rhs_body':" <+> ppr rhs_body' ]) $
- return ()
--}
-
-- Make the RHS of the specialised function
; let spec_rhs_bndrs = spec_bndrs ++ inner_rhs_bndrs'
- (rhs_uds1, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs rhs_uds
- (rhs_uds2, outer_dumped_dbs) = dumpUDs poly_qvars (dx_binds `consDictBinds` rhs_uds1)
- -- dx_binds comes from the arguments to the call, and so can mention
- -- poly_qvars but no other local binders
- spec_rhs = mkLams poly_qvars $
- wrapDictBindsE outer_dumped_dbs $
- mkLams spec_rhs_bndrs $
+ (rhs_uds2, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs $
+ dx_binds `consDictBinds` rhs_uds
+ -- dx_binds comes from the arguments to the call,
+ -- and so can mention poly_qvars but no other local binders
+ spec_rhs = mkLams spec_rhs_bndrs $
wrapDictBindsE inner_dumped_dbs rhs_body'
- rule_rhs_args = poly_qvars ++ spec_bndrs
+ rule_rhs_args = spec_bndrs
-- Maybe add a void arg to the specialised function,
-- to avoid unlifted bindings
@@ -1787,7 +1771,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
text "SPEC"
spec_rule = mkSpecRule dflags this_mod True inl_act
- herald fn all_rule_bndrs rule_lhs_args
+ herald fn rule_bndrs rule_lhs_args
(mkVarApps (Var spec_fn) rule_rhs_args1)
_rule_trace_doc = vcat [ ppr fn <+> dcolon <+> ppr fn_type
@@ -1798,8 +1782,12 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
, text "existing" <+> ppr existing_rules
]
- ; -- pprTrace "spec_call: rule" _rule_trace_doc
- return ( spec_rule : rules_acc
+-- ; pprTrace "spec_call: rule" (vcat [ -- text "poly_qvars" <+> ppr poly_qvars
+-- text "rule_bndrs" <+> ppr rule_bndrs
+-- , text "rule_lhs_args" <+> ppr rule_lhs_args
+-- , text "all_call_args" <+> ppr all_call_args
+-- , ppr spec_rule ]) $
+ ; return ( spec_rule : rules_acc
, (spec_fn, spec_rhs1) : pairs_acc
, rhs_uds2 `thenUDs` uds_acc
) } }
@@ -1946,6 +1934,16 @@ floating to top level anyway; but that is hard to spot (since we don't know what
the non-top-level in-scope binders are) and rare (since the binding must satisfy
Note [Core let-can-float invariant] in GHC.Core).
+Arguably we'd be better off if we had left that `x` in the RHS of `n`, thus
+ f x = let n::Natural = let x::ByteArray# = <some literal> in
+ NB x
+ in wombat @192827 (n |> co)
+Now we could float `n` happily. But that's in conflict with exposing the `NB`
+data constructor in the body of the `let`, so I'm leaving this unresolved.
+
+Another case came up in #26682, where the binding had an unlifted sum type
+(# Word# | ByteArray# #), itself arising from an UNPACK pragma. Test case
+T26682.
Note [Specialising Calls]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2593,12 +2591,22 @@ specHeader subst _ [] = pure (False, subst, [], [], [], [], [])
-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding
-- details.
specHeader subst (bndr:bndrs) (SpecType ty : args)
- = do { let subst1 = Core.extendTvSubst subst bndr ty
- ; (useful, subst2, rule_bs, rule_args, spec_bs, dx, spec_args)
- <- specHeader subst1 bndrs args
- ; pure ( useful, subst2
- , rule_bs, Type ty : rule_args
- , spec_bs, dx, Type ty : spec_args ) }
+ = do { -- Find free_tvs, the type variables to add to the binders for the rule
+ -- Namely those free in `ty` that aren't in scope
+ -- See (MP2) in Note [Specialising polymorphic dictionaries]
+ let in_scope = Core.substInScopeSet subst
+ not_in_scope tv = not (tv `elemInScopeSet` in_scope)
+ free_tvs = scopedSort $ fvVarList $
+ filterFV not_in_scope $
+ tyCoFVsOfType ty
+ subst1 = subst `Core.extendSubstInScopeList` free_tvs
+
+ ; let subst2 = Core.extendTvSubst subst1 bndr ty
+ ; (useful, subst3, rule_bs, rule_args, spec_bs, dx, spec_args)
+ <- specHeader subst2 bndrs args
+ ; pure ( useful, subst3
+ , free_tvs ++ rule_bs, Type ty : rule_args
+ , free_tvs ++ spec_bs, dx, Type ty : spec_args ) }
-- Next we have a type that we don't want to specialise. We need to perform
-- a substitution on it (in case the type refers to 'a'). Additionally, we need
@@ -2682,7 +2690,7 @@ bindAuxiliaryDict subst orig_dict_id fresh_dict_id dict_arg
-- don’t bother creating a new dict binding; just substitute
| exprIsTrivial dict_arg
, let subst' = Core.extendSubst subst orig_dict_id dict_arg
- = -- pprTrace "bindAuxiliaryDict:trivial" (ppr orig_dict_id <+> ppr dict_id) $
+ = -- pprTrace "bindAuxiliaryDict:trivial" (ppr orig_dict_id <+> ppr dict_arg) $
(subst', Nothing, dict_arg)
| otherwise -- Non-trivial dictionary arg; make an auxiliary binding
@@ -2978,7 +2986,8 @@ pprCallInfo fn (CI { ci_key = key })
instance Outputable CallInfo where
ppr (CI { ci_key = key, ci_fvs = _fvs })
- = text "CI" <> braces (sep (map ppr key))
+ = text "CI" <> braces (text "fvs" <+> ppr _fvs
+ $$ sep (map ppr key))
unionCalls :: CallDetails -> CallDetails -> CallDetails
unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2
@@ -3394,38 +3403,49 @@ wrapDictBindsE dbs expr
----------------------
dumpUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind)
--- Used at a lambda or case binder; just dump anything mentioning the binder
+-- Used at binder; just dump anything mentioning the binder
dumpUDs bndrs uds@(MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
| null bndrs = (uds, nilOL) -- Common in case alternatives
| otherwise = -- pprTrace "dumpUDs" (vcat
- -- [ text "bndrs" <+> ppr bndrs
- -- , text "uds" <+> ppr uds
- -- , text "free_uds" <+> ppr free_uds
- -- , text "dump-dbs" <+> ppr dump_dbs ]) $
+ -- [ text "bndrs" <+> ppr bndrs
+ -- , text "uds" <+> ppr uds
+ -- , text "free_uds" <+> ppr free_uds
+ -- , text "dump_dbs" <+> ppr dump_dbs ]) $
(free_uds, dump_dbs)
where
free_uds = uds { ud_binds = free_dbs, ud_calls = free_calls }
bndr_set = mkVarSet bndrs
(free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set
- free_calls = deleteCallsMentioning dump_set $ -- Drop calls mentioning bndr_set on the floor
- deleteCallsFor bndrs orig_calls -- Discard calls for bndr_set; there should be
- -- no calls for any of the dicts in dump_dbs
-dumpBindUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind, Bool)
+ -- Delete calls:
+ -- * For any binder in `bndrs`
+ -- * That mention a dictionary bound in `dump_set`
+ -- These variables aren't in scope "above" the binding and the `dump_dbs`,
+ -- so no call should mention them. (See #26682.)
+ free_calls = deleteCallsMentioning dump_set $
+ deleteCallsFor bndrs orig_calls
+
+dumpBindUDs :: Bool -- Main binding can float to top
+ -> [CoreBndr] -> UsageDetails
+ -> (UsageDetails, OrdList DictBind, Bool)
-- Used at a let(rec) binding.
--- We return a boolean indicating whether the binding itself is mentioned,
--- directly or indirectly, by any of the ud_calls; in that case we want to
--- float the binding itself;
--- See Note [Floated dictionary bindings]
-dumpBindUDs bndrs (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
- = -- pprTrace "dumpBindUDs" (ppr bndrs $$ ppr free_uds $$ ppr dump_dbs $$ ppr float_all) $
- (free_uds, dump_dbs, float_all)
+-- We return a boolean indicating whether the binding itself
+-- is mentioned, directly or indirectly, by any of the ud_calls;
+-- in that case we want to float the binding itself.
+-- See Note [Floated dictionary bindings]
+-- If the boolean is True, then the returned ud_calls can mention `bndrs`;
+-- if False, then returned ud_calls must not mention `bndrs`
+dumpBindUDs can_float_bind bndrs (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
+ = ( MkUD { ud_binds = free_dbs, ud_calls = free_calls2 }
+ , dump_dbs
+ , can_float_bind && calls_mention_bndrs )
where
- free_uds = MkUD { ud_binds = free_dbs, ud_calls = free_calls }
bndr_set = mkVarSet bndrs
(free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set
- free_calls = deleteCallsFor bndrs orig_calls
- float_all = dump_set `intersectsVarSet` callDetailsFVs free_calls
+ free_calls1 = deleteCallsFor bndrs orig_calls
+ calls_mention_bndrs = dump_set `intersectsVarSet` callDetailsFVs free_calls1
+ free_calls2 | can_float_bind = free_calls1
+ | otherwise = deleteCallsMentioning dump_set free_calls1
callsForMe :: Id -> UsageDetails -> (UsageDetails, [CallInfo])
callsForMe fn uds@MkUD { ud_binds = orig_dbs, ud_calls = orig_calls }
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -825,9 +825,10 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con
-- LFInfo stores post-unarisation arity
wrap_arg_dmds =
- replicate (length theta) topDmd ++ map mk_dmd arg_ibangs
+ replicate (length stupid_theta + length theta) topDmd
+ ++ map mk_dmd arg_ibangs
-- Don't forget the dictionary arguments when building
- -- the strictness signature (#14290).
+ -- the strictness signature (#14290, #26748).
mk_dmd str | isBanged str = evalDmd
| otherwise = topDmd
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE DerivingVia #-}
@@ -160,14 +161,17 @@ import qualified Data.Set as Set
import Data.Time
import Data.List (unfoldr)
import System.IO as IO
-import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO.Error ( mkIOError, eofErrorType )
import Type.Reflection ( Typeable, SomeTypeRep(..) )
import qualified Type.Reflection as Refl
import GHC.Real ( Ratio(..) )
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
+import GHC.ByteOrder
import GHC.ForeignPtr ( unsafeWithForeignPtr )
+import GHC.Exts
+import GHC.IO
+import GHC.Word
import Unsafe.Coerce (unsafeCoerce)
@@ -638,7 +642,7 @@ getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do
ix <- readFastMutInt ix_r
when (ix + size > sz_r) $
ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing)
- w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix)
+ !w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix)
-- This is safe WRT #17760 as we we guarantee that the above line doesn't
-- diverge
writeFastMutInt ix_r (ix + size)
@@ -651,71 +655,52 @@ getWord8 :: ReadBinHandle -> IO Word8
getWord8 h = getPrim h 1 peek
putWord16 :: WriteBinHandle -> Word16 -> IO ()
-putWord16 h w = putPrim h 2 (\op -> do
- pokeElemOff op 0 (fromIntegral (w `shiftR` 8))
- pokeElemOff op 1 (fromIntegral (w .&. 0xFF))
- )
+putWord16 h w = putPrim h 2 $ \(Ptr p#) ->
+ IO $ \s -> (# writeWord8OffAddrAsWord16# p# 0# x# s, () #)
+ where
+ !(W16# x#) = case targetByteOrder of
+ BigEndian -> w
+ LittleEndian -> byteSwap16 w
getWord16 :: ReadBinHandle -> IO Word16
-getWord16 h = getPrim h 2 (\op -> do
- w0 <- fromIntegral <$> peekElemOff op 0
- w1 <- fromIntegral <$> peekElemOff op 1
- return $! w0 `shiftL` 8 .|. w1
- )
+getWord16 h = getPrim h 2 $ \(Ptr p#) ->
+ IO $ \s -> case readWord8OffAddrAsWord16# p# 0# s of
+ (# s', w16# #) -> case targetByteOrder of
+ BigEndian -> (# s', W16# w16# #)
+ LittleEndian -> case byteSwap16 $ W16# w16# of
+ !w16 -> (# s', w16 #)
putWord32 :: WriteBinHandle -> Word32 -> IO ()
-putWord32 h w = putPrim h 4 (\op -> do
- pokeElemOff op 0 (fromIntegral (w `shiftR` 24))
- pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
- pokeElemOff op 2 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
- pokeElemOff op 3 (fromIntegral (w .&. 0xFF))
- )
+putWord32 h w = putPrim h 4 $ \(Ptr p#) ->
+ IO $ \s -> (# writeWord8OffAddrAsWord32# p# 0# x# s, () #)
+ where
+ !(W32# x#) = case targetByteOrder of
+ BigEndian -> w
+ LittleEndian -> byteSwap32 w
getWord32 :: ReadBinHandle -> IO Word32
-getWord32 h = getPrim h 4 (\op -> do
- w0 <- fromIntegral <$> peekElemOff op 0
- w1 <- fromIntegral <$> peekElemOff op 1
- w2 <- fromIntegral <$> peekElemOff op 2
- w3 <- fromIntegral <$> peekElemOff op 3
-
- return $! (w0 `shiftL` 24) .|.
- (w1 `shiftL` 16) .|.
- (w2 `shiftL` 8) .|.
- w3
- )
+getWord32 h = getPrim h 4 $ \(Ptr p#) ->
+ IO $ \s -> case readWord8OffAddrAsWord32# p# 0# s of
+ (# s', w32# #) -> case targetByteOrder of
+ BigEndian -> (# s', W32# w32# #)
+ LittleEndian -> case byteSwap32 $ W32# w32# of
+ !w32 -> (# s', w32 #)
putWord64 :: WriteBinHandle -> Word64 -> IO ()
-putWord64 h w = putPrim h 8 (\op -> do
- pokeElemOff op 0 (fromIntegral (w `shiftR` 56))
- pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))
- pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))
- pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))
- pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))
- pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
- pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
- pokeElemOff op 7 (fromIntegral (w .&. 0xFF))
- )
+putWord64 h w = putPrim h 8 $ \(Ptr p#) ->
+ IO $ \s -> (# writeWord8OffAddrAsWord64# p# 0# x# s, () #)
+ where
+ !(W64# x#) = case targetByteOrder of
+ BigEndian -> w
+ LittleEndian -> byteSwap64 w
getWord64 :: ReadBinHandle -> IO Word64
-getWord64 h = getPrim h 8 (\op -> do
- w0 <- fromIntegral <$> peekElemOff op 0
- w1 <- fromIntegral <$> peekElemOff op 1
- w2 <- fromIntegral <$> peekElemOff op 2
- w3 <- fromIntegral <$> peekElemOff op 3
- w4 <- fromIntegral <$> peekElemOff op 4
- w5 <- fromIntegral <$> peekElemOff op 5
- w6 <- fromIntegral <$> peekElemOff op 6
- w7 <- fromIntegral <$> peekElemOff op 7
-
- return $! (w0 `shiftL` 56) .|.
- (w1 `shiftL` 48) .|.
- (w2 `shiftL` 40) .|.
- (w3 `shiftL` 32) .|.
- (w4 `shiftL` 24) .|.
- (w5 `shiftL` 16) .|.
- (w6 `shiftL` 8) .|.
- w7
- )
+getWord64 h = getPrim h 8 $ \(Ptr p#) ->
+ IO $ \s -> case readWord8OffAddrAsWord64# p# 0# s of
+ (# s', w64# #) -> case targetByteOrder of
+ BigEndian -> (# s', W64# w64# #)
+ LittleEndian -> case byteSwap64 $ W64# w64# of
+ !w64 -> (# s', w64 #)
putByte :: WriteBinHandle -> Word8 -> IO ()
putByte bh !w = putWord8 bh w
=====================================
libraries/base/changelog.md
=====================================
@@ -17,6 +17,8 @@
* Adjust the strictness of `Data.List.iterate'` to be more reasonable: every element of the output list is forced to WHNF when the `(:)` containing it is forced. ([CLC proposal #335)](https://github.com/haskell/core-libraries-committee/issues/335)
* Add `nubOrd` / `nubOrdBy` to `Data.List` and `Data.List.NonEmpty`. ([CLC proposal #336](https://github.com/haskell/core-libraries-committee/issues/336))
* Add `Semigroup` and `Monoid` instances for `Control.Monad.ST.Lazy`. ([CLC proposal #374](https://github.com/haskell/core-libraries-committee/issues/374))
+ * `GHC.Conc.throwSTM` and `GHC.Conc.Sync.throwSTM` now carry a `HasCallStack` constraint and attach a `Backtrace` annotation to the thrown exception. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365))
+ * `GHC.Conc.catchSTM` and `GHC.Conc.Sync.catchSTM` now attach `WhileHandling` annotation to exceptions thrown from the handler. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365))
## 4.22.0.0 *TBA*
* Shipped with GHC 9.14.1
=====================================
libraries/base/src/GHC/Conc.hs
=====================================
@@ -119,6 +119,7 @@ module GHC.Conc
import GHC.Internal.Conc.IO
import GHC.Internal.Conc.Sync
+import GHC.Internal.STM
#if !defined(mingw32_HOST_OS)
import GHC.Internal.Conc.Signal
=====================================
libraries/base/src/GHC/Conc/Sync.hs
=====================================
@@ -89,3 +89,4 @@ module GHC.Conc.Sync
) where
import GHC.Internal.Conc.Sync
+import GHC.Internal.STM
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -293,6 +293,7 @@ Library
GHC.Internal.StaticPtr
GHC.Internal.STRef
GHC.Internal.Show
+ GHC.Internal.STM
GHC.Internal.Stable
GHC.Internal.StableName
GHC.Internal.Stack
=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
=====================================
@@ -60,6 +60,7 @@ module GHC.Internal.Conc.IO
import GHC.Internal.Base
import GHC.Internal.Conc.Sync as Sync
+import GHC.Internal.STM as STM
import GHC.Internal.Real ( fromIntegral )
import GHC.Internal.System.Posix.Types
@@ -142,17 +143,17 @@ threadWaitWrite fd
-- to read from a file descriptor. The second returned value
-- is an IO action that can be used to deregister interest
-- in the file descriptor.
-threadWaitReadSTM :: Fd -> IO (Sync.STM (), IO ())
+threadWaitReadSTM :: Fd -> IO (STM.STM (), IO ())
threadWaitReadSTM fd
#if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
| threaded = Event.threadWaitReadSTM fd
#endif
| otherwise = do
- m <- Sync.newTVarIO False
+ m <- STM.newTVarIO False
t <- Sync.forkIO $ do
threadWaitRead fd
- Sync.atomically $ Sync.writeTVar m True
- let waitAction = do b <- Sync.readTVar m
+ STM.atomically $ STM.writeTVar m True
+ let waitAction = do b <- STM.readTVar m
if b then return () else retry
let killAction = Sync.killThread t
return (waitAction, killAction)
@@ -161,17 +162,17 @@ threadWaitReadSTM fd
-- can be written to a file descriptor. The second returned value
-- is an IO action that can be used to deregister interest
-- in the file descriptor.
-threadWaitWriteSTM :: Fd -> IO (Sync.STM (), IO ())
+threadWaitWriteSTM :: Fd -> IO (STM.STM (), IO ())
threadWaitWriteSTM fd
#if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
| threaded = Event.threadWaitWriteSTM fd
#endif
| otherwise = do
- m <- Sync.newTVarIO False
+ m <- STM.newTVarIO False
t <- Sync.forkIO $ do
threadWaitWrite fd
- Sync.atomically $ Sync.writeTVar m True
- let waitAction = do b <- Sync.readTVar m
+ STM.atomically $ STM.writeTVar m True
+ let waitAction = do b <- STM.readTVar m
if b then return () else retry
let killAction = Sync.killThread t
return (waitAction, killAction)
=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
=====================================
@@ -56,6 +56,7 @@ import GHC.Internal.MVar
import GHC.Internal.Num (Num(..))
import GHC.Internal.Ptr
import GHC.Internal.Real (div, fromIntegral)
+import GHC.Internal.STM (TVar, atomically, newTVar, writeTVar)
import GHC.Internal.Word (Word32, Word64)
import GHC.Internal.Windows
=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
=====================================
@@ -76,21 +76,6 @@ module GHC.Internal.Conc.Sync
, enableAllocationLimit
, disableAllocationLimit
- -- * TVars
- , STM(..)
- , atomically
- , retry
- , orElse
- , throwSTM
- , catchSTM
- , TVar(..)
- , newTVar
- , newTVarIO
- , readTVar
- , readTVarIO
- , writeTVar
- , unsafeIOToSTM
-
-- * Miscellaneous
, withMVar
, modifyMVar_
@@ -665,220 +650,6 @@ mkWeakThreadId t@(ThreadId t#) = IO $ \s ->
(# s1, w #) -> (# s1, Weak w #)
------------------------------------------------------------------------------
--- Transactional heap operations
------------------------------------------------------------------------------
-
--- TVars are shared memory locations which support atomic memory
--- transactions.
-
--- |A monad supporting atomic memory transactions.
-newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #))
-
-unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))
-unSTM (STM a) = a
-
--- | @since base-4.3.0.0
-instance Functor STM where
- fmap f x = x >>= (pure . f)
-
--- | @since base-4.8.0.0
-instance Applicative STM where
- {-# INLINE pure #-}
- {-# INLINE (*>) #-}
- {-# INLINE liftA2 #-}
- pure x = returnSTM x
- (<*>) = ap
- liftA2 = liftM2
- m *> k = thenSTM m k
-
--- | @since base-4.3.0.0
-instance Monad STM where
- {-# INLINE (>>=) #-}
- m >>= k = bindSTM m k
- (>>) = (*>)
-
--- | @since base-4.17.0.0
-instance Semigroup a => Semigroup (STM a) where
- (<>) = liftA2 (<>)
-
--- | @since base-4.17.0.0
-instance Monoid a => Monoid (STM a) where
- mempty = pure mempty
-
-bindSTM :: STM a -> (a -> STM b) -> STM b
-bindSTM (STM m) k = STM ( \s ->
- case m s of
- (# new_s, a #) -> unSTM (k a) new_s
- )
-
-thenSTM :: STM a -> STM b -> STM b
-thenSTM (STM m) k = STM ( \s ->
- case m s of
- (# new_s, _ #) -> unSTM k new_s
- )
-
-returnSTM :: a -> STM a
-returnSTM x = STM (\s -> (# s, x #))
-
--- | Takes the first non-'retry'ing 'STM' action.
---
--- @since base-4.8.0.0
-instance Alternative STM where
- empty = retry
- (<|>) = orElse
-
--- | Takes the first non-'retry'ing 'STM' action.
---
--- @since base-4.3.0.0
-instance MonadPlus STM
-
--- | Unsafely performs IO in the STM monad. Beware: this is a highly
--- dangerous thing to do.
---
--- * The STM implementation will often run transactions multiple
--- times, so you need to be prepared for this if your IO has any
--- side effects.
---
--- * The STM implementation will abort transactions that are known to
--- be invalid and need to be restarted. This may happen in the middle
--- of `unsafeIOToSTM`, so make sure you don't acquire any resources
--- that need releasing (exception handlers are ignored when aborting
--- the transaction). That includes doing any IO using Handles, for
--- example. Getting this wrong will probably lead to random deadlocks.
---
--- * The transaction may have seen an inconsistent view of memory when
--- the IO runs. Invariants that you expect to be true throughout
--- your program may not be true inside a transaction, due to the
--- way transactions are implemented. Normally this wouldn't be visible
--- to the programmer, but using `unsafeIOToSTM` can expose it.
---
-unsafeIOToSTM :: IO a -> STM a
-unsafeIOToSTM (IO m) = STM m
-
--- | Perform a series of STM actions atomically.
---
--- Using 'atomically' inside an 'unsafePerformIO' or 'unsafeInterleaveIO'
--- subverts some of guarantees that STM provides. It makes it possible to
--- run a transaction inside of another transaction, depending on when the
--- thunk is evaluated. If a nested transaction is attempted, an exception
--- is thrown by the runtime. It is possible to safely use 'atomically' inside
--- 'unsafePerformIO' or 'unsafeInterleaveIO', but the typechecker does not
--- rule out programs that may attempt nested transactions, meaning that
--- the programmer must take special care to prevent these.
---
--- However, there are functions for creating transactional variables that
--- can always be safely called in 'unsafePerformIO'. See: 'newTVarIO',
--- 'Control.Concurrent.STM.TChan.newTChanIO',
--- 'Control.Concurrent.STM.TChan.newBroadcastTChanIO',
--- 'Control.Concurrent.STM.TQueue.newTQueueIO',
--- 'Control.Concurrent.STM.TBQueue.newTBQueueIO', and
--- 'Control.Concurrent.STM.TMVar.newTMVarIO'.
---
--- Using 'unsafePerformIO' inside of 'atomically' is also dangerous but for
--- different reasons. See 'unsafeIOToSTM' for more on this.
-
-atomically :: STM a -> IO a
-atomically (STM m) = IO (\s -> (atomically# m) s )
-
--- | Retry execution of the current memory transaction because it has seen
--- values in 'TVar's which mean that it should not continue (e.g. the 'TVar's
--- represent a shared buffer that is now empty). The implementation may
--- block the thread until one of the 'TVar's that it has read from has been
--- updated. (GHC only)
-retry :: STM a
-retry = STM $ \s# -> retry# s#
-
--- | Compose two alternative STM actions (GHC only).
---
--- If the first action completes without retrying then it forms the result of
--- the 'orElse'. Otherwise, if the first action retries, then the second action
--- is tried in its place. If both actions retry then the 'orElse' as a whole
--- retries.
-orElse :: STM a -> STM a -> STM a
-orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
-
--- | A variant of 'throw' that can only be used within the 'STM' monad.
---
--- Throwing an exception in @STM@ aborts the transaction and propagates the
--- exception. If the exception is caught via 'catchSTM', only the changes
--- enclosed by the catch are rolled back; changes made outside of 'catchSTM'
--- persist.
---
--- If the exception is not caught inside of the 'STM', it is re-thrown by
--- 'atomically', and the entire 'STM' is rolled back.
---
--- Although 'throwSTM' has a type that is an instance of the type of 'throw', the
--- two functions are subtly different:
---
--- > throw e `seq` x ===> throw e
--- > throwSTM e `seq` x ===> x
---
--- The first example will cause the exception @e@ to be raised,
--- whereas the second one won\'t. In fact, 'throwSTM' will only cause
--- an exception to be raised when it is used within the 'STM' monad.
--- The 'throwSTM' variant should be used in preference to 'throw' to
--- raise an exception within the 'STM' monad because it guarantees
--- ordering with respect to other 'STM' operations, whereas 'throw'
--- does not.
-throwSTM :: Exception e => e -> STM a
-throwSTM e = STM $ raiseIO# (toException e)
-
--- | Exception handling within STM actions.
---
--- @'catchSTM' m f@ catches any exception thrown by @m@ using 'throwSTM',
--- using the function @f@ to handle the exception. If an exception is
--- thrown, any changes made by @m@ are rolled back, but changes prior to
--- @m@ persist.
-catchSTM :: Exception e => STM a -> (e -> STM a) -> STM a
-catchSTM (STM m) handler = STM $ catchSTM# m handler'
- where
- handler' e = case fromException e of
- Just e' -> unSTM (handler e')
- Nothing -> raiseIO# e
-
--- |Shared memory locations that support atomic memory transactions.
-data TVar a = TVar (TVar# RealWorld a)
-
--- | @since base-4.8.0.0
-instance Eq (TVar a) where
- (TVar tvar1#) == (TVar tvar2#) = isTrue# (sameTVar# tvar1# tvar2#)
-
--- | Create a new 'TVar' holding a value supplied
-newTVar :: a -> STM (TVar a)
-newTVar val = STM $ \s1# ->
- case newTVar# val s1# of
- (# s2#, tvar# #) -> (# s2#, TVar tvar# #)
-
--- | @IO@ version of 'newTVar'. This is useful for creating top-level
--- 'TVar's using 'System.IO.Unsafe.unsafePerformIO', because using
--- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
--- possible.
-newTVarIO :: a -> IO (TVar a)
-newTVarIO val = IO $ \s1# ->
- case newTVar# val s1# of
- (# s2#, tvar# #) -> (# s2#, TVar tvar# #)
-
--- | Return the current value stored in a 'TVar'.
--- This is equivalent to
---
--- > readTVarIO = atomically . readTVar
---
--- but works much faster, because it doesn't perform a complete
--- transaction, it just reads the current value of the 'TVar'.
-readTVarIO :: TVar a -> IO a
-readTVarIO (TVar tvar#) = IO $ \s# -> readTVarIO# tvar# s#
-
--- |Return the current value stored in a 'TVar'.
-readTVar :: TVar a -> STM a
-readTVar (TVar tvar#) = STM $ \s# -> readTVar# tvar# s#
-
--- |Write the supplied value into a 'TVar'.
-writeTVar :: TVar a -> a -> STM ()
-writeTVar (TVar tvar#) val = STM $ \s1# ->
- case writeTVar# tvar# val s1# of
- s2# -> (# s2#, () #)
-
-----------------------------------------------------------------------------
-- MVar utilities
-----------------------------------------------------------------------------
=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot
=====================================
@@ -17,7 +17,6 @@
module GHC.Internal.Conc.Sync
( forkIO,
- TVar(..),
ThreadId(..),
myThreadId,
showThreadId,
@@ -33,7 +32,6 @@ import GHC.Internal.Ptr
forkIO :: IO () -> IO ThreadId
data ThreadId = ThreadId ThreadId#
-data TVar a = TVar (TVar# RealWorld a)
data BlockReason
= BlockedOnMVar
=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
=====================================
@@ -42,12 +42,12 @@ module GHC.Internal.Conc.Windows
) where
import GHC.Internal.Base
-import GHC.Internal.Conc.Sync
import qualified GHC.Internal.Conc.POSIX as POSIX
import qualified GHC.Internal.Event.Windows.Thread as WINIO
import GHC.Internal.Event.Windows.ConsoleEvent
import GHC.Internal.IO.SubSystem ((<!>))
import GHC.Internal.Ptr
+import GHC.Internal.STM
-- ----------------------------------------------------------------------------
-- Thread waiting
=====================================
libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
=====================================
@@ -38,11 +38,11 @@ import GHC.Internal.Foreign.C.Types (CInt(..), CUInt(..))
import GHC.Internal.Foreign.Ptr (Ptr)
import GHC.Internal.Base
import GHC.Internal.List (zipWith, zipWith3)
-import GHC.Internal.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,
- labelThread, modifyMVar_, withMVar, newTVar, sharedCAF,
+import GHC.Internal.STM (TVar, atomically, newTVar, writeTVar, newTVarIO, readTVar, retry, throwSTM, STM)
+import GHC.Internal.Conc.Sync (ThreadId, ThreadStatus(..), forkIO,
+ labelThread, modifyMVar_, withMVar, sharedCAF,
getNumCapabilities, threadCapability, myThreadId, forkOn,
- threadStatus, writeTVar, newTVarIO, readTVar, retry,
- throwSTM, STM, yield)
+ threadStatus, yield)
import GHC.Internal.IO (mask_, uninterruptibleMask_, onException)
import GHC.Internal.IO.Exception (ioError)
import GHC.Internal.IOArray (IOArray, newIOArray, readIOArray, writeIOArray,
=====================================
libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
=====================================
@@ -7,11 +7,11 @@ module GHC.Internal.Event.Windows.Thread (
registerDelay,
) where
-import GHC.Internal.Conc.Sync
import GHC.Internal.Base
import GHC.Internal.Event.Windows
import GHC.Internal.IO
import GHC.Internal.MVar
+import GHC.Internal.STM
ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning = wakeupIOManager
@@ -36,4 +36,3 @@ registerDelay usecs = do
mgr <- getSystemManager
_ <- registerTimeout mgr usecs $ atomically $ writeTVar t True
return t
-
=====================================
libraries/ghc-internal/src/GHC/Internal/STM.hs
=====================================
@@ -0,0 +1,254 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# OPTIONS_HADDOCK not-home #-}
+
+module GHC.Internal.STM
+ (
+ -- * the 'STM' monad
+ STM(..)
+ , atomically
+ , retry
+ , orElse
+ , throwSTM
+ , catchSTM
+ , unsafeIOToSTM
+ -- * TVars
+ , TVar(..)
+ , newTVar
+ , newTVarIO
+ , readTVar
+ , readTVarIO
+ , writeTVar
+ ) where
+
+import GHC.Internal.Base
+import GHC.Internal.Exception (Exception, toExceptionWithBacktrace, fromException, addExceptionContext)
+import GHC.Internal.Exception.Context (ExceptionAnnotation)
+import GHC.Internal.Exception.Type (WhileHandling(..))
+import GHC.Internal.Stack (HasCallStack)
+
+-- TVars are shared memory locations which support atomic memory
+-- transactions.
+
+-- |A monad supporting atomic memory transactions.
+newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #))
+
+unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))
+unSTM (STM a) = a
+
+-- | @since base-4.3.0.0
+instance Functor STM where
+ fmap f x = x >>= (pure . f)
+
+-- | @since base-4.8.0.0
+instance Applicative STM where
+ {-# INLINE pure #-}
+ {-# INLINE (*>) #-}
+ {-# INLINE liftA2 #-}
+ pure x = returnSTM x
+ (<*>) = ap
+ liftA2 = liftM2
+ m *> k = thenSTM m k
+
+-- | @since base-4.3.0.0
+instance Monad STM where
+ {-# INLINE (>>=) #-}
+ m >>= k = bindSTM m k
+ (>>) = (*>)
+
+-- | @since base-4.17.0.0
+instance Semigroup a => Semigroup (STM a) where
+ (<>) = liftA2 (<>)
+
+-- | @since base-4.17.0.0
+instance Monoid a => Monoid (STM a) where
+ mempty = pure mempty
+
+bindSTM :: STM a -> (a -> STM b) -> STM b
+bindSTM (STM m) k = STM ( \s ->
+ case m s of
+ (# new_s, a #) -> unSTM (k a) new_s
+ )
+
+thenSTM :: STM a -> STM b -> STM b
+thenSTM (STM m) k = STM ( \s ->
+ case m s of
+ (# new_s, _ #) -> unSTM k new_s
+ )
+
+returnSTM :: a -> STM a
+returnSTM x = STM (\s -> (# s, x #))
+
+-- | Takes the first non-'retry'ing 'STM' action.
+--
+-- @since base-4.8.0.0
+instance Alternative STM where
+ empty = retry
+ (<|>) = orElse
+
+-- | Takes the first non-'retry'ing 'STM' action.
+--
+-- @since base-4.3.0.0
+instance MonadPlus STM
+
+-- | Unsafely performs IO in the STM monad. Beware: this is a highly
+-- dangerous thing to do.
+--
+-- * The STM implementation will often run transactions multiple
+-- times, so you need to be prepared for this if your IO has any
+-- side effects.
+--
+-- * The STM implementation will abort transactions that are known to
+-- be invalid and need to be restarted. This may happen in the middle
+-- of `unsafeIOToSTM`, so make sure you don't acquire any resources
+-- that need releasing (exception handlers are ignored when aborting
+-- the transaction). That includes doing any IO using Handles, for
+-- example. Getting this wrong will probably lead to random deadlocks.
+--
+-- * The transaction may have seen an inconsistent view of memory when
+-- the IO runs. Invariants that you expect to be true throughout
+-- your program may not be true inside a transaction, due to the
+-- way transactions are implemented. Normally this wouldn't be visible
+-- to the programmer, but using `unsafeIOToSTM` can expose it.
+--
+unsafeIOToSTM :: IO a -> STM a
+unsafeIOToSTM (IO m) = STM m
+
+-- | Perform a series of STM actions atomically.
+--
+-- Using 'atomically' inside an 'unsafePerformIO' or 'unsafeInterleaveIO'
+-- subverts some of guarantees that STM provides. It makes it possible to
+-- run a transaction inside of another transaction, depending on when the
+-- thunk is evaluated. If a nested transaction is attempted, an exception
+-- is thrown by the runtime. It is possible to safely use 'atomically' inside
+-- 'unsafePerformIO' or 'unsafeInterleaveIO', but the typechecker does not
+-- rule out programs that may attempt nested transactions, meaning that
+-- the programmer must take special care to prevent these.
+--
+-- However, there are functions for creating transactional variables that
+-- can always be safely called in 'unsafePerformIO'. See: 'newTVarIO',
+-- 'Control.Concurrent.STM.TChan.newTChanIO',
+-- 'Control.Concurrent.STM.TChan.newBroadcastTChanIO',
+-- 'Control.Concurrent.STM.TQueue.newTQueueIO',
+-- 'Control.Concurrent.STM.TBQueue.newTBQueueIO', and
+-- 'Control.Concurrent.STM.TMVar.newTMVarIO'.
+--
+-- Using 'unsafePerformIO' inside of 'atomically' is also dangerous but for
+-- different reasons. See 'unsafeIOToSTM' for more on this.
+
+atomically :: STM a -> IO a
+atomically (STM m) = IO (\s -> (atomically# m) s )
+
+-- | Retry execution of the current memory transaction because it has seen
+-- values in 'TVar's which mean that it should not continue (e.g. the 'TVar's
+-- represent a shared buffer that is now empty). The implementation may
+-- block the thread until one of the 'TVar's that it has read from has been
+-- updated. (GHC only)
+retry :: STM a
+retry = STM $ \s# -> retry# s#
+
+-- | Compose two alternative STM actions (GHC only).
+--
+-- If the first action completes without retrying then it forms the result of
+-- the 'orElse'. Otherwise, if the first action retries, then the second action
+-- is tried in its place. If both actions retry then the 'orElse' as a whole
+-- retries.
+orElse :: STM a -> STM a -> STM a
+orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
+
+-- | A variant of 'throw' that can only be used within the 'STM' monad.
+--
+-- Throwing an exception in @STM@ aborts the transaction and propagates the
+-- exception. If the exception is caught via 'catchSTM', only the changes
+-- enclosed by the catch are rolled back; changes made outside of 'catchSTM'
+-- persist.
+--
+-- If the exception is not caught inside of the 'STM', it is re-thrown by
+-- 'atomically', and the entire 'STM' is rolled back.
+--
+-- Although 'throwSTM' has a type that is an instance of the type of 'throw', the
+-- two functions are subtly different:
+--
+-- > throw e `seq` x ===> throw e
+-- > throwSTM e `seq` x ===> x
+--
+-- The first example will cause the exception @e@ to be raised,
+-- whereas the second one won\'t. In fact, 'throwSTM' will only cause
+-- an exception to be raised when it is used within the 'STM' monad.
+-- The 'throwSTM' variant should be used in preference to 'throw' to
+-- raise an exception within the 'STM' monad because it guarantees
+-- ordering with respect to other 'STM' operations, whereas 'throw'
+-- does not.
+throwSTM :: (HasCallStack, Exception e) => e -> STM a
+throwSTM e = do
+ -- N.B. Typically use of unsafeIOToSTM is very much frowned upon as this
+ -- is an easy way to end up with nested transactions. However, we can be
+ -- certain that toExceptionWithBacktrace will not initiate a transaction.
+ se <- unsafeIOToSTM (toExceptionWithBacktrace e)
+ STM $ raiseIO# se
+
+-- | Exception handling within STM actions.
+--
+-- @'catchSTM' m f@ catches any exception thrown by @m@ using 'throwSTM',
+-- using the function @f@ to handle the exception. If an exception is
+-- thrown, any changes made by @m@ are rolled back, but changes prior to
+-- @m@ persist.
+catchSTM :: Exception e => STM a -> (e -> STM a) -> STM a
+catchSTM (STM m) handler = STM $ catchSTM# m handler'
+ where
+ handler' e = case fromException e of
+ Just e' -> unSTM (annotateSTM (WhileHandling e) (handler e'))
+ Nothing -> raiseIO# e
+
+-- | Execute an 'STM' action, adding the given 'ExceptionContext'
+-- to any thrown synchronous exceptions.
+annotateSTM :: forall e a. ExceptionAnnotation e => e -> STM a -> STM a
+annotateSTM ann (STM io) = STM (catch# io handler)
+ where
+ handler se = raiseIO# (addExceptionContext ann se)
+
+-- |Shared memory locations that support atomic memory transactions.
+data TVar a = TVar (TVar# RealWorld a)
+
+-- | @since base-4.8.0.0
+instance Eq (TVar a) where
+ (TVar tvar1#) == (TVar tvar2#) = isTrue# (sameTVar# tvar1# tvar2#)
+
+-- | Create a new 'TVar' holding a value supplied
+newTVar :: a -> STM (TVar a)
+newTVar val = STM $ \s1# ->
+ case newTVar# val s1# of
+ (# s2#, tvar# #) -> (# s2#, TVar tvar# #)
+
+-- | @IO@ version of 'newTVar'. This is useful for creating top-level
+-- 'TVar's using 'System.IO.Unsafe.unsafePerformIO', because using
+-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
+-- possible.
+newTVarIO :: a -> IO (TVar a)
+newTVarIO val = IO $ \s1# ->
+ case newTVar# val s1# of
+ (# s2#, tvar# #) -> (# s2#, TVar tvar# #)
+
+-- | Return the current value stored in a 'TVar'.
+-- This is equivalent to
+--
+-- > readTVarIO = atomically . readTVar
+--
+-- but works much faster, because it doesn't perform a complete
+-- transaction, it just reads the current value of the 'TVar'.
+readTVarIO :: TVar a -> IO a
+readTVarIO (TVar tvar#) = IO $ \s# -> readTVarIO# tvar# s#
+
+-- |Return the current value stored in a 'TVar'.
+readTVar :: TVar a -> STM a
+readTVar (TVar tvar#) = STM $ \s# -> readTVar# tvar# s#
+
+-- |Write the supplied value into a 'TVar'.
+writeTVar :: TVar a -> a -> STM ()
+writeTVar (TVar tvar#) val = STM $ \s1# ->
+ case writeTVar# tvar# val s1# of
+ s2# -> (# s2#, () #)
+
=====================================
testsuite/tests/dmdanal/should_run/T26748.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE Haskell98 #-}
+module Main (main, x) where
+
+data Eq a => D a = MkD { lazy_field :: a, strict_field :: !a }
+
+x :: D ()
+{-# INLINABLE x #-}
+x = MkD { lazy_field = error "urk", strict_field = () }
+
+main :: IO ()
+main = print (strict_field x)
=====================================
testsuite/tests/dmdanal/should_run/T26748.stdout
=====================================
@@ -0,0 +1 @@
+()
=====================================
testsuite/tests/dmdanal/should_run/all.T
=====================================
@@ -34,3 +34,4 @@ test('T22475b', normal, compile_and_run, [''])
test('T22549', normal, compile_and_run, ['-fdicts-strict -fno-specialise'])
test('T23208', exit_code(1), multimod_compile_and_run, ['T23208_Lib', 'T23208'])
test('T25439', normal, compile_and_run, [''])
+test('T26748', normal, compile_and_run, [''])
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -146,9 +146,9 @@ module Control.Concurrent where
threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
threadWaitRead :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
- threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+ threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
- threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+ threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
tryPutMVar :: forall a. MVar a -> a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
tryReadMVar :: forall a. MVar a -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -5117,7 +5117,7 @@ module GHC.Conc where
threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
- throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+ throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -5197,7 +5197,7 @@ module GHC.Conc.Sync where
threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
threadLabel :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
threadStatus :: ThreadId -> GHC.Internal.Types.IO ThreadStatus
- throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+ throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -11117,12 +11117,12 @@ instance GHC.Internal.Base.Alternative GHC.Internal.Maybe.Maybe -- Defined in
instance GHC.Internal.Base.Alternative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowPlus a => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Alternative m => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Alternative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Alternative GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (Data.Functor.Compose.Compose f g) -- Defined in ‘Data.Functor.Compose’
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.Alternative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *). (GHC.Internal.Generics.Generic1 f, GHC.Internal.Base.Alternative (GHC.Internal.Generics.Rep1 f)) => GHC.Internal.Base.Alternative (GHC.Internal.Generics.Generically1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11146,7 +11146,6 @@ instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Applicative (
instance GHC.Internal.Base.Applicative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Applicative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
instance GHC.Internal.Base.Applicative Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11168,6 +11167,7 @@ instance GHC.Internal.Base.Applicative Data.Semigroup.First -- Defined in ‘Dat
instance GHC.Internal.Base.Applicative Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Applicative Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Applicative Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Applicative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Applicative GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11197,7 +11197,6 @@ instance forall m. GHC.Internal.Base.Functor (GHC.Internal.Data.Functor.Const.Co
instance GHC.Internal.Base.Functor GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Functor m => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Functor GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Functor GHC.Internal.Control.Exception.Handler -- Defined in ‘GHC.Internal.Control.Exception’
instance forall s. GHC.Internal.Base.Functor (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Functor (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11223,6 +11222,7 @@ instance GHC.Internal.Base.Functor Data.Semigroup.Last -- Defined in ‘Data.Sem
instance GHC.Internal.Base.Functor Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Functor Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
instance forall i. GHC.Internal.Base.Functor (GHC.Internal.Arr.Array i) -- Defined in ‘GHC.Internal.Arr’
+instance GHC.Internal.Base.Functor GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Functor GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:+: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11257,7 +11257,6 @@ instance forall a b. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b) =>
instance forall a b c. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c) => GHC.Internal.Base.Monad ((,,,) a b c) -- Defined in ‘GHC.Internal.Base’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowApply a => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Monad m => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Monad GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance forall s. GHC.Internal.Base.Monad (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Monad (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
instance GHC.Internal.Base.Monad Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11278,6 +11277,7 @@ instance GHC.Internal.Base.Monad Data.Semigroup.First -- Defined in ‘Data.Semi
instance GHC.Internal.Base.Monad Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Monad Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Monad Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Monad GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Monad GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Monad f, GHC.Internal.Base.Monad g) => GHC.Internal.Base.Monad (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monad f => GHC.Internal.Base.Monad (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
@@ -11292,11 +11292,11 @@ instance GHC.Internal.Base.MonadPlus [] -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.MonadPlus GHC.Internal.Maybe.Maybe -- Defined in ‘GHC.Internal.Base’
instance forall (a :: * -> * -> *). (GHC.Internal.Control.Arrow.ArrowApply a, GHC.Internal.Control.Arrow.ArrowPlus a) => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.MonadPlus m => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.MonadPlus GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.MonadPlus GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.MonadPlus GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.Rec1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11316,7 +11316,6 @@ instance forall a b c d. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b
instance forall a b c d e. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c, GHC.Internal.Base.Monoid d, GHC.Internal.Base.Monoid e) => GHC.Internal.Base.Monoid (a, b, c, d, e) -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.Monoid () -- Defined in ‘GHC.Internal.Base’
instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11347,6 +11346,7 @@ instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.I
instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Monoid (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
@@ -11371,7 +11371,6 @@ instance forall a b c d e. (GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Sem
instance GHC.Internal.Base.Semigroup () -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.Semigroup GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11409,6 +11408,7 @@ instance forall a. GHC.Internal.Base.Semigroup (Data.Semigroup.Last a) -- Define
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Semigroup (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
@@ -11510,7 +11510,6 @@ instance forall a. GHC.Internal.Classes.Eq a => GHC.Internal.Classes.Eq (GHC.Int
instance forall a. GHC.Internal.Classes.Eq (Control.Concurrent.Chan.Chan a) -- Defined in ‘Control.Concurrent.Chan’
instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.MVar.MVar a) -- Defined in ‘GHC.Internal.MVar’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.BlockReason -- Defined in ‘GHC.Internal.Conc.Sync’
-instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Conc.Sync.TVar a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadId -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadStatus -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
@@ -11640,6 +11639,7 @@ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Foreign.C.ConstPtr.Cons
instance forall i e. (GHC.Internal.Ix.Ix i, GHC.Internal.Classes.Eq e) => GHC.Internal.Classes.Eq (GHC.Internal.Arr.Array i e) -- Defined in ‘GHC.Internal.Arr’
instance forall s i e. GHC.Internal.Classes.Eq (GHC.Internal.Arr.STArray s i e) -- Defined in ‘GHC.Internal.Arr’
instance GHC.Internal.Classes.Eq GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
+instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.STM.TVar a) -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -146,9 +146,9 @@ module Control.Concurrent where
threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
threadWaitRead :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
- threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+ threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
- threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+ threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
tryPutMVar :: forall a. MVar a -> a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
tryReadMVar :: forall a. MVar a -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -5117,7 +5117,7 @@ module GHC.Conc where
threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
- throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+ throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -5197,7 +5197,7 @@ module GHC.Conc.Sync where
threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
threadLabel :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
threadStatus :: ThreadId -> GHC.Internal.Types.IO ThreadStatus
- throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+ throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -14163,12 +14163,12 @@ instance GHC.Internal.Base.Alternative GHC.Internal.Maybe.Maybe -- Defined in
instance GHC.Internal.Base.Alternative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowPlus a => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Alternative m => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Alternative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Alternative GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (Data.Functor.Compose.Compose f g) -- Defined in ‘Data.Functor.Compose’
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.Alternative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *). (GHC.Internal.Generics.Generic1 f, GHC.Internal.Base.Alternative (GHC.Internal.Generics.Rep1 f)) => GHC.Internal.Base.Alternative (GHC.Internal.Generics.Generically1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -14192,7 +14192,6 @@ instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Applicative (
instance GHC.Internal.Base.Applicative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Applicative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
instance GHC.Internal.Base.Applicative Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -14214,6 +14213,7 @@ instance GHC.Internal.Base.Applicative Data.Semigroup.First -- Defined in ‘Dat
instance GHC.Internal.Base.Applicative Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Applicative Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Applicative Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Applicative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Applicative GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
@@ -14243,7 +14243,6 @@ instance forall m. GHC.Internal.Base.Functor (GHC.Internal.Data.Functor.Const.Co
instance GHC.Internal.Base.Functor GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Functor m => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Functor GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Functor GHC.Internal.Control.Exception.Handler -- Defined in ‘GHC.Internal.Control.Exception’
instance forall s. GHC.Internal.Base.Functor (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Functor (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -14269,6 +14268,7 @@ instance GHC.Internal.Base.Functor Data.Semigroup.Last -- Defined in ‘Data.Sem
instance GHC.Internal.Base.Functor Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Functor Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
instance forall i. GHC.Internal.Base.Functor (GHC.Internal.Arr.Array i) -- Defined in ‘GHC.Internal.Arr’
+instance GHC.Internal.Base.Functor GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Functor GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:+: g) -- Defined in ‘GHC.Internal.Generics’
@@ -14303,7 +14303,6 @@ instance forall a b. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b) =>
instance forall a b c. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c) => GHC.Internal.Base.Monad ((,,,) a b c) -- Defined in ‘GHC.Internal.Base’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowApply a => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Monad m => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Monad GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance forall s. GHC.Internal.Base.Monad (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Monad (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
instance GHC.Internal.Base.Monad Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -14324,6 +14323,7 @@ instance GHC.Internal.Base.Monad Data.Semigroup.First -- Defined in ‘Data.Semi
instance GHC.Internal.Base.Monad Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Monad Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Monad Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Monad GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Monad GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Monad f, GHC.Internal.Base.Monad g) => GHC.Internal.Base.Monad (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monad f => GHC.Internal.Base.Monad (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
@@ -14338,11 +14338,11 @@ instance GHC.Internal.Base.MonadPlus [] -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.MonadPlus GHC.Internal.Maybe.Maybe -- Defined in ‘GHC.Internal.Base’
instance forall (a :: * -> * -> *). (GHC.Internal.Control.Arrow.ArrowApply a, GHC.Internal.Control.Arrow.ArrowPlus a) => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.MonadPlus m => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.MonadPlus GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.MonadPlus GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.MonadPlus GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.Rec1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -14362,7 +14362,6 @@ instance forall a b c d. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b
instance forall a b c d e. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c, GHC.Internal.Base.Monoid d, GHC.Internal.Base.Monoid e) => GHC.Internal.Base.Monoid (a, b, c, d, e) -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.Monoid () -- Defined in ‘GHC.Internal.Base’
instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -14393,6 +14392,7 @@ instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.I
instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Monoid (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Monoid (f p), GHC.Internal.Base.Monoid (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Monoid (f (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’
@@ -14414,7 +14414,6 @@ instance forall a b c d e. (GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Sem
instance GHC.Internal.Base.Semigroup () -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.Semigroup GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -14452,6 +14451,7 @@ instance forall a. GHC.Internal.Base.Semigroup (Data.Semigroup.Last a) -- Define
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Semigroup (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Semigroup (f p), GHC.Internal.Base.Semigroup (g p)) => GHC.Internal.Base.Semigroup ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Semigroup (f (g p)) => GHC.Internal.Base.Semigroup ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Semigroup (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Semigroup (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’
@@ -14550,7 +14550,6 @@ instance forall a. GHC.Internal.Classes.Eq a => GHC.Internal.Classes.Eq (GHC.Int
instance forall a. GHC.Internal.Classes.Eq (Control.Concurrent.Chan.Chan a) -- Defined in ‘Control.Concurrent.Chan’
instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.MVar.MVar a) -- Defined in ‘GHC.Internal.MVar’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.BlockReason -- Defined in ‘GHC.Internal.Conc.Sync’
-instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Conc.Sync.TVar a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadId -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadStatus -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
@@ -14680,6 +14679,7 @@ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Foreign.C.ConstPtr.Cons
instance forall i e. (GHC.Internal.Ix.Ix i, GHC.Internal.Classes.Eq e) => GHC.Internal.Classes.Eq (GHC.Internal.Arr.Array i e) -- Defined in ‘GHC.Internal.Arr’
instance forall s i e. GHC.Internal.Classes.Eq (GHC.Internal.Arr.STArray s i e) -- Defined in ‘GHC.Internal.Arr’
instance GHC.Internal.Classes.Eq GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
+instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.STM.TVar a) -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Classes.Eq GHC.Internal.Event.TimeOut.TimeoutKey -- Defined in ‘GHC.Internal.Event.TimeOut’
instance GHC.Internal.Classes.Eq GHC.Internal.Stack.Types.SrcLoc -- Defined in ‘GHC.Internal.Stack.Types’
instance GHC.Internal.Classes.Eq GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -146,9 +146,9 @@ module Control.Concurrent where
threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
threadWaitRead :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
- threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+ threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
- threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+ threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
tryPutMVar :: forall a. MVar a -> a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
tryReadMVar :: forall a. MVar a -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -5121,7 +5121,7 @@ module GHC.Conc where
threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
- throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+ throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
toWin32ConsoleEvent :: forall a. (GHC.Internal.Classes.Eq a, GHC.Internal.Num.Num a) => a -> GHC.Internal.Maybe.Maybe ConsoleEvent
unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
@@ -5213,7 +5213,7 @@ module GHC.Conc.Sync where
threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
threadLabel :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
threadStatus :: ThreadId -> GHC.Internal.Types.IO ThreadStatus
- throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+ throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -5224,7 +5224,7 @@ module GHC.Conc.WinIO where
-- Safety: None
ensureIOManagerIsRunning :: GHC.Internal.Types.IO ()
interruptIOManager :: GHC.Internal.Types.IO ()
- registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.TVar GHC.Internal.Types.Bool)
+ registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.STM.TVar GHC.Internal.Types.Bool)
threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
module GHC.Conc.Windows where
@@ -5238,7 +5238,7 @@ module GHC.Conc.Windows where
asyncWriteBA :: GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> GHC.Internal.Prim.MutableByteArray# GHC.Internal.Prim.RealWorld -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Int)
ensureIOManagerIsRunning :: GHC.Internal.Types.IO ()
interruptIOManager :: GHC.Internal.Types.IO ()
- registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.TVar GHC.Internal.Types.Bool)
+ registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.STM.TVar GHC.Internal.Types.Bool)
start_console_handler :: GHC.Internal.Word.Word32 -> GHC.Internal.Types.IO ()
threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
toWin32ConsoleEvent :: forall a. (GHC.Internal.Classes.Eq a, GHC.Internal.Num.Num a) => a -> GHC.Internal.Maybe.Maybe ConsoleEvent
@@ -5445,7 +5445,7 @@ module GHC.Event.Windows.Thread where
-- Safety: None
ensureIOManagerIsRunning :: GHC.Internal.Types.IO ()
interruptIOManager :: GHC.Internal.Types.IO ()
- registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.TVar GHC.Internal.Types.Bool)
+ registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.STM.TVar GHC.Internal.Types.Bool)
threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
module GHC.Exception where
@@ -11379,12 +11379,12 @@ instance GHC.Internal.Base.Alternative GHC.Internal.Maybe.Maybe -- Defined in
instance GHC.Internal.Base.Alternative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowPlus a => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Alternative m => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Alternative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Alternative GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (Data.Functor.Compose.Compose f g) -- Defined in ‘Data.Functor.Compose’
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.Alternative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *). (GHC.Internal.Generics.Generic1 f, GHC.Internal.Base.Alternative (GHC.Internal.Generics.Rep1 f)) => GHC.Internal.Base.Alternative (GHC.Internal.Generics.Generically1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11408,7 +11408,6 @@ instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Applicative (
instance GHC.Internal.Base.Applicative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Applicative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
instance GHC.Internal.Base.Applicative Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11430,6 +11429,7 @@ instance GHC.Internal.Base.Applicative Data.Semigroup.First -- Defined in ‘Dat
instance GHC.Internal.Base.Applicative Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Applicative Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Applicative Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Applicative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Applicative GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11459,7 +11459,6 @@ instance forall m. GHC.Internal.Base.Functor (GHC.Internal.Data.Functor.Const.Co
instance GHC.Internal.Base.Functor GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Functor m => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Functor GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Functor GHC.Internal.Control.Exception.Handler -- Defined in ‘GHC.Internal.Control.Exception’
instance forall s. GHC.Internal.Base.Functor (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Functor (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11485,6 +11484,7 @@ instance GHC.Internal.Base.Functor Data.Semigroup.Last -- Defined in ‘Data.Sem
instance GHC.Internal.Base.Functor Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Functor Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
instance forall i. GHC.Internal.Base.Functor (GHC.Internal.Arr.Array i) -- Defined in ‘GHC.Internal.Arr’
+instance GHC.Internal.Base.Functor GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Functor GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:+: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11519,7 +11519,6 @@ instance forall a b. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b) =>
instance forall a b c. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c) => GHC.Internal.Base.Monad ((,,,) a b c) -- Defined in ‘GHC.Internal.Base’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowApply a => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Monad m => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Monad GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance forall s. GHC.Internal.Base.Monad (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Monad (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
instance GHC.Internal.Base.Monad Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11540,6 +11539,7 @@ instance GHC.Internal.Base.Monad Data.Semigroup.First -- Defined in ‘Data.Semi
instance GHC.Internal.Base.Monad Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Monad Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Monad Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Monad GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Monad GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Monad f, GHC.Internal.Base.Monad g) => GHC.Internal.Base.Monad (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monad f => GHC.Internal.Base.Monad (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
@@ -11554,11 +11554,11 @@ instance GHC.Internal.Base.MonadPlus [] -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.MonadPlus GHC.Internal.Maybe.Maybe -- Defined in ‘GHC.Internal.Base’
instance forall (a :: * -> * -> *). (GHC.Internal.Control.Arrow.ArrowApply a, GHC.Internal.Control.Arrow.ArrowPlus a) => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.MonadPlus m => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.MonadPlus GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.MonadPlus GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.MonadPlus GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.Rec1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11578,7 +11578,6 @@ instance forall a b c d. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b
instance forall a b c d e. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c, GHC.Internal.Base.Monoid d, GHC.Internal.Base.Monoid e) => GHC.Internal.Base.Monoid (a, b, c, d, e) -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.Monoid () -- Defined in ‘GHC.Internal.Base’
instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11609,6 +11608,7 @@ instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.I
instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Monoid (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Monoid GHC.Internal.Event.Windows.EventData -- Defined in ‘GHC.Internal.Event.Windows’
instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Monoid (f p), GHC.Internal.Base.Monoid (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Monoid (f (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -11631,7 +11631,6 @@ instance forall a b c d e. (GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Sem
instance GHC.Internal.Base.Semigroup () -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.Semigroup GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11669,6 +11668,7 @@ instance forall a. GHC.Internal.Base.Semigroup (Data.Semigroup.Last a) -- Define
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Semigroup (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Semigroup GHC.Internal.Event.Windows.EventData -- Defined in ‘GHC.Internal.Event.Windows’
instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Semigroup (f p), GHC.Internal.Base.Semigroup (g p)) => GHC.Internal.Base.Semigroup ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Semigroup (f (g p)) => GHC.Internal.Base.Semigroup ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -11768,7 +11768,6 @@ instance forall a. GHC.Internal.Classes.Eq a => GHC.Internal.Classes.Eq (GHC.Int
instance forall a. GHC.Internal.Classes.Eq (Control.Concurrent.Chan.Chan a) -- Defined in ‘Control.Concurrent.Chan’
instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.MVar.MVar a) -- Defined in ‘GHC.Internal.MVar’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.BlockReason -- Defined in ‘GHC.Internal.Conc.Sync’
-instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Conc.Sync.TVar a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadId -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadStatus -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
@@ -11899,6 +11898,7 @@ instance forall i e. (GHC.Internal.Ix.Ix i, GHC.Internal.Classes.Eq e) => GHC.In
instance forall s i e. GHC.Internal.Classes.Eq (GHC.Internal.Arr.STArray s i e) -- Defined in ‘GHC.Internal.Arr’
instance GHC.Internal.Classes.Eq GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
instance GHC.Internal.Classes.Eq GHC.Internal.Event.Windows.ConsoleEvent.ConsoleEvent -- Defined in ‘GHC.Internal.Event.Windows.ConsoleEvent’
+instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.STM.TVar a) -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Classes.Eq GHC.Internal.Event.TimeOut.TimeoutKey -- Defined in ‘GHC.Internal.Event.TimeOut’
instance GHC.Internal.Classes.Eq GHC.Internal.Event.Windows.HandleKey -- Defined in ‘GHC.Internal.Event.Windows’
instance GHC.Internal.Classes.Eq GHC.Internal.Event.Windows.FFI.IOCP -- Defined in ‘GHC.Internal.Event.Windows.FFI’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -146,9 +146,9 @@ module Control.Concurrent where
threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
threadWaitRead :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
- threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+ threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
- threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+ threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
tryPutMVar :: forall a. MVar a -> a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
tryReadMVar :: forall a. MVar a -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -5117,7 +5117,7 @@ module GHC.Conc where
threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
- throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+ throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -5197,7 +5197,7 @@ module GHC.Conc.Sync where
threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
threadLabel :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
threadStatus :: ThreadId -> GHC.Internal.Types.IO ThreadStatus
- throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+ throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -11117,12 +11117,12 @@ instance GHC.Internal.Base.Alternative GHC.Internal.Maybe.Maybe -- Defined in
instance GHC.Internal.Base.Alternative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowPlus a => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Alternative m => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Alternative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Alternative GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (Data.Functor.Compose.Compose f g) -- Defined in ‘Data.Functor.Compose’
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.Alternative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *). (GHC.Internal.Generics.Generic1 f, GHC.Internal.Base.Alternative (GHC.Internal.Generics.Rep1 f)) => GHC.Internal.Base.Alternative (GHC.Internal.Generics.Generically1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11146,7 +11146,6 @@ instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Applicative (
instance GHC.Internal.Base.Applicative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Applicative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
instance GHC.Internal.Base.Applicative Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11168,6 +11167,7 @@ instance GHC.Internal.Base.Applicative Data.Semigroup.First -- Defined in ‘Dat
instance GHC.Internal.Base.Applicative Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Applicative Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Applicative Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Applicative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Applicative GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11197,7 +11197,6 @@ instance forall m. GHC.Internal.Base.Functor (GHC.Internal.Data.Functor.Const.Co
instance GHC.Internal.Base.Functor GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Functor m => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Functor GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Functor GHC.Internal.Control.Exception.Handler -- Defined in ‘GHC.Internal.Control.Exception’
instance forall s. GHC.Internal.Base.Functor (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Functor (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11223,6 +11222,7 @@ instance GHC.Internal.Base.Functor Data.Semigroup.Last -- Defined in ‘Data.Sem
instance GHC.Internal.Base.Functor Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Functor Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
instance forall i. GHC.Internal.Base.Functor (GHC.Internal.Arr.Array i) -- Defined in ‘GHC.Internal.Arr’
+instance GHC.Internal.Base.Functor GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Functor GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:+: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11257,7 +11257,6 @@ instance forall a b. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b) =>
instance forall a b c. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c) => GHC.Internal.Base.Monad ((,,,) a b c) -- Defined in ‘GHC.Internal.Base’
instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowApply a => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.Monad m => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Monad GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance forall s. GHC.Internal.Base.Monad (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
instance forall s. GHC.Internal.Base.Monad (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
instance GHC.Internal.Base.Monad Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11278,6 +11277,7 @@ instance GHC.Internal.Base.Monad Data.Semigroup.First -- Defined in ‘Data.Semi
instance GHC.Internal.Base.Monad Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Monad Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Base.Monad Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Monad GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Monad GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Monad f, GHC.Internal.Base.Monad g) => GHC.Internal.Base.Monad (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monad f => GHC.Internal.Base.Monad (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
@@ -11292,11 +11292,11 @@ instance GHC.Internal.Base.MonadPlus [] -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.MonadPlus GHC.Internal.Maybe.Maybe -- Defined in ‘GHC.Internal.Base’
instance forall (a :: * -> * -> *). (GHC.Internal.Control.Arrow.ArrowApply a, GHC.Internal.Control.Arrow.ArrowPlus a) => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
instance forall (m :: * -> *) a. GHC.Internal.Base.MonadPlus m => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.MonadPlus GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.MonadPlus GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.MonadPlus GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.Rec1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11316,7 +11316,6 @@ instance forall a b c d. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b
instance forall a b c d e. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c, GHC.Internal.Base.Monoid d, GHC.Internal.Base.Monoid e) => GHC.Internal.Base.Monoid (a, b, c, d, e) -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.Monoid () -- Defined in ‘GHC.Internal.Base’
instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11347,6 +11346,7 @@ instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.I
instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Monoid (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
@@ -11371,7 +11371,6 @@ instance forall a b c d e. (GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Sem
instance GHC.Internal.Base.Semigroup () -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Base.Semigroup GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11409,6 +11408,7 @@ instance forall a. GHC.Internal.Base.Semigroup (Data.Semigroup.Last a) -- Define
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Semigroup (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
@@ -11510,7 +11510,6 @@ instance forall a. GHC.Internal.Classes.Eq a => GHC.Internal.Classes.Eq (GHC.Int
instance forall a. GHC.Internal.Classes.Eq (Control.Concurrent.Chan.Chan a) -- Defined in ‘Control.Concurrent.Chan’
instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.MVar.MVar a) -- Defined in ‘GHC.Internal.MVar’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.BlockReason -- Defined in ‘GHC.Internal.Conc.Sync’
-instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Conc.Sync.TVar a) -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadId -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadStatus -- Defined in ‘GHC.Internal.Conc.Sync’
instance GHC.Internal.Classes.Eq GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
@@ -11640,6 +11639,7 @@ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Foreign.C.ConstPtr.Cons
instance forall i e. (GHC.Internal.Ix.Ix i, GHC.Internal.Classes.Eq e) => GHC.Internal.Classes.Eq (GHC.Internal.Arr.Array i e) -- Defined in ‘GHC.Internal.Arr’
instance forall s i e. GHC.Internal.Classes.Eq (GHC.Internal.Arr.STArray s i e) -- Defined in ‘GHC.Internal.Arr’
instance GHC.Internal.Classes.Eq GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
+instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.STM.TVar a) -- Defined in ‘GHC.Internal.STM’
instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
=====================================
testsuite/tests/simplCore/should_compile/T26682.hs
=====================================
@@ -0,0 +1,105 @@
+{-# LANGUAGE Haskell2010 #-}
+
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# OPTIONS_GHC -fspecialise-aggressively #-}
+
+-- This is the result of @sheaf's work in minimising
+-- @mikolaj's original bug report for #26682
+
+module T26682 ( tensorADOnceMnistTests2 ) where
+
+import Prelude
+
+import Data.Proxy
+ ( Proxy (Proxy) )
+
+import GHC.TypeNats
+import Data.Kind
+
+import T26682a
+
+
+data Concrete2 x = Concrete2
+
+instance Eq ( Concrete2 a ) where
+ _ == _ = error "no"
+ {-# OPAQUE (==) #-}
+
+type X :: Type -> TK
+type family X a
+
+type instance X (target y) = y
+type instance X (a, b) = TKProduct (X a) (X b)
+type instance X (a, b, c) = TKProduct (TKProduct (X a) (X b)) (X c)
+
+tensorADOnceMnistTests2 :: Int -> Bool
+tensorADOnceMnistTests2 seed0 =
+ withSomeSNat 999 $ \ _ ->
+ let seed1 =
+ randomValue2
+ @(Concrete2 (X (ADFcnnMnist2ParametersShaped Concrete2 101 101 Double Double)))
+ seed0
+ art = mnistTrainBench2VTOGradient3 seed1
+
+ gg :: Concrete2
+ (TKProduct
+ (TKProduct
+ (TKProduct
+ (TKProduct (TKR2 2 (TKScalar Double)) (TKR2 1 (TKScalar Double)))
+ (TKProduct (TKR2 2 (TKScalar Double)) (TKR2 1 (TKScalar Double))))
+ (TKProduct (TKR2 2 (TKScalar Double)) (TKR2 1 (TKScalar Double))))
+ (TKProduct (TKR 1 Double) (TKR 1 Double)))
+ gg = undefined
+ value1 = revInterpretArtifact2 art gg
+ in
+ value1 == value1
+
+mnistTrainBench2VTOGradient3
+ :: Int
+ -> AstArtifactRev2
+ (TKProduct
+ (XParams2 Double Double)
+ (TKProduct (TKR2 1 (TKScalar Double))
+ (TKR2 1 (TKScalar Double))))
+ (TKScalar Double)
+mnistTrainBench2VTOGradient3 !_
+ | Dict0 <- lemTKScalarAllNumAD2 (Proxy @Double)
+ = undefined
+
+type ADFcnnMnist2ParametersShaped
+ (target :: TK -> Type) (widthHidden :: Nat) (widthHidden2 :: Nat) r q =
+ ( ( target (TKS '[widthHidden, 784] r)
+ , target (TKS '[widthHidden] r) )
+ , ( target (TKS '[widthHidden2, widthHidden] q)
+ , target (TKS '[widthHidden2] r) )
+ , ( target (TKS '[10, widthHidden2] r)
+ , target (TKS '[10] r) )
+ )
+
+-- | The differentiable type of all trainable parameters of this nn.
+type ADFcnnMnist2Parameters (target :: TK -> Type) r q =
+ ( ( target (TKR 2 r)
+ , target (TKR 1 r) )
+ , ( target (TKR 2 q)
+ , target (TKR 1 r) )
+ , ( target (TKR 2 r)
+ , target (TKR 1 r) )
+ )
+
+type XParams2 r q = X (ADFcnnMnist2Parameters Concrete2 r q)
+
+data AstArtifactRev2 x z = AstArtifactRev2
+
+revInterpretArtifact2
+ :: AstArtifactRev2 x z
+ -> Concrete2 x
+ -> Concrete2 z
+{-# OPAQUE revInterpretArtifact2 #-}
+revInterpretArtifact2 _ _ = error "no"
=====================================
testsuite/tests/simplCore/should_compile/T26682a.hs
=====================================
@@ -0,0 +1,109 @@
+{-# LANGUAGE Haskell2010 #-}
+
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeData #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module T26682a
+ ( TK(..), TKR, TKS, TKX
+ , Dict0(..)
+ , randomValue2
+ , lemTKScalarAllNumAD2
+ ) where
+
+import Prelude
+
+
+import GHC.TypeLits ( KnownNat(..), Nat, SNat )
+import Data.Kind ( Type, Constraint )
+import Data.Typeable ( Typeable )
+import Data.Proxy ( Proxy )
+
+import Type.Reflection
+import Data.Type.Equality
+
+ifDifferentiable2 :: forall r a. Typeable r
+ => (Num r => a) -> a -> a
+{-# INLINE ifDifferentiable2 #-}
+ifDifferentiable2 ra _
+ | Just Refl <- testEquality (typeRep @r) (typeRep @Double) = ra
+ifDifferentiable2 ra _
+ | Just Refl <- testEquality (typeRep @r) (typeRep @Float) = ra
+ifDifferentiable2 _ a = a
+
+data Dict0 c where
+ Dict0 :: c => Dict0 c
+
+type ShS2 :: [Nat] -> Type
+data ShS2 ns where
+ Z :: ShS2 '[]
+ S :: {-# UNPACK #-} !( SNat n ) -> !( ShS2 ns ) -> ShS2 (n ': ns)
+
+type KnownShS2 :: [Nat] -> Constraint
+class KnownShS2 ns where
+ knownShS2 :: ShS2 ns
+
+instance KnownShS2 '[] where
+ knownShS2 = Z
+instance ( KnownNat n, KnownShS2 ns ) => KnownShS2 ( n ': ns ) where
+ knownShS2 =
+ case natSing @n of
+ !i ->
+ case knownShS2 @ns of
+ !j ->
+ S i j
+
+type RandomValue2 :: Type -> Constraint
+class RandomValue2 vals where
+ randomValue2 :: Int -> Int
+
+
+type IsDouble :: Type -> Constraint
+type family IsDouble a where
+ IsDouble Double = ( () :: Constraint )
+
+class ( Typeable r, IsDouble r ) => NumScalar2 r
+instance ( Typeable r, IsDouble r ) => NumScalar2 r
+
+instance forall sh r target. (KnownShS2 sh, NumScalar2 r)
+ => RandomValue2 (target (TKS sh r)) where
+ randomValue2 g =
+ ifDifferentiable2 @r
+ ( case knownShS2 @sh of
+ !_ -> g )
+ g
+
+instance (RandomValue2 (target a), RandomValue2 (target b))
+ => RandomValue2 (target (TKProduct a b)) where
+ randomValue2 g =
+ let g1 = randomValue2 @(target a) g
+ g2 = randomValue2 @(target b) g1
+ in g2
+
+lemTKScalarAllNumAD2 :: Proxy r -> Dict0 ( IsDouble r )
+lemTKScalarAllNumAD2 _ = undefined
+{-# OPAQUE lemTKScalarAllNumAD2 #-}
+
+
+type data TK =
+ TKScalar Type
+ | TKR2 Nat TK
+ | TKS2 [Nat] TK
+ | TKX2 [Maybe Nat] TK
+ | TKProduct TK TK
+
+type TKR n r = TKR2 n (TKScalar r)
+type TKS sh r = TKS2 sh (TKScalar r)
+type TKX sh r = TKX2 sh (TKScalar r)
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -569,4 +569,6 @@ test('T26681', normal, compile, ['-O'])
test('T26709', [grep_errmsg(r'case')],
multimod_compile,
['T26709', '-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds'])
+test('T26682', normal, multimod_compile, ['T26682', '-O -v0'])
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99721d450079074a5bb622eca00ef8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99721d450079074a5bb622eca00ef8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26722] Try using `uf_expandable` in `interestingArg`
by Simon Peyton Jones (＠simonpj) 09 Jan '26
by Simon Peyton Jones (＠simonpj) 09 Jan '26
09 Jan '26
Simon Peyton Jones pushed to branch wip/T26722 at Glasgow Haskell Compiler / GHC
Commits:
2a7e8721 by Simon Peyton Jones at 2026-01-09T11:42:28+00:00
Try using `uf_expandable` in `interestingArg`
See hmm in https://gitlab.haskell.org/ghc/ghc/-/issues/26722#note_652486
- - - - -
2 changed files:
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Utils.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -1066,18 +1066,18 @@ interestingArg env e = go env 0 e
DFunUnfolding {} -> ValueArg -- We konw that idArity=0
CoreUnfolding{ uf_cache = cache }
| uf_is_conlike cache -> ValueArg -- Includes constructor applications
- | uf_is_value cache -> NonTrivArg -- Things like partial applications
+ | uf_expandable cache -> NonTrivArg -- Things like partial applications,
+ -- and strict data constructors
| otherwise -> TrivArg
BootUnfolding -> TrivArg
NoUnfolding -> TrivArg
-************************************************************************
+{- *********************************************************************
* *
SimplMode
* *
-************************************************************************
--}
+********************************************************************* -}
updModeForStableUnfoldings :: ActivationGhc -> SimplMode -> SimplMode
-- See Note [The environments of the Simplify pass]
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -1509,6 +1509,22 @@ going to put up with this, because the previous more aggressive inlining
(which treated 'noFactor' as work-free) was duplicating primops, which
in turn was making inner loops of array calculations runs slow (#5623)
+Wrinkles
+
+(WF1) Strict constructor fields. We regard (K x) as work-free even if
+ K is a strict data constructor (see Note [Strict fields in Core])
+ data T a = K !a
+ If we have
+ let t = K x in ...(case t of K y -> blah)...
+ we want to treat t's binding as expandable so that `exprIsConApp_maybe`
+ will look through its unfolding. (NB: exprIsWorkFree implies
+ exprIsExpandable.)
+
+ Because K is strict, after inlining we'll get a leftover eval on x, which may
+ or may not disappear
+ let t = K x in ...(case x of y -> blah)...
+ In effect we count duplicating the eval as work-free
+
Note [Case expressions are work-free]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Are case-expressions work-free? Consider
@@ -1650,7 +1666,8 @@ isWorkFreeApp fn n_val_args
= True
| otherwise
= case idDetails fn of
- DataConWorkId {} -> True
+ DataConWorkId {} -> True -- Even if the data constructor is strict
+ -- See (WF1) in Note [exprIsWorkFree]
PrimOpId op _ -> primOpIsWorkFree op
_ -> False
@@ -1751,6 +1768,8 @@ expansion. Specifically:
duplicate the (a +# b) primop, which we should not do lightly.
(It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.)
+NB: exprIsWorkFree implies exprIsExpandable.
+
Note [isExpandableApp: bottoming functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's important that isExpandableApp does not respond True to bottoming
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2a7e8721ec12ce5e1eab32a92f58f5e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2a7e8721ec12ce5e1eab32a92f58f5e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/t26751] Evaluate backtraces for "error" exceptions at the moment they are thrown
by Matthew Pickering (＠mpickering) 09 Jan '26
by Matthew Pickering (＠mpickering) 09 Jan '26
09 Jan '26
Matthew Pickering pushed to branch wip/t26751 at Glasgow Haskell Compiler / GHC
Commits:
7ae17f5d by Matthew Pickering at 2026-01-09T11:38:34+00:00
Evaluate backtraces for "error" exceptions at the moment they are thrown
See Note [Capturing the backtrace in throw] and
Note [Hiding precise exception signature in throw] which explain the
implementation.
This commit makes `error` and `throw` behave the same with regard to
backtraces. Previously, exceptiosn raised by `error` would not contain
useful IPE backtraces.
I did try and implement `error` in terms of `throw` but it started to
involve putting diverging functions into hs-boot files, which seemed to
risky if the compiler wouldn't be able to see if applying a function
would diverge.
Fixes #26751
- - - - -
5 changed files:
- libraries/ghc-internal/src/GHC/Internal/Err.hs
- testsuite/tests/ghci.debugger/scripts/T8487.stdout
- testsuite/tests/ghci.debugger/scripts/break011.stdout
- testsuite/tests/ghci.debugger/scripts/break017.stdout
- testsuite/tests/ghci.debugger/scripts/break025.stdout
Changes:
=====================================
libraries/ghc-internal/src/GHC/Internal/Err.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, ImplicitParams #-}
{-# LANGUAGE RankNTypes, PolyKinds, DataKinds #-}
+{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK not-home #-}
-----------------------------------------------------------------------------
@@ -25,6 +26,7 @@
module GHC.Internal.Err( absentErr, error, errorWithoutStackTrace, undefined ) where
import GHC.Internal.Types (Char, RuntimeRep)
import GHC.Internal.Stack.Types
+import GHC.Internal.Magic
import GHC.Internal.Prim
import {-# SOURCE #-} GHC.Internal.Exception
( errorCallWithCallStackException
@@ -33,7 +35,10 @@ import {-# SOURCE #-} GHC.Internal.Exception
-- | 'error' stops execution and displays an error message.
error :: forall (r :: RuntimeRep). forall (a :: TYPE r).
HasCallStack => [Char] -> a
-error s = raise# (errorCallWithCallStackException s ?callStack)
+error s =
+ -- Evaluate SomeException before to get accurate callstacks (like throw)
+ let !se = noinline (errorCallWithCallStackException s ?callStack)
+ in raise# se
-- Bleh, we should be using 'GHC.Internal.Stack.callStack' instead of
-- '?callStack' here, but 'GHC.Internal.Stack.callStack' depends on
-- 'GHC.Internal.Stack.popCallStack', which is partial and depends on
@@ -73,7 +78,9 @@ undefined :: forall (r :: RuntimeRep). forall (a :: TYPE r).
-- nor wanted (see #19886). We’d like to use withFrozenCallStack, but that
-- is not available in this module yet, and making it so is hard. So let’s just
-- use raise# directly.
-undefined = raise# (errorCallWithCallStackException "Prelude.undefined" ?callStack)
+undefined =
+ let !se = noinline (errorCallWithCallStackException "Prelude.undefined" ?callStack)
+ in raise# se
-- | Used for compiler-generated error message;
-- encoding saves bytes of string junk.
=====================================
testsuite/tests/ghci.debugger/scripts/T8487.stdout
=====================================
@@ -1,4 +1,5 @@
Breakpoint 0 activated at T8487.hs:(5,8)-(7,53)
Stopped in Main.f, T8487.hs:(5,8)-(7,53)
_result :: IO String = _
-ma :: Either SomeException String = Left _
+ma :: Either SomeException String = Left
+ (SomeException (ErrorCall ...))
=====================================
testsuite/tests/ghci.debugger/scripts/break011.stdout
=====================================
@@ -4,9 +4,10 @@ HasCallStack backtrace:
error, called at <interactive>:2:1 in interactive:Ghci1
Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = GHC.Internal.Exception.Type.SomeException
+ (GHC.Internal.Exception.ErrorCall _)
Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = SomeException (ErrorCall _)
-1 : main (Test7.hs:2:18-28)
-2 : main (Test7.hs:2:8-29)
<end of history>
@@ -26,7 +27,7 @@ _exception :: SomeException = SomeException (ErrorCall "foo")
*** Exception: foo
HasCallStack backtrace:
- error, called at Test7.hs:2:18 in main:Main
+ error, called at Test7.hs:2:18 in interactive-session:Main
Stopped in <exception thrown>, <unknown>
_exception :: e = _
@@ -35,5 +36,5 @@ _exception :: e = _
*** Exception: foo
HasCallStack backtrace:
- error, called at Test7.hs:2:18 in main:Main
+ error, called at Test7.hs:2:18 in interactive-session:Main
=====================================
testsuite/tests/ghci.debugger/scripts/break017.stdout
=====================================
@@ -1,5 +1,6 @@
"Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = GHC.Internal.Exception.Type.SomeException
+ (GHC.Internal.Exception.ErrorCall _)
Logged breakpoint at QSort.hs:6:32-34
_result :: Char -> Bool
a :: Char
=====================================
testsuite/tests/ghci.debugger/scripts/break025.stdout
=====================================
@@ -1,3 +1,4 @@
Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = GHC.Internal.Exception.Type.SomeException
+ (GHC.Internal.Exception.ErrorCall _)
()
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ae17f5d13f42385b462e8e75c6d14a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ae17f5d13f42385b462e8e75c6d14a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
09 Jan '26
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
744f5ea2 by Apoorv Ingle at 2025-12-22T11:40:39-06:00
some minor things
- - - - -
9e0ddc42 by Apoorv Ingle at 2026-01-09T12:09:25+01:00
enable NB for custom, user written HasField constraint errors
- - - - -
7 changed files:
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Utils/Monad.hs
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr
Changes:
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -81,6 +81,8 @@ import qualified GHC.Data.Strict as Strict
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
+import Language.Haskell.Syntax (HsExpr (RecordUpd, HsGetField, HsProjection))
+import GHC.Hs.Expr (SrcCodeOrigin(..))
import Control.Monad ( unless, when, foldM, forM_ )
import Data.Bifunctor ( bimap )
@@ -2685,6 +2687,10 @@ isHasFieldOrigin = \case
RecordUpdOrigin {} -> True
RecordFieldProjectionOrigin {} -> True
GetFieldOrigin {} -> True
+ ExpansionOrigin (OrigExpr e)
+ | HsGetField{} <- e -> True
+ | RecordUpd{} <- e -> True
+ | HsProjection{} <- e -> True
_ -> False
-----------------------
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -958,7 +958,7 @@ addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside
, ppr arg
, ppr arg_no])
; setSrcSpanA arg_loc $
- mkNthFunArgErrCtxt app_head arg arg_no $
+ addNthFunArgErrCtxt app_head arg arg_no $
thing_inside
}
| otherwise
@@ -971,8 +971,8 @@ addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside
thing_inside
}
where
- mkNthFunArgErrCtxt :: HsExpr GhcRn -> HsExpr GhcRn -> Int -> TcM a -> TcM a
- mkNthFunArgErrCtxt app_head arg arg_no thing_inside
+ addNthFunArgErrCtxt :: HsExpr GhcRn -> HsExpr GhcRn -> Int -> TcM a -> TcM a
+ addNthFunArgErrCtxt app_head arg arg_no thing_inside
| XExpr (ExpandedThingRn o _) <- arg
= addExpansionErrCtxt o (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $
thing_inside
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -765,7 +765,7 @@ tcXExpr :: XXExprGhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
tcXExpr (ExpandedThingRn o e) res_ty
= mkExpandedTc o <$> -- necessary for hpc ticks
-- Need to call tcExpr and not tcApp
- -- as e can be let statements which tcApp cannot gracefully handle
+ -- as e can be let statement which tcApp cannot gracefully handle
tcExpr e res_ty
-- For record selection, same as HsVar case
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1079,7 +1079,7 @@ setSrcSpan :: SrcSpan -> TcRn a -> TcRn a
setSrcSpan (RealSrcSpan loc _) thing_inside
= updLclCtxt (\env -> env { tcl_loc = loc }) thing_inside
-setSrcSpan (UnhelpfulSpan _) thing_inside
+setSrcSpan loc thing_inside
= thing_inside
getSrcCodeOrigin :: TcRn (Maybe SrcCodeOrigin)
=====================================
testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
=====================================
@@ -1,9 +1,15 @@
RecordDotSyntaxFail10.hs:40:11: error: [GHC-39999]
• No instance for ‘HasField "quux" Quux String’
+ arising from a record update
NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class.
• In the second argument of ‘($)’, namely ‘a {foo.bar.baz.quux}’
- In a stmt of a 'do' block: print $ a {foo.bar.baz.quux}
In the expression:
- do let a = Foo {foo = ...}
- let quux = "Expecto patronum!"
- print $ a {foo.bar.baz.quux}
+ do let a = Foo {foo = ...}
+ let quux = "Expecto patronum!"
+ print $ a {foo.bar.baz.quux}
+ In an equation for ‘main’:
+ main
+ = do let a = ...
+ let quux = "Expecto patronum!"
+ print $ a {foo.bar.baz.quux}
+
=====================================
testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr
=====================================
@@ -3,8 +3,11 @@ RecordDotSyntaxFail13.hs:26:11: error: [GHC-39999]
arising from a record update
NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class.
• In the second argument of ‘($)’, namely ‘a {foo}’
- In a stmt of a 'do' block: print $ a {foo}
In the expression:
do let a = Foo {foo = 12}
print $ a {foo}
+ In an equation for ‘main’:
+ main
+ = do let a = ...
+ print $ a {foo}
=====================================
testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr
=====================================
@@ -3,7 +3,6 @@ RecordDotSyntaxFail8.hs:47:17: error: [GHC-39999]
arising from selecting the field ‘quux1’
NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class.
• In the second argument of ‘($)’, namely ‘....bar.baz.quux1’
- In a stmt of a 'do' block: print @Quux $ ....baz.quux1
In the expression:
do let a = Foo {foo = ...}
print @Quux $ ....quux1
@@ -11,13 +10,19 @@ RecordDotSyntaxFail8.hs:47:17: error: [GHC-39999]
print @Quux $ b.quux2
let c = Foo {foo = ...}
...
+ In an equation for ‘main’:
+ main
+ = do let a = ...
+ print @Quux $ ....quux1
+ let b = myQuux
+ print @Quux $ b.quux2
+ ...
RecordDotSyntaxFail8.hs:50:17: error: [GHC-39999]
• No instance for ‘HasField "quux2" Quux Quux’
arising from selecting the field ‘quux2’
NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class.
• In the second argument of ‘($)’, namely ‘b.quux2’
- In a stmt of a 'do' block: print @Quux $ b.quux2
In the expression:
do let a = Foo {foo = ...}
print @Quux $ ....quux1
@@ -25,12 +30,31 @@ RecordDotSyntaxFail8.hs:50:17: error: [GHC-39999]
print @Quux $ b.quux2
let c = Foo {foo = ...}
...
+ In an equation for ‘main’:
+ main
+ = do let a = ...
+ print @Quux $ ....quux1
+ let b = myQuux
+ print @Quux $ b.quux2
+ ...
RecordDotSyntaxFail8.hs:53:17: error: [GHC-39999]
- • No instance for ‘HasField "quux3" Quux r0’
+ • No instance for ‘HasField "quux3" Quux a0’
arising from selecting the field ‘quux3’
NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class.
• In the expression: ....bar.baz.quux3
- In the second argument of ‘($)’, namely ‘....baz.quux3.wob’
- In a stmt of a 'do' block: print @Bool $ ....quux3.wob
+ In the expression:
+ do let a = Foo {foo = ...}
+ print @Quux $ ....quux1
+ let b = myQuux
+ print @Quux $ b.quux2
+ let c = Foo {foo = ...}
+ ...
+ In an equation for ‘main’:
+ main
+ = do let a = ...
+ print @Quux $ ....quux1
+ let b = myQuux
+ print @Quux $ b.quux2
+ ...
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40a3603f392fb50b057dc07ba56a4e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40a3603f392fb50b057dc07ba56a4e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed new branch wip/26737 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/26737
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26746] Error message wibbles [skip ci]
by Simon Peyton Jones (＠simonpj) 09 Jan '26
by Simon Peyton Jones (＠simonpj) 09 Jan '26
09 Jan '26
Simon Peyton Jones pushed to branch wip/T26746 at Glasgow Haskell Compiler / GHC
Commits:
01a35008 by Simon Peyton Jones at 2026-01-09T09:58:29+00:00
Error message wibbles [skip ci]
...still needs documentation, but awaiting review first
- - - - -
9 changed files:
- testsuite/tests/deriving/should_fail/T8984.stderr
- testsuite/tests/deriving/should_fail/deriving-via-fail.stderr
- testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr
- testsuite/tests/deriving/should_fail/deriving-via-fail5.stderr
- testsuite/tests/typecheck/should_fail/T15801.stderr
- testsuite/tests/typecheck/should_fail/T22924b.stderr
- testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs
- testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
testsuite/tests/deriving/should_fail/T8984.stderr
=====================================
@@ -1,6 +1,6 @@
T8984.hs:7:46: error: [GHC-18872]
- • Couldn't match representation of type: cat a (N cat a Int)
- with that of: cat a (cat a Int)
+ • Couldn't match representation of type: cat a (cat a Int)
+ with that of: cat a (N cat a Int)
arising from the coercion of the method ‘app’
from type ‘cat a (cat a Int)’ to type ‘N cat a (N cat a Int)’
Note: We cannot know what roles the parameters to ‘cat a’ have;
=====================================
testsuite/tests/deriving/should_fail/deriving-via-fail.stderr
=====================================
@@ -1,12 +1,12 @@
deriving-via-fail.hs:10:34: error: [GHC-10283]
- • Couldn't match representation of type ‘a’ with that of ‘b’
+ • Couldn't match representation of type ‘b’ with that of ‘a’
arising from the coercion of the method ‘showsPrec’
from type ‘Int -> Identity b -> ShowS’
to type ‘Int -> Foo1 a -> ShowS’
- ‘a’ is a rigid type variable bound by
+ ‘b’ is a rigid type variable bound by
the deriving clause for ‘Show (Foo1 a)’
at deriving-via-fail.hs:10:34-37
- ‘b’ is a rigid type variable bound by
+ ‘a’ is a rigid type variable bound by
the deriving clause for ‘Show (Foo1 a)’
at deriving-via-fail.hs:10:34-37
• When deriving the instance for (Show (Foo1 a))
=====================================
testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr
=====================================
@@ -1,17 +1,17 @@
deriving-via-fail4.hs:15:12: error: [GHC-18872]
- • Couldn't match representation of type ‘Int’ with that of ‘Char’
+ • Couldn't match representation of type ‘Char’ with that of ‘Int’
arising from the coercion of the method ‘==’
from type ‘Char -> Char -> Bool’ to type ‘F1 -> F1 -> Bool’
• When deriving the instance for (Eq F1)
deriving-via-fail4.hs:18:13: error: [GHC-10283]
- • Couldn't match representation of type ‘a1’ with that of ‘a2’
+ • Couldn't match representation of type ‘a2’ with that of ‘a1’
arising from the coercion of the method ‘c’
from type ‘a -> a -> Bool’ to type ‘a -> F2 a1 -> Bool’
- ‘a1’ is a rigid type variable bound by
+ ‘a2’ is a rigid type variable bound by
the deriving clause for ‘C a (F2 a1)’
at deriving-via-fail4.hs:18:13-15
- ‘a2’ is a rigid type variable bound by
+ ‘a1’ is a rigid type variable bound by
the deriving clause for ‘C a (F2 a1)’
at deriving-via-fail4.hs:18:13-15
• When deriving the instance for (C a (F2 a1))
=====================================
testsuite/tests/deriving/should_fail/deriving-via-fail5.stderr
=====================================
@@ -1,10 +1,10 @@
deriving-via-fail5.hs:8:1: error: [GHC-10283]
- • Couldn't match representation of type ‘a’ with that of ‘b’
+ • Couldn't match representation of type ‘b’ with that of ‘a’
arising from a use of ‘GHC.Internal.Prim.coerce’
- ‘a’ is a rigid type variable bound by
+ ‘b’ is a rigid type variable bound by
the instance declaration
at deriving-via-fail5.hs:(8,1)-(9,24)
- ‘b’ is a rigid type variable bound by
+ ‘a’ is a rigid type variable bound by
the instance declaration
at deriving-via-fail5.hs:(8,1)-(9,24)
• In the expression:
@@ -25,12 +25,12 @@ deriving-via-fail5.hs:8:1: error: [GHC-10283]
(bound at deriving-via-fail5.hs:8:1)
deriving-via-fail5.hs:8:1: error: [GHC-10283]
- • Couldn't match representation of type ‘a’ with that of ‘b’
+ • Couldn't match representation of type ‘b’ with that of ‘a’
arising from a use of ‘GHC.Internal.Prim.coerce’
- ‘a’ is a rigid type variable bound by
+ ‘b’ is a rigid type variable bound by
the instance declaration
at deriving-via-fail5.hs:(8,1)-(9,24)
- ‘b’ is a rigid type variable bound by
+ ‘a’ is a rigid type variable bound by
the instance declaration
at deriving-via-fail5.hs:(8,1)-(9,24)
• In the expression:
@@ -48,12 +48,12 @@ deriving-via-fail5.hs:8:1: error: [GHC-10283]
show :: Foo4 a -> String (bound at deriving-via-fail5.hs:8:1)
deriving-via-fail5.hs:8:1: error: [GHC-10283]
- • Couldn't match representation of type ‘a’ with that of ‘b’
+ • Couldn't match representation of type ‘b’ with that of ‘a’
arising from a use of ‘GHC.Internal.Prim.coerce’
- ‘a’ is a rigid type variable bound by
+ ‘b’ is a rigid type variable bound by
the instance declaration
at deriving-via-fail5.hs:(8,1)-(9,24)
- ‘b’ is a rigid type variable bound by
+ ‘a’ is a rigid type variable bound by
the instance declaration
at deriving-via-fail5.hs:(8,1)-(9,24)
• In the expression:
=====================================
testsuite/tests/typecheck/should_fail/T15801.stderr
=====================================
@@ -1,7 +1,8 @@
T15801.hs:52:10: error: [GHC-18872]
- • Couldn't match representation of type: UnOp op_a -> UnOp b
- with that of: op_a --> b
- arising (via a quantified constraint) from the superclasses of an instance declaration
+ • Couldn't match representation of type: op_a --> b
+ with that of: UnOp op_a -> UnOp b
+ arising (via a quantified constraint) from
+ the superclasses of an instance declaration
When trying to solve the quantified constraint
forall (op_a :: Op (*)) (b :: Op (*)). op_a -#- b
arising from the superclasses of an instance declaration
=====================================
testsuite/tests/typecheck/should_fail/T22924b.stderr
=====================================
@@ -1,6 +1,6 @@
T22924b.hs:10:5: error: [GHC-40404]
• Reduction stack overflow; size = 201
- When simplifying the following constraint: Coercible [R] S
+ When simplifying the following constraint: Coercible S [R]
• In the expression: coerce
In an equation for ‘f’: f = coerce
Suggested fix:
=====================================
testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs
=====================================
@@ -20,15 +20,6 @@ foo4 = coerce $ one :: Down Int
newtype Void = Void Void
foo5 = coerce :: Void -> ()
-
-------------------------------------
--- This next one generates an exponentially big type as it
--- tries to unwrap. See comment:15 in #11518
--- Adding assertions that force the types can make us
--- run out of space.
-newtype VoidBad a = VoidBad (VoidBad (a,a))
-foo5' = coerce :: (VoidBad ()) -> ()
-
------------------------------------
-- This should fail with a context stack overflow
newtype Fix f = Fix (f (Fix f))
=====================================
testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
=====================================
@@ -34,23 +34,21 @@ TcCoercibleFail.hs:18:8: error: [GHC-18872]
In the expression: coerce $ one :: Down Int
In an equation for ‘foo4’: foo4 = coerce $ one :: Down Int
-TcCoercibleFail.hs:21:8: error: [GHC-18872]
- • Couldn't match representation of type ‘Void’ with that of ‘()’
- arising from a use of ‘coerce’
+TcCoercibleFail.hs:21:8: error: [GHC-40404]
+ • Reduction stack overflow; size = 201
+ When simplifying the following constraint: Coercible () Void
• In the expression: coerce :: Void -> ()
In an equation for ‘foo5’: foo5 = coerce :: Void -> ()
+ Suggested fix:
+ Use -freduction-depth=0 to disable this check
+ (any upper bound you could choose might fail unpredictably with
+ minor updates to GHC, so disabling the check is recommended if
+ you're sure that type checking should terminate)
-TcCoercibleFail.hs:30:9: error: [GHC-18872]
- • Couldn't match representation of type ‘VoidBad ()’
- with that of ‘()’
- arising from a use of ‘coerce’
- • In the expression: coerce :: (VoidBad ()) -> ()
- In an equation for ‘foo5'’: foo5' = coerce :: (VoidBad ()) -> ()
-
-TcCoercibleFail.hs:35:8: error: [GHC-40404]
+TcCoercibleFail.hs:26:8: error: [GHC-40404]
• Reduction stack overflow; size = 201
When simplifying the following constraint:
- Coercible (Either Int (Fix (Either Int))) (Fix (Either Age))
+ Coercible (Fix (Either Age)) (Either Int (Fix (Either Int)))
• In the expression: coerce :: Fix (Either Int) -> Fix (Either Age)
In an equation for ‘foo6’:
foo6 = coerce :: Fix (Either Int) -> Fix (Either Age)
@@ -60,10 +58,9 @@ TcCoercibleFail.hs:35:8: error: [GHC-40404]
minor updates to GHC, so disabling the check is recommended if
you're sure that type checking should terminate)
-TcCoercibleFail.hs:36:8: error: [GHC-18872]
- • Couldn't match representation of type ‘Either
- Int (Fix (Either Int))’
- with that of ‘()’
+TcCoercibleFail.hs:27:8: error: [GHC-18872]
+ • Couldn't match representation of type ‘()’
+ with that of ‘Either Int (Fix (Either Int))’
arising from a use of ‘coerce’
• In the expression: coerce :: Fix (Either Int) -> ()
In an equation for ‘foo7’: foo7 = coerce :: Fix (Either Int) -> ()
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -326,11 +326,7 @@ test('T7989', normal, compile_fail, [''])
test('T8034', normal, compile_fail, [''])
test('T8142', normal, compile_fail, [''])
test('T8262', normal, compile_fail, [''])
-
-# TcCoercibleFail times out with the compiler is compiled with -DDEBUG.
-# This is expected (see comment in source file).
-test('TcCoercibleFail', [when(compiler_debugged(), skip)], compile_fail, [''])
-
+test('TcCoercibleFail', [], compile_fail, [''])
test('TcCoercibleFail2', [], compile_fail, [''])
test('TcCoercibleFail3', [], compile_fail, [''])
test('T8306', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01a35008fbf78e8dc2a12ef9610cda9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01a35008fbf78e8dc2a12ef9610cda9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0