[Git][ghc/ghc][wip/jeltsch/detecting-os-handle-types] 10 commits: ci: update darwin boot ghc to 9.10.3
by Wolfgang Jeltsch (＠jeltsch) 28 Jan '26
by Wolfgang Jeltsch (＠jeltsch) 28 Jan '26
28 Jan '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/detecting-os-handle-types at Glasgow Haskell Compiler / GHC
Commits:
50761451 by Cheng Shao at 2026-01-27T21:51:23-05:00
ci: update darwin boot ghc to 9.10.3
This patch updates darwin boot ghc to 9.10.3, along with other related
updates, and pays off some technical debt here:
- Update `nixpkgs` and use the `nixpkgs-25.05-darwin` channel.
- Update the `niv` template.
- Update LLVM to 21 and update `llvm-targets` to reflect LLVM 21
layout changes for arm64/x86_64 darwin targets.
- Use `stdenvNoCC` to prevent nix packaged apple sdk from being used
by boot ghc, and manually set `DEVELOPER_DIR`/`SDKROOT` to enforce
the usage of system-wide command line sdk for macos.
- When building nix derivation for boot ghc, run `configure` via the
`arch` command so that `configure` and its subprocesses pick up the
manually specified architecture.
- Remove the previous horrible hack that obliterates `configure` to
make autoconf test result in true. `configure` now properly does its
job.
- Remove the now obsolete configure args and post install settings
file patching logic.
- Use `scheme-small` for texlive to avoid build failures in certain
unused texlive packages, especially on x86_64-darwin.
- - - - -
94dcd15e by Matthew Pickering at 2026-01-27T21:52:05-05: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, exceptions 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.
CLC proposal: https://github.com/haskell/core-libraries-committee/issues/383
Fixes #26751
- - - - -
ef35e3ea by Teo Camarasu at 2026-01-27T21:52:46-05:00
ghc-internal: move all Data instances to Data.Data
Most instances of Data are defined in GHC.Internal.Data.Data.
Let's move all remaining instance there.
This moves other modules down in the dependency hierarchy allowing for
more parallelism, and it decreases the likelihood that we would need to
load this heavy .hi file if we don't actually need it.
Resolves #26830
Metric Decrease:
T12227
T16875
- - - - -
5e0ec555 by sheaf at 2026-01-28T06:56:38-05:00
Add test case for #25679
This commit adds the T25679 test case. The test now passes, thanks to
commit 1e53277af36d3f0b6ad5491f70ffc5593a49dcfd.
Fixes #25679
- - - - -
f1cd1611 by sheaf at 2026-01-28T06:56:38-05:00
Improve defaulting of representational equalities
This commit makes the defaulting of representational equalities, introduced
in 1e53277a, a little bit more robust. Now, instead of calling the eager
unifier, it calls the full-blown constraint solver, which means that it can
handle some subtle situations, e.g. involving functional dependencies and
type-family injectivity annotations, such as:
type family F a = r | r -> a
type instance F Int = Bool
[W] F beta ~R Bool
- - - - -
25edf516 by sheaf at 2026-01-28T06:56:38-05:00
Improve errors for unsolved representational equalities
This commit adds a new field of CtLoc, CtExplanations, which allows the
typechecker to leave some information about what it has done. For the moment,
it is only used to improve error messages for unsolved representational
equalities. The typechecker will now accumulate, when unifying at
representational role:
- out-of-scope newtype constructors,
- type constructors that have nominal role in a certain argument,
- over-saturated type constructors,
- AppTys, e.g. `c a ~R# c b`, to report that we must assume that 'c' has
nominal role in its parameters,
- data family applications that do not reduce, potentially preventing
newtype unwrapping.
Now, instead of having to re-construct the possible errors after the fact,
we simply consult the CtExplanations field.
Additionally, this commit modifies the typechecker error messages that
concern out-of-scope newtype constructors. The error message now depends
on whether we have an import suggestion to provide to the user:
- If we have an import suggestion for the newtype constructor,
the message will be of the form:
The data constructor MkN of the newtype N is out of scope
Suggested fix: add 'MkN' to the import list in the import of 'M'
- If we don't have any import suggestions, the message will be
of the form:
NB: The type 'N' is an opaque newtype, whose constructor is hidden
Fixes #15850, #20289, #20468, #23731, #25949, #26137
- - - - -
4d0e6da1 by Simon Peyton Jones at 2026-01-28T06:57:19-05:00
Fix two bugs in short-cut constraint solving
There are two main changes here:
* Use `isSolvedWC` rather than `isEmptyWC` in `tryShortCutSolver`
The residual constraint may have some fully-solved, but
still-there implications, and we don't want them to abort short
cut solving! That bug caused #26805.
* In the short-cut solver, we abandon the fully-solved residual
constraint; but we may thereby lose track of Givens that are
needed, and either report them as redundant or prune evidence
bindings that are in fact needed.
This bug stopped the `constraints` package from compiling;
see the trail in !15389.
The second bug led me to (another) significant refactoring
of the mechanism for tracking needed EvIds. See the new
Note [Tracking needed EvIds] in GHC.Tc.Solver.Solve
It's simpler and much less head-scratchy now.
Some particulars:
* An EvBindsVar now tracks NeededEvIds
* We deal with NeededEvIds for an implication only when it is
fully solved. Much simpler!
* `tryShortCutTcS` now takes a `TcM WantedConstraints` rather than
`TcM Bool`, so that is can plumb the needed EvIds correctly.
* Remove `ic_need` and `ic_need_implic` from Implication (hooray),
and add `ics_dm` and `ics_non_dm` to `IC_Solved`.
Pure refactor
* Shorten data constructor `CoercionHole` to `CH`, following
general practice in GHC.
* Rename `EvBindMap` to `EvBindsMap` for consistency
- - - - -
662480b7 by Cheng Shao at 2026-01-28T06:58:00-05:00
ci: use debian validate bindists instead of fedora release bindists in testing stage
This patch changes the `abi-test`, `hadrian-multi` and `perf` jobs in
the full-ci pipeline testing stage to use debian validate bindists
instead of fedora release bindists, to increase pipeline level
parallelism and allow full-ci pipelines to complete earlier. Closes #26818.
- - - - -
39581ec6 by Cheng Shao at 2026-01-28T06:58:40-05:00
ci: run perf test with -j$cores
This patch makes the perf ci job compile Cabal with -j$cores to speed
up the job.
- - - - -
ea3b1e5e by Wolfgang Jeltsch at 2026-01-28T14:14:39+02:00
Add OS handle type detection to `base`
It is deliberate that this addition to `base` does not simply reflect
the `conditional`/`<!>` operation currently in `GHC.IO.SubSystem` but
simply uses the value of a custom enumeration type to describe the type
of OS handles currently in use. The reason for using this approach is
that it is simpler and at the same type more future-proof: if a new OS
handle type should be introduced in the future, it would only be
necessary to add another value to `OSHandleType`, and user code that
uses fallback branches in case distinctions regarding OS handle types
would continue to be compilable at least; `conditional`, on the other
hand, would have to have its argument count changed and `<!>` could not
even be used as an infix operator anymore. Since Haskell has `case`
expressions, there is no real need to have a case-distinguishing
operation like `conditional`/`<!>`.
- - - - -
129 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/darwin/nix/sources.json
- .gitlab/darwin/toolchain.nix
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Core/TyCon/RecWalk.hs
- compiler/GHC/Data/Maybe.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Default.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/CtLoc.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Utils/Monad.hs
- compiler/GHC/Utils/Trace.hs
- libraries/base/changelog.md
- libraries/base/src/System/IO/OS.hs
- libraries/base/tests/IO/all.T
- libraries/base/tests/IO/osHandles001FileDescriptors.hs
- libraries/base/tests/IO/osHandles001FileDescriptors.stdout
- libraries/base/tests/IO/osHandles001WindowsHandles.hs
- libraries/base/tests/IO/osHandles001WindowsHandles.stdout
- libraries/base/tests/IO/osHandles002FileDescriptors.hs
- libraries/base/tests/IO/osHandles002FileDescriptors.stdout
- libraries/base/tests/IO/osHandles002WindowsHandles.hs
- libraries/base/tests/IO/osHandles002WindowsHandles.stdout
- + libraries/base/tests/IO/osHandles003FileDescriptors.hs
- libraries/base/tests/IO/osHandles002FileDescriptors.stderr → libraries/base/tests/IO/osHandles003FileDescriptors.stderr
- libraries/base/tests/IO/osHandles002FileDescriptors.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdin
- libraries/base/tests/IO/osHandles002WindowsHandles.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdout
- + libraries/base/tests/IO/osHandles003WindowsHandles.hs
- libraries/base/tests/IO/osHandles002WindowsHandles.stderr → libraries/base/tests/IO/osHandles003WindowsHandles.stderr
- + libraries/base/tests/IO/osHandles003WindowsHandles.stdin
- + libraries/base/tests/IO/osHandles003WindowsHandles.stdout
- libraries/base/tests/T23454.stderr
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Err.hs
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs
- libraries/ghc-internal/tests/stack-annotation/all.T
- + libraries/ghc-internal/tests/stack-annotation/ann_frame005.hs
- + libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout
- llvm-targets
- + testsuite/tests/default/T25825.hs
- testsuite/tests/default/all.T
- testsuite/tests/deriving/should_fail/T1496.stderr
- testsuite/tests/deriving/should_fail/T4846.stderr
- testsuite/tests/deriving/should_fail/T5498.stderr
- testsuite/tests/deriving/should_fail/T6147.stderr
- testsuite/tests/deriving/should_fail/T7148.stderr
- testsuite/tests/deriving/should_fail/T7148a.stderr
- 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/gadt/CasePrune.stderr
- 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
- testsuite/tests/indexed-types/should_fail/T9580.stderr
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/linear/should_fail/LinearRole.stderr
- testsuite/tests/roles/should_fail/RolesIArray.stderr
- + testsuite/tests/simplCore/should_compile/T26805.hs
- + testsuite/tests/simplCore/should_compile/T26805.stderr
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/typecheck/should_compile/T26805a.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T10285.stderr
- testsuite/tests/typecheck/should_fail/T10534.stderr
- testsuite/tests/typecheck/should_fail/T10715b.stderr
- testsuite/tests/typecheck/should_fail/T11347.stderr
- testsuite/tests/typecheck/should_fail/T15801.stderr
- + testsuite/tests/typecheck/should_fail/T15850.hs
- + testsuite/tests/typecheck/should_fail/T15850.stderr
- + testsuite/tests/typecheck/should_fail/T15850_Lib.hs
- + testsuite/tests/typecheck/should_fail/T20289.hs
- + testsuite/tests/typecheck/should_fail/T20289.stderr
- + testsuite/tests/typecheck/should_fail/T20289_A.hs
- testsuite/tests/typecheck/should_fail/T22645.stderr
- testsuite/tests/typecheck/should_fail/T22924a.stderr
- + testsuite/tests/typecheck/should_fail/T23731.hs
- + testsuite/tests/typecheck/should_fail/T23731.stderr
- + testsuite/tests/typecheck/should_fail/T23731b.hs
- + testsuite/tests/typecheck/should_fail/T23731b.stderr
- + testsuite/tests/typecheck/should_fail/T23731b_aux.hs
- + testsuite/tests/typecheck/should_fail/T25679.hs
- + testsuite/tests/typecheck/should_fail/T25679.stderr
- + testsuite/tests/typecheck/should_fail/T25949.hs
- + testsuite/tests/typecheck/should_fail/T25949.stderr
- + testsuite/tests/typecheck/should_fail/T25949_aux.hs
- + testsuite/tests/typecheck/should_fail/T26137.hs
- + testsuite/tests/typecheck/should_fail/T26137.stderr
- testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
- testsuite/tests/typecheck/should_fail/TcCoercibleFail3.stderr
- testsuite/tests/typecheck/should_fail/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f8d806e9421db25e2773b674ac45a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f8d806e9421db25e2773b674ac45a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
28 Jan '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
39581ec6 by Cheng Shao at 2026-01-28T06:58:40-05:00
ci: run perf test with -j$cores
This patch makes the perf ci job compile Cabal with -j$cores to speed
up the job.
- - - - -
1 changed file:
- .gitlab/ci.sh
Changes:
=====================================
.gitlab/ci.sh
=====================================
@@ -835,6 +835,7 @@ function cabal_test() {
run "$HC" \
-hidir tmp -odir tmp -fforce-recomp \
-dumpdir "$OUT/dumps" -ddump-timings \
+ -j"$cores" \
+RTS --machine-readable "-t$OUT/rts.log" -RTS \
-ilibraries/Cabal/Cabal/src -XNoPolyKinds Distribution.Simple \
"$@" 2>&1 | tee $OUT/log
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39581ec6f267e56484b082ee78013ca…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39581ec6f267e56484b082ee78013ca…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] ci: use debian validate bindists instead of fedora release bindists in testing stage
by Marge Bot (＠marge-bot) 28 Jan '26
by Marge Bot (＠marge-bot) 28 Jan '26
28 Jan '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
662480b7 by Cheng Shao at 2026-01-28T06:58:00-05:00
ci: use debian validate bindists instead of fedora release bindists in testing stage
This patch changes the `abi-test`, `hadrian-multi` and `perf` jobs in
the full-ci pipeline testing stage to use debian validate bindists
instead of fedora release bindists, to increase pipeline level
parallelism and allow full-ci pipelines to complete earlier. Closes #26818.
- - - - -
1 changed file:
- .gitlab-ci.yml
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -444,14 +444,14 @@ hadrian-ghc-in-ghci:
hadrian-multi:
stage: testing
needs:
- - job: x86_64-linux-fedora43-release
+ - job: x86_64-linux-deb12-validate
optional: true
- - job: nightly-x86_64-linux-fedora43-release
+ - job: nightly-x86_64-linux-deb12-validate
optional: true
- - job: release-x86_64-linux-fedora43-release
+ - job: release-x86_64-linux-deb12-release
optional: true
dependencies: null
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora43:$DOCKER_REV"
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:$DOCKER_REV"
before_script:
# workaround for docker permissions
- sudo chown ghc:ghc -R .
@@ -471,7 +471,8 @@ hadrian-multi:
- ls
- |
mkdir tmp
- tar -xf ghc-x86_64-linux-fedora43-release.tar.xz -C tmp
+ tar -xf ghc-x86_64-linux-deb12-validate.tar.xz -C tmp \
+ || tar -xf ghc-x86_64-linux-deb12-release.tar.xz -C tmp
pushd tmp/ghc-*/
./configure --prefix=$root
make install
@@ -1001,14 +1002,14 @@ perf-nofib:
perf:
stage: testing
needs:
- - job: x86_64-linux-fedora43-release
+ - job: x86_64-linux-deb12-validate
optional: true
- - job: nightly-x86_64-linux-fedora43-release
+ - job: nightly-x86_64-linux-deb12-validate
optional: true
- - job: release-x86_64-linux-fedora43-release
+ - job: release-x86_64-linux-deb12-release
optional: true
dependencies: null
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora43:$DOCKER_REV"
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:$DOCKER_REV"
tags:
- x86_64-linux-perf
before_script:
@@ -1018,7 +1019,8 @@ perf:
- root=$(pwd)/ghc
- |
mkdir tmp
- tar -xf ghc-x86_64-linux-fedora43-release.tar.xz -C tmp
+ tar -xf ghc-x86_64-linux-deb12-validate.tar.xz -C tmp \
+ || tar -xf ghc-x86_64-linux-deb12-release.tar.xz -C tmp
pushd tmp/ghc-*/
./configure --prefix=$root
make install
@@ -1042,21 +1044,22 @@ perf:
abi-test:
stage: testing
needs:
- - job: x86_64-linux-fedora43-release
+ - job: x86_64-linux-deb12-validate
optional: true
- - job: nightly-x86_64-linux-fedora43-release
+ - job: nightly-x86_64-linux-deb12-validate
optional: true
- - job: release-x86_64-linux-fedora43-release
+ - job: release-x86_64-linux-deb12-release
optional: true
dependencies: null
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora43:$DOCKER_REV"
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:$DOCKER_REV"
tags:
- x86_64-linux
script:
- root=$(pwd)/ghc
- |
mkdir tmp
- tar -xf ghc-x86_64-linux-fedora43-release.tar.xz -C tmp
+ tar -xf ghc-x86_64-linux-deb12-validate.tar.xz -C tmp \
+ || tar -xf ghc-x86_64-linux-deb12-release.tar.xz -C tmp
pushd tmp/ghc-*/
./configure --prefix=$root
make install
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/662480b7b5ab2910ca1344dfeaf9256…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/662480b7b5ab2910ca1344dfeaf9256…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Fix two bugs in short-cut constraint solving
by Marge Bot (＠marge-bot) 28 Jan '26
by Marge Bot (＠marge-bot) 28 Jan '26
28 Jan '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
4d0e6da1 by Simon Peyton Jones at 2026-01-28T06:57:19-05:00
Fix two bugs in short-cut constraint solving
There are two main changes here:
* Use `isSolvedWC` rather than `isEmptyWC` in `tryShortCutSolver`
The residual constraint may have some fully-solved, but
still-there implications, and we don't want them to abort short
cut solving! That bug caused #26805.
* In the short-cut solver, we abandon the fully-solved residual
constraint; but we may thereby lose track of Givens that are
needed, and either report them as redundant or prune evidence
bindings that are in fact needed.
This bug stopped the `constraints` package from compiling;
see the trail in !15389.
The second bug led me to (another) significant refactoring
of the mechanism for tracking needed EvIds. See the new
Note [Tracking needed EvIds] in GHC.Tc.Solver.Solve
It's simpler and much less head-scratchy now.
Some particulars:
* An EvBindsVar now tracks NeededEvIds
* We deal with NeededEvIds for an implication only when it is
fully solved. Much simpler!
* `tryShortCutTcS` now takes a `TcM WantedConstraints` rather than
`TcM Bool`, so that is can plumb the needed EvIds correctly.
* Remove `ic_need` and `ic_need_implic` from Implication (hooray),
and add `ics_dm` and `ics_non_dm` to `IC_Solved`.
Pure refactor
* Shorten data constructor `CoercionHole` to `CH`, following
general practice in GHC.
* Rename `EvBindMap` to `EvBindsMap` for consistency
- - - - -
28 changed files:
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Gen/Default.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Utils/Trace.hs
- + testsuite/tests/simplCore/should_compile/T26805.hs
- + testsuite/tests/simplCore/should_compile/T26805.stderr
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/typecheck/should_compile/T26805a.hs
- testsuite/tests/typecheck/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/TyCo/Rep.hs
=====================================
@@ -1688,11 +1688,9 @@ holes `HoleCo`, which get filled in later.
-- | A coercion to be filled in by the type-checker. See Note [Coercion holes]
data CoercionHole
- = CoercionHole { ch_co_var :: CoVar
- -- See Note [Coercion holes] wrinkle (COH2)
-
- , ch_ref :: IORef (Maybe CoercionPlusHoles)
- }
+ = CH { ch_co_var :: CoVar -- See Note [Coercion holes] wrinkle (COH2)
+ , ch_ref :: IORef (Maybe CoercionPlusHoles)
+ }
data CoercionPlusHoles
= CPH { cph_co :: Coercion
@@ -1714,7 +1712,7 @@ instance Data.Data CoercionHole where
dataTypeOf _ = mkNoRepType "CoercionHole"
instance Outputable CoercionHole where
- ppr (CoercionHole { ch_co_var = cv }) = braces (ppr cv)
+ ppr (CH { ch_co_var = cv }) = braces (ppr cv)
instance Outputable CoercionPlusHoles where
ppr (CPH { cph_co = co, cph_holes = holes })
@@ -1723,7 +1721,7 @@ instance Outputable CoercionPlusHoles where
, text "cph_holes =" <+> ppr holes ])
instance Uniquable CoercionHole where
- getUnique (CoercionHole { ch_co_var = cv }) = getUnique cv
+ getUnique (CH { ch_co_var = cv }) = getUnique cv
-- | A CoHoleSet stores a set of CoercionHoles that have been used to rewrite
=====================================
compiler/GHC/Core/TyCo/Subst.hs
=====================================
@@ -892,8 +892,7 @@ subst_co subst co
in cos' `seqList` cos'
-- See Note [Substituting in a coercion hole]
- go_hole h@(CoercionHole { ch_co_var = cv })
- = h { ch_co_var = updateVarType go_ty cv }
+ go_hole h@(CH { ch_co_var = cv }) = h { ch_co_var = updateVarType go_ty cv }
-- | Perform a substitution within a 'DVarSet' of free variables,
-- returning the shallow free coercion variables.
=====================================
compiler/GHC/Core/TyCo/Tidy.hs
=====================================
@@ -357,7 +357,7 @@ tidyCo env co
go_cv cv = tidyTyCoVarOcc env cv
- go_hole (CoercionHole cv r) = (CoercionHole $! go_cv cv) r
+ go_hole (CH cv r) = (CH $! go_cv cv) r
-- Tidy even the holes; tidied types should have tidied kinds
tidyCos :: TidyEnv -> [Coercion] -> [Coercion]
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -405,7 +405,7 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs
_ -> False
warnRedundantConstraints :: SolverReportErrCtxt -> CtLocEnv -> SkolemInfoAnon -> [EvVar] -> TcM ()
--- See Note [Tracking redundant constraints] in GHC.Tc.Solver
+-- See Note [Tracking needed EvIds] in GHC.Tc.Solver
warnRedundantConstraints ctxt env info redundant_evs
| not (cec_warn_redundant ctxt)
= return ()
=====================================
compiler/GHC/Tc/Gen/Default.hs
=====================================
@@ -22,7 +22,7 @@ import GHC.Tc.Errors.Types
import GHC.Tc.Gen.HsType
import GHC.Tc.Solver.Monad ( runTcS )
import GHC.Tc.Solver.Solve ( solveWanteds )
-import GHC.Tc.Types.Constraint ( isEmptyWC, andWC, mkSimpleWC )
+import GHC.Tc.Types.Constraint ( isSolvedWC, andWC, mkSimpleWC )
import GHC.Tc.Types.Origin ( CtOrigin(DefaultOrigin) )
import GHC.Tc.Utils.Env
import GHC.Tc.Utils.Monad
@@ -296,7 +296,7 @@ simplifyDefault cls dflt_ty@(L l _)
, text "inst_pred:" <+> ppr inst_pred
, text "all_wanteds " <+> ppr all_wanteds
, text "unsolved:" <+> ppr unsolved ]
- ; let is_instance = isEmptyWC unsolved
+ ; let is_instance = isSolvedWC unsolved
; return $
if | is_instance
, ClassPred _ tys <- classifyPredType inst_pred
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -199,6 +199,9 @@ tcPolyExprCheck expr res_ty
-> TcM (HsExpr GhcTc)
outer_skolemise (Left ty) thing_inside
= do { (wrap, expr') <- tcSkolemiseExpectedType ty thing_inside
+ ; traceTc "outer_skol" (vcat [ text "wrap" <+> ppr wrap
+ , text "expr'" <+> ppr expr'
+ , text "wrapped" <+> ppr (mkHsWrap wrap expr') ])
; return (mkHsWrap wrap expr') }
outer_skolemise (Right sig) thing_inside
= do { (wrap, expr') <- tcSkolemiseCompleteSig sig thing_inside
=====================================
compiler/GHC/Tc/Solver/Default.hs
=====================================
@@ -272,10 +272,9 @@ unsatisfiableEv_maybe v = (v,) <$> isUnsatisfiableCt_maybe (idType v)
-- solve all the other Wanted constraints, including those nested within
-- deeper implications.
solveImplicationUsingUnsatGiven :: (EvVar, Type) -> Implication -> TcS Implication
-solveImplicationUsingUnsatGiven
- unsat_given@(given_ev,_)
+solveImplicationUsingUnsatGiven unsat_given
impl@(Implic { ic_wanted = wtd, ic_tclvl = tclvl, ic_binds = ev_binds_var
- , ic_need_implic = inner, ic_info = skol_info })
+ , ic_info = skol_info })
| isCoEvBindsVar ev_binds_var
-- We can't use Unsatisfiable evidence in kinds.
-- See Note [Coercion evidence only] in GHC.Tc.Types.Evidence.
@@ -283,9 +282,7 @@ solveImplicationUsingUnsatGiven
| otherwise
= do { wcs <- nestImplicTcS skol_info ev_binds_var tclvl $ go_wc wtd
; setImplicationStatus $
- impl { ic_wanted = wcs
- , ic_need_implic = inner `extendEvNeedSet` given_ev } }
- -- Record that the Given is needed; I'm not certain why
+ impl { ic_wanted = wcs } }
where
go_wc :: WantedConstraints -> TcS WantedConstraints
go_wc wc@(WC { wc_simple = wtds, wc_impl = impls })
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -663,6 +663,12 @@ Some wrinkles:
of the caller (#15164). You might worry about having a solved-dict that uses
a Given -- but that too will have been subject to short-cut solving so it's fine.
+(SCS4) In `tryShortCutSolver`, when deciding if we have "completely solved" the
+ constraint, we must use `isSolvedWC` not `isEmptyWC`. The latter says "False"
+ if the residual constraint has any implications, even solved ones; and we
+ don't want to reject short-cut solving just because we have some leftover
+ /solved/ implications. #26805 was a case in point.
+
Note [Shortcut solving: incoherence]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This optimization relies on coherence of dictionaries to be correct. When we
@@ -742,7 +748,8 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys
= -- There is a matching dictionary in the inert set
do { -- For a Wanted, first to try to solve it /completely/ from top level instances
-- See Note [Shortcut solving]
- ; short_cut_worked <- tryShortCutSolver (isGiven ev_i) dict_w
+ ; dflags <- getDynFlags
+ ; short_cut_worked <- tryShortCutSolver dflags (isGiven ev_i) dict_w
; if | short_cut_worked
-> stopWith ev_w "shortCutSolver worked(1)"
@@ -770,7 +777,8 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys
; continueWith () }
-- See Note [Shortcut solving]
-tryShortCutSolver :: Bool -- True <=> try the short-cut solver; False <=> don't
+tryShortCutSolver :: DynFlags
+ -> Bool -- True <=> try the short-cut solver; False <=> don't
-> DictCt -- Work item
-> TcS Bool -- True <=> success
-- We are about to solve a [W] constraint from a [G] constraint. We take
@@ -778,30 +786,25 @@ tryShortCutSolver :: Bool -- True <=> try the short-cut solver; False <=>
-- Note that we only do this for the sake of performance. Exactly the same
-- programs should typecheck regardless of whether we take this step or
-- not. See Note [Shortcut solving]
-tryShortCutSolver try_short_cut dict_w@(DictCt { di_ev = ev_w })
- | not try_short_cut
- = return False
- | otherwise
- = do { dflags <- getDynFlags
- ; if | CtWanted (WantedCt { ctev_pred = pred_w }) <- ev_w
-
- , not (couldBeIPLike pred_w) -- Not for implicit parameters (#18627)
+tryShortCutSolver dflags try_short_cut dict_w
+ | try_short_cut
+ , DictCt { di_ev = ev_w } <- dict_w
+ , CtWanted (WantedCt { ctev_pred = pred_w }) <- ev_w
+ , not (couldBeIPLike pred_w) -- Not for implicit parameters (#18627)
- , not (xopt LangExt.IncoherentInstances dflags)
+ , not (xopt LangExt.IncoherentInstances dflags)
-- If IncoherentInstances is on then we cannot rely on coherence of proofs
-- in order to justify this optimization: The proof provided by the
-- [G] constraint's superclass may be different from the top-level proof.
-- See Note [Shortcut solving: incoherence]
-
- , gopt Opt_SolveConstantDicts dflags
+ , gopt Opt_SolveConstantDicts dflags
-- Enabled by the -fsolve-constant-dicts flag
- -> tryShortCutTcS $ -- tryTcS tries to completely solve some contraints
- do { residual <- solveSimpleWanteds (unitBag (CDictCan dict_w))
- ; return (isEmptyWC residual) }
+ = tryShortCutTcS $ -- tryTcS tries to completely solve some contraints
+ solveSimpleWanteds (unitBag (CDictCan dict_w))
- | otherwise
- -> return False }
+ | otherwise
+ = return False
{- *******************************************************************
@@ -836,7 +839,7 @@ try_instances inerts work_item@(DictCt { di_ev = ev@(CtWanted wev), di_cls = cls
; case lkup_res of
OneInst { cir_what = what }
-> do { let is_local_given = case what of { LocalInstance -> True; _ -> False }
- ; take_shortcut <- tryShortCutSolver is_local_given work_item
+ ; take_shortcut <- tryShortCutSolver dflags is_local_given work_item
; if take_shortcut
then stopWith ev "shortCutSolver worked(2)"
else do { insertSafeOverlapFailureTcS what work_item
=====================================
compiler/GHC/Tc/Solver/Equality.hs
=====================================
@@ -746,7 +746,7 @@ can_eq_nc_forall ev eq_rel s1 s2
-- they are kept alive by `neededEvVars`. Admittedly they are free in `all_co`,
-- but only if we zonk it, which `neededEvVars` does not do (see test T7196).
ev_binds_var <- getTcEvBindsVar
- ; updTcEvBinds ev_binds_var nested_ev_binds_var
+ ; combineTcEvBinds ev_binds_var nested_ev_binds_var
; setWantedEq orig_dest (CPH { cph_co = all_co, cph_holes = emptyCoHoleSet })
-- emptyCoHoleSet: fully solved, so all_co has no holes
=====================================
compiler/GHC/Tc/Solver/InertSet.hs
=====================================
@@ -2127,7 +2127,7 @@ solveOneFromTheOther.
- For everything else, we want to keep the outermost one. Reason: that
makes it more likely that the inner one will turn out to be unused,
- and can be reported as redundant. See Note [Tracking redundant constraints]
+ and can be reported as redundant. See Note [Tracking needed EvIds]
in GHC.Tc.Solver.
It transpires that using the outermost one is responsible for an
@@ -2140,7 +2140,7 @@ solveOneFromTheOther.
according to Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance.
(b) Prefer constraints that are not superclass selections. See
- (TRC3) in Note [Tracking redundant constraints] in GHC.Tc.Solver.
+ (TRC3) in Note [Tracking needed EvIds] in GHC.Tc.Solver.
(c) If both are GivenSCOrigin, chooose the one with the shallower
superclass-selection depth, in the hope of identifying more correct
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -15,7 +15,7 @@ module GHC.Tc.Solver.Monad (
failTcS, warnTcS, addErrTcS, wrapTcS, ctLocWarnTcS,
runTcSEqualities,
nestTcS, nestImplicTcS, tryShortCutTcS, nestFunDepsTcS,
- setEvBindsTcS, setTcLevelTcS, updTcEvBinds,
+ setEvBindsTcS, setTcLevelTcS,
selectNextWorkItem,
getWorkList,
@@ -58,7 +58,7 @@ module GHC.Tc.Solver.Monad (
getInstEnvs, getFamInstEnvs, -- Getting the environments
getTopEnv, getGblEnv, getLclEnv, setSrcSpan,
getTcEvBindsVar, getTcLevel,
- getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap,
+ getTcEvBindsMap, setTcEvBindsMap, getTcEvBindsState, combineTcEvBinds,
tcLookupClass, tcLookupId, tcLookupTyCon,
-- Inerts
@@ -1140,7 +1140,7 @@ csTraceTcM mk_doc
{-# INLINE csTraceTcM #-} -- see Note [INLINE conditional tracing utilities]
runTcS :: TcS a -- What to run
- -> TcM (a, EvBindMap)
+ -> TcM (a, EvBindsMap)
runTcS tcs
= do { ev_binds_var <- TcM.newTcEvBinds
; res <- runTcSWithEvBinds ev_binds_var tcs
@@ -1222,7 +1222,7 @@ runTcSWithEvBinds' mode ev_binds_var thing_inside
----------------------------
#if defined(DEBUG)
-checkForCyclicBinds :: EvBindMap -> TcM ()
+checkForCyclicBinds :: EvBindsMap -> TcM ()
checkForCyclicBinds ev_binds_map
| null cycles
= return ()
@@ -1351,7 +1351,7 @@ nestTcS (TcS thing_inside)
; return res }
-tryShortCutTcS :: TcS Bool -> TcS Bool
+tryShortCutTcS :: TcS WantedConstraints -> TcS Bool
-- Like nestTcS, but
-- (a) be a no-op if the nested computation returns False
-- (b) if (but only if) success, propagate nested bindings to the caller
@@ -1380,26 +1380,43 @@ tryShortCutTcS (TcS thing_inside)
, tcs_inerts = new_inert_var
, tcs_worklist = new_wl_var }
- ; TcM.traceTc "tryTcS {" $
+ ; TcM.traceTc "tryShortCutTcS {" $
vcat [ text "old_ev_binds:" <+> ppr old_ev_binds_var
, text "new_ev_binds:" <+> ppr new_ev_binds_var
, ppr old_inerts ]
- ; solved <- thing_inside nest_env
- ; TcM.traceTc "tryTcS }" (ppr solved)
-
- ; if not solved
- then return False
- else do { -- Successfully solved
- -- Add the new bindings to the existing ones
- ; TcM.updTcEvBinds old_ev_binds_var new_ev_binds_var
-
- -- Update the existing inert set
- ; new_inerts <- TcM.readTcRef new_inert_var
- ; TcM.updTcRef inerts_var (`updateInertsWith` new_inerts)
-
- ; TcM.traceTc "tryTcS update" (ppr (inert_solved_dicts new_inerts))
-
- ; return True } }
+ ; residual <- thing_inside nest_env
+ ; let solved = isSolvedWC residual
+ -- NB: isSolvedWC, not isEmptyWC (#26805). We might succeed
+ -- in fully-solving the constraint but still leave some
+ -- /solved/ implications in the residual.
+ -- See (SCS4) in Note [Shortcut solving]
+ ; TcM.traceTc "tryShortCutTcS }" (ppr solved)
+
+ ; when solved $ -- Successfully solved
+ do { -- Add the new bindings to the existing ones
+ ; TcM.combineTcEvBinds old_ev_binds_var new_ev_binds_var
+
+ -- We are discarding some implications; we must add their
+ -- NeededEvIds to the current bindings, lest we fail to record
+ -- some needed givens, and then wrongly prune away their bindings
+ ; TcM.addNeededEvIds old_ev_binds_var $
+ foldr add_implic emptyVarSet $
+ wc_impl residual
+
+ -- Update the existing inert set
+ ; new_inerts <- TcM.readTcRef new_inert_var
+ ; TcM.updTcRef inerts_var (`updateInertsWith` new_inerts) }
+
+
+ ; return solved
+ }
+ where
+ add_implic :: Implication -> NeededEvIds -> NeededEvIds
+ add_implic implic@(Implic { ic_status = status }) needs
+ | IC_Solved { ics_dm = dm, ics_non_dm = non_dm } <- status
+ = needs `unionVarSet` dm `unionVarSet` non_dm
+ | otherwise
+ = pprPanic "tryShortCutTcS" (ppr implic)
updateInertsWith :: InertSet -> InertSet -> InertSet
-- Update the current inert set with bits from a nested solve,
@@ -1465,21 +1482,21 @@ getTcEvBindsVar = TcS (return . tcs_ev_binds)
getTcLevel :: TcS TcLevel
getTcLevel = wrapTcS TcM.getTcLevel
-getTcEvTyCoVars :: EvBindsVar -> TcS [TcCoercion]
-getTcEvTyCoVars ev_binds_var
- = wrapTcS $ TcM.getTcEvTyCoVars ev_binds_var
+getTcEvBindsState :: EvBindsVar -> TcS EvBindsState
+getTcEvBindsState ev_binds_var
+ = wrapTcS $ TcM.getTcEvBindsState ev_binds_var
-getTcEvBindsMap :: EvBindsVar -> TcS EvBindMap
+getTcEvBindsMap :: EvBindsVar -> TcS EvBindsMap
getTcEvBindsMap ev_binds_var
= wrapTcS $ TcM.getTcEvBindsMap ev_binds_var
-setTcEvBindsMap :: EvBindsVar -> EvBindMap -> TcS ()
+setTcEvBindsMap :: EvBindsVar -> EvBindsMap -> TcS ()
setTcEvBindsMap ev_binds_var binds
= wrapTcS $ TcM.setTcEvBindsMap ev_binds_var binds
-updTcEvBinds :: EvBindsVar -> EvBindsVar -> TcS ()
-updTcEvBinds evb nested_evb
- = wrapTcS $ TcM.updTcEvBinds evb nested_evb
+combineTcEvBinds :: EvBindsVar -> EvBindsVar -> TcS ()
+combineTcEvBinds evb nested_evb
+ = wrapTcS $ TcM.combineTcEvBinds evb nested_evb
getDefaultInfo :: TcS (DefaultEnv, Bool)
getDefaultInfo = wrapTcS TcM.tcGetDefaultTys
@@ -2029,12 +2046,9 @@ setWantedDict dest canonical tm
HoleDest h -> pprPanic "setWantedEq: HoleDest" (ppr h)
fillCoercionHole :: CoercionHole -> CoercionPlusHoles -> TcS ()
-fillCoercionHole hole co_plus_holes@(CPH { cph_co = co })
+fillCoercionHole hole co_plus_holes
= do { ev_binds_var <- getTcEvBindsVar
- ; wrapTcS $ do { -- Record usage of the free vars of this coercion
- TcM.updTcRef (ebv_tcvs ev_binds_var) (co :)
- ; -- Fill the hole
- TcM.fillCoercionHole hole co_plus_holes }
+ ; wrapTcS $ TcM.addTcEvCoBind ev_binds_var hole co_plus_holes
; kickOutAfterFillingCoercionHole hole co_plus_holes }
newTcEvBinds :: TcS EvBindsVar
=====================================
compiler/GHC/Tc/Solver/Solve.hs
=====================================
@@ -33,7 +33,6 @@ import qualified GHC.Tc.Zonk.TcType as TcM
import GHC.Core.Predicate
import GHC.Core.Reduction
import GHC.Core.Coercion
-import GHC.Core.TyCo.FVs( coVarsOfCos )
import GHC.Core.Class( classHasSCs )
import GHC.Types.Id( idType )
@@ -432,12 +431,10 @@ solveImplication imp@(Implic { ic_tclvl = tclvl
, ic_wanted = final_wanted })
; evbinds <- TcS.getTcEvBindsMap ev_binds_var
- ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var
; traceTcS "solveImplication end }" $ vcat
[ text "has_given_eqs =" <+> ppr has_given_eqs
, text "res_implic =" <+> ppr res_implic
- , text "implication evbinds =" <+> ppr (evBindMapBinds evbinds)
- , text "implication tvcs =" <+> ppr tcvs ]
+ , text "evbinds =" <+> ppr evbinds ]
; return res_implic }
@@ -460,30 +457,27 @@ setImplicationStatus :: Implication -> TcS Implication
-- * Prune unnecessary evidence bindings
-- * Prune unnecessary child implications
-- Precondition: the ic_status field is not already IC_Solved
-setImplicationStatus implic@(Implic { ic_status = old_status
- , ic_info = info
- , ic_wanted = wc })
- = assertPpr (not (isSolvedStatus old_status)) (ppr info) $
- -- Precondition: we only set the status if it is not already solved
- do { traceTcS "setImplicationStatus {" (ppr implic)
-
- ; let solved = isSolvedWC wc
- ; new_implic <- neededEvVars implic
- ; bad_telescope <- if solved then checkBadTelescope implic
- else return False
-
- ; let new_status | insolubleWC wc = IC_Insoluble
- | not solved = IC_Unsolved
- | bad_telescope = IC_BadTelescope
- | otherwise = IC_Solved { ics_dead = dead_givens }
- dead_givens = findRedundantGivens new_implic
- new_wc = pruneImplications wc
-
- final_implic = new_implic { ic_status = new_status
- , ic_wanted = new_wc }
-
- ; traceTcS "setImplicationStatus }" (ppr final_implic)
- ; return final_implic }
+setImplicationStatus implic@(Implic { ic_wanted = wc })
+ | insolubleWC wc
+ = do { traceTcS "setImplicationStatus:insoluble" (ppr implic)
+ ; return (implic { ic_status = IC_Insoluble }) }
+
+ | not (isSolvedWC wc)
+ = -- Precondition: we only set the status if it is not /already/ solved
+ do { traceTcS "setImplicationStatus:in progress" (ppr implic)
+ ; return (implic { ic_status = IC_Unsolved }) }
+
+ | otherwise -- The Wanteds are all solved
+ = do { traceTcS "setImplicationStatus:solved" (ppr implic)
+ ; bad_telescope <- checkBadTelescope implic
+ ; if bad_telescope
+ then return (implic { ic_status = IC_BadTelescope })
+ else
+
+ do { solved_status <- computeSolvedStatus implic
+ ; let pruned_wc = pruneImplications wc
+ ; return (implic { ic_status = solved_status
+ , ic_wanted = pruned_wc }) } }
pruneImplications :: WantedConstraints -> WantedConstraints
-- We have now recorded the `ic_need` variables of the child
@@ -502,44 +496,6 @@ pruneImplications wc@(WC { wc_impl = implics })
| otherwise
= True -- Otherwise, keep it
-findRedundantGivens :: Implication -> [EvVar]
-findRedundantGivens (Implic { ic_info = info, ic_need = need, ic_given = givens })
- | not (warnRedundantGivens info) -- Don't report redundant constraints at all
- = [] -- See (TRC4) of Note [Tracking redundant constraints]
-
- | not (null unused_givens) -- Some givens are literally unused
- = unused_givens
-
- -- Only try this if unused_givens is empty: see (TRC2a)
- | otherwise -- All givens are used, but some might
- = redundant_givens -- still be redundant e.g. (Eq a, Ord a)
-
- where
- in_instance_decl = case info of { InstSkol {} -> True; _ -> False }
- -- See Note [Redundant constraints in instance decls]
-
- unused_givens = filterOut is_used givens
-
- needed_givens_ignoring_default_methods = ens_fvs need
- is_used given = is_type_error given
- || given `elemVarSet` needed_givens_ignoring_default_methods
- || (in_instance_decl && is_improving (idType given))
-
- minimal_givens = mkMinimalBySCs evVarPred givens -- See (TRC2)
-
- is_minimal = (`elemVarSet` mkVarSet minimal_givens)
- redundant_givens
- | in_instance_decl = []
- | otherwise = filterOut is_minimal givens
-
- -- See #15232
- is_type_error id = containsUserTypeError False (idType id)
- -- False <=> do not look under ty-fam apps, AppTy etc.
- -- See (UTE1) in Note [Custom type errors in constraints].
-
- is_improving pred -- (transSuperClasses p) does not include p
- = any isImprovementPred (pred : transSuperClasses pred)
-
warnRedundantGivens :: SkolemInfoAnon -> Bool
warnRedundantGivens (SigSkol ctxt _ _)
= case ctxt of
@@ -549,7 +505,7 @@ warnRedundantGivens (SigSkol ctxt _ _)
warnRedundantGivens (InstSkol from _)
-- Do not report redundant constraints for quantified constraints
- -- See (TRC4) in Note [Tracking redundant constraints]
+ -- See (TRC4) in Note [Tracking needed EvIds]
-- Fortunately it is easy to spot implications constraints that arise
-- from quantified constraints, from their SkolInfo
= case from of
@@ -611,113 +567,142 @@ checkBadTelescope (Implic { ic_info = info
| otherwise
= go (later_skols `extendVarSet` one_skol) earlier_skols
-neededEvVars :: Implication -> TcS Implication
--- Find all the evidence variables that are "needed",
--- /and/ delete dead evidence bindings
+computeSolvedStatus :: Implication -> TcS ImplicStatus
+-- Given a fully-solved implication,
+-- - Figure out the right IC_Solved fields
+-- - Delete unused evidence bindings
--
--- See Note [Tracking redundant constraints]
+-- See Note [Tracking needed EvIds]
-- See Note [Delete dead Given evidence bindings]
---
--- - Start from initial_seeds (from nested implications)
---
--- - Add free vars of RHS of all Wanted evidence bindings
--- and coercion variables accumulated in tcvs (all Wanted)
---
--- - Generate 'needed', the needed set of EvVars, by doing transitive
--- closure through Given bindings
--- e.g. Needed {a,b}
--- Given a = sc_sel a2
--- Then a2 is needed too
---
--- - Prune out all Given bindings that are not needed
-
-neededEvVars implic@(Implic { ic_info = info
+computeSolvedStatus (Implic { ic_info = info
, ic_binds = ev_binds_var
- , ic_wanted = WC { wc_impl = implics }
- , ic_need_implic = old_need_implic -- See (TRC1)
- })
- = do { ev_binds <- TcS.getTcEvBindsMap ev_binds_var
- ; used_cos <- TcS.getTcEvTyCoVars ev_binds_var
-
- ; let -- Find the variables needed by `implics`
- new_need_implic@(ENS { ens_dms = dm_seeds, ens_fvs = other_seeds })
- = foldr add_implic old_need_implic implics
- -- Start from old_need_implic! See (TRC1)
-
- -- Get the variables needed by the solved bindings
- -- (It's OK to use a non-deterministic fold here
- -- because add_wanted is commutative.)
- used_covars = coVarsOfCos used_cos
- seeds_w = nonDetStrictFoldEvBindMap add_wanted used_covars ev_binds
-
- need_ignoring_dms = findNeededGivenEvVars ev_binds (other_seeds `unionVarSet` seeds_w)
- need_from_dms = findNeededGivenEvVars ev_binds dm_seeds
- need_full = need_ignoring_dms `unionVarSet` need_from_dms
-
- -- `need`: the Givens from outer scopes that are used in this implication
- -- is_dm_skol: see (TRC5)
- need | is_dm_skol info = ENS { ens_dms = trim ev_binds need_full
- , ens_fvs = emptyVarSet }
- | otherwise = ENS { ens_dms = trim ev_binds need_from_dms
- , ens_fvs = trim ev_binds need_ignoring_dms }
-
- -- Delete dead Given evidence bindings
+ , ic_given = givens
+ , ic_wanted = WC { wc_impl = implics } })
+ = do { ev_binds_state <- TcS.getTcEvBindsState ev_binds_var
+
+ ; let EBS { ebs_binds = ev_binds, ebs_needs = local_needs } = ev_binds_state
+
+ -- Gather the raw needed EvIds, from the
+ -- current evidence bindings `local_needs`, and the `implics`
+ (need_dm, need_non_dm) = foldr add_implic (emptyVarSet, local_needs) implics
+
+ -- Do transitive closure through the evidence bindings
+ -- and delete all EvIds bound by the bindings
+ need_dm1 = findNeededGivenEvVars ev_binds need_dm
+ need_non_dm1 = findNeededGivenEvVars ev_binds need_non_dm
+
+ -- Compute the redundant Givens
+ dead_givens = findRedundantGivens info need_non_dm1 givens
+
+ -- Delete variables bound by ev_binds or by givens
+ need_dm2 = trim_needs need_dm1
+ need_non_dm2 = trim_needs need_non_dm1
+
+ trim_needs :: NeededEvIds -> NeededEvIds
+ trim_needs needs = (needs `varSetMinusEvBindsMap` ev_binds)
+ `delVarSetList` givens
+
+ -- Prune dead Given evidence bindings
-- See Note [Delete dead Given evidence bindings]
- ; let live_ev_binds = filterEvBindMap (needed_ev_bind need_full) ev_binds
- ; TcS.setTcEvBindsMap ev_binds_var live_ev_binds
-
- ; traceTcS "neededEvVars" $
- vcat [ text "old_need_implic:" <+> ppr old_need_implic
- , text "new_need_implic:" <+> ppr new_need_implic
- , text "used_covars:" <+> ppr used_covars
- , text "need_ignoring_dms:" <+> ppr need_ignoring_dms
- , text "need_from_dms:" <+> ppr need_from_dms
- , text "need:" <+> ppr need
+ ; let need_full = need_dm1 `unionVarSet` need_non_dm1
+ pruned_ev_binds = filterEvBindsMap (keep_ev_bind need_full) ev_binds
+ ; TcS.setTcEvBindsMap ev_binds_var pruned_ev_binds
+
+ ; traceTcS "computeSolvedStatus" $
+ vcat [ text "local_needs:" <+> ppr local_needs
+ , text "need_dm:" <+> ppr need_dm
+ , text "need_non_dm:" <+> ppr need_non_dm
+ , text "need_dm1:" <+> ppr need_dm1
+ , text "need_non_dm1:" <+> ppr need_non_dm1
+ , text "need_dm2:" <+> ppr need_dm2
+ , text "need_non_dm2:" <+> ppr need_non_dm2
, text "ev_binds:" <+> ppr ev_binds
- , text "live_ev_binds:" <+> ppr live_ev_binds ]
- ; return (implic { ic_need = need
- , ic_need_implic = new_need_implic }) }
- where
- trim :: EvBindMap -> VarSet -> VarSet
- -- Delete variables bound by Givens or bindings
- trim ev_binds needs = needs `varSetMinusEvBindMap` ev_binds
+ , text "deleted ev_binds:"
+ <+> ppr (filterEvBindsMap (not . keep_ev_bind need_full) ev_binds) ]
+
+ ; if is_dm_skol info
+ then return (IC_Solved { ics_dead = dead_givens
+ , ics_dm = need_dm2 `unionVarSet` need_non_dm2
+ , ics_non_dm = emptyVarSet })
- add_implic :: Implication -> EvNeedSet -> EvNeedSet
- add_implic (Implic { ic_given = givens, ic_need = need }) acc
- = (need `delGivensFromEvNeedSet` givens) `unionEvNeedSet` acc
+ else return (IC_Solved { ics_dead = dead_givens
+ , ics_dm = need_dm2
+ , ics_non_dm = need_non_dm2 }) }
+ where
+ add_implic :: Implication -> (NeededEvIds, NeededEvIds) -> (NeededEvIds, NeededEvIds)
+ add_implic (Implic { ic_status = status}) (dm2, non_dm2)
+ | IC_Solved { ics_dm = dm1, ics_non_dm = non_dm1 } <- status
+ = (dm1 `unionVarSet` dm2, non_dm1 `unionVarSet` non_dm2)
+ | otherwise
+ = pprPanic "computeSolvedStatus" (ppr implics)
- needed_ev_bind needed (EvBind { eb_lhs = ev_var, eb_info = info })
+ keep_ev_bind :: NeededEvIds -> EvBind -> Bool
+ -- False => we can discard this unused Given evidence binding
+ -- We always keep all the Wanted bindings
+ keep_ev_bind needed (EvBind { eb_lhs = ev_var, eb_info = info })
| EvBindGiven{} <- info = ev_var `elemVarSet` needed
| otherwise = True -- Keep all wanted bindings
- add_wanted :: EvBind -> VarSet -> VarSet
- add_wanted (EvBind { eb_info = info, eb_rhs = rhs }) needs
- | EvBindGiven{} <- info = needs -- Add the rhs vars of the Wanted bindings only
- | otherwise = nestedEvIdsOfTerm rhs `unionVarSet` needs
-
is_dm_skol :: SkolemInfoAnon -> Bool
is_dm_skol (MethSkol _ is_dm) = is_dm
is_dm_skol _ = False
-findNeededGivenEvVars :: EvBindMap -> VarSet -> VarSet
+findRedundantGivens :: SkolemInfoAnon -> NeededEvIds -> [EvVar] -> [EvVar]
+findRedundantGivens info need givens
+ | not (warnRedundantGivens info) -- Don't report redundant constraints at all
+ = [] -- See (TRC4) of Note [Tracking needed EvIds]
+
+ | not (null unused_givens) -- Some givens are literally unused
+ = unused_givens
+
+ -- Only try this if unused_givens is empty: see (TRC2a)
+ | otherwise -- All givens are used, but some might
+ = redundant_givens -- still be redundant e.g. (Eq a, Ord a)
+
+ where
+ in_instance_decl = case info of { InstSkol {} -> True; _ -> False }
+ -- See Note [Redundant constraints in instance decls]
+
+ unused_givens = filterOut is_used givens
+
+ is_used given = is_type_error given
+ || given `elemVarSet` need
+ || (in_instance_decl && is_improving (idType given))
+
+ minimal_givens = mkMinimalBySCs evVarPred givens -- See (TRC2)
+
+ is_minimal = (`elemVarSet` mkVarSet minimal_givens)
+ redundant_givens
+ | in_instance_decl = []
+ | otherwise = filterOut is_minimal givens
+
+ -- See #15232
+ is_type_error id = containsUserTypeError False (idType id)
+ -- False <=> do not look under ty-fam apps, AppTy etc.
+ -- See (UTE1) in Note [Custom type errors in constraints].
+
+ is_improving pred -- (transSuperClasses p) does not include p
+ = any isImprovementPred (pred : transSuperClasses pred)
+
+findNeededGivenEvVars :: EvBindsMap -> NeededEvIds -> NeededEvIds
-- Find all the Given evidence needed by seeds,
-- looking transitively through bindings for Givens (only)
findNeededGivenEvVars ev_binds seeds
= transCloVarSet also_needs seeds
where
- also_needs :: VarSet -> VarSet
- also_needs needs = nonDetStrictFoldUniqSet add emptyVarSet needs
- -- It's OK to use a non-deterministic fold here because we immediately
- -- forget about the ordering by creating a set
-
- add :: Var -> VarSet -> VarSet
- add v needs
- | Just ev_bind <- lookupEvBind ev_binds v
- , EvBind { eb_info = EvBindGiven, eb_rhs = rhs } <- ev_bind
- -- Look at Given bindings only
- = nestedEvIdsOfTerm rhs `unionVarSet` needs
- | otherwise
- = needs
+ also_needs :: VarSet -> VarSet
+ also_needs needs = nonDetStrictFoldUniqSet add emptyVarSet needs
+ -- It's OK to use a non-deterministic fold here because we immediately
+ -- forget about the ordering by creating a set
+
+ add :: Var -> VarSet -> VarSet
+ add v needs
+ | Just ev_bind <- lookupEvBind ev_binds v
+ , EvBind { eb_info = EvBindGiven, eb_rhs = rhs } <- ev_bind
+ -- Look at Given bindings only
+ = nestedEvIdsOfTerm rhs `unionVarSet` needs
+ | otherwise
+ = needs
-------------------------------------------------
simplifyDelayedErrors :: Bag DelayedError -> TcS (Bag DelayedError)
@@ -837,26 +822,80 @@ from TypeHole in HoleSort.
See also Note [Extra-constraint holes in partial type signatures]
in GHC.Tc.Gen.HsType.
-Note [Tracking redundant constraints]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-With Opt_WarnRedundantConstraints, GHC can report which constraints of a type
-signature (or instance declaration) are redundant, and can be omitted. Here is
-an overview of how it works.
+Note [Tracking needed EvIds]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The solver has some careful footwork to track:
+
+ Which Given EvIds are in fact needed
+
+The relevant type is NeededEvIds, which is just a VarSet; it may be a mixture
+of DictIds and CoVars.
+
+The NeededEvIds are used for two related purposes:
-This is all tested in typecheck/should_compile/T20602 (among others).
+* Redundant Givens. With Opt_WarnRedundantConstraints, GHC can report which
+ constraints of a type signature (or instance declaration) are redundant, and
+ can be omitted. We report this by computing which of the Implication's
+ `ic_givens` are not in the `NeededIds` for that Implication.
-How tracking works:
+ See `findRedundantGivens`
-* We maintain the `ic_need` field in an implication:
- ic_need: the set of Given evidence variables that are needed somewhere
- inside this implication; and are bound either by this implication
- or by an enclosing one.
+* Pruning useless evidence bindings. The solver creates lots of superclass
+ bindings, in the EvBinds of an Implication, just in case they are needed. So
+ we might get
+ \ (d::Ord a). let d2:Eq a = sc_sel d in ...
+ That `d2` binding may or may not be needed. For fully-solved implications,
+ GHC prunes away the un-needed bindings simply to reduce clutter; less to zonk,
+ less to desugar etc.
-* `setImplicationStatus` does all the work:
- - When the constraint solver finishes solving all the wanteds in
- an implication, it sets its status to IC_Solved
+ See Note [Delete dead Given evidence bindings]
+ and the pruning code in `computeSolvedStatus`
+
+The tracking works like this:
+
+* An `Implication` has `ic_binds :: EvBindVar`.
+
+* That EvBindsVar holds a mutable reference to an `EvBindsState`.
+
+* That `EvBindsState` is a pair of
+ * ebs_binds :: EvBindsMap The evidence bindings themselves
+ * ebs_needs :: NeededEvIds The free EvIds of the Wanted `ebs_binds`
+ NB: only the Wanted ones!
+
+ When we add a new binding to `ebs_binds` we also add to `ebs_needs` the free
+ EvIds of the RHS, iff the binding is Wanted. Why Wanted only? Each Wanted
+ binding solves a Wanted constraint, so we want them all. But Given bindings
+ are speculative; we work them out in `findNeededGivenEvVars`.
+
+ See `GHC.Tc.Utils.Monad.addTcEvBind` and `addTcCoBind`
+
+* When an implication is fully Solved, we give it an `ic_status` of IC_Solved,
+ in `setImplicationStatus`:
+ data ImplicStatus
+ = ...
+ | IC_Solved { ics_dead :: [EvVar]
+ , ics_dm :: NeededEvIds
+ , ics_non_dm :: NeededEvIds }
+ The `ics_dead` field records the `ic_given` EvVars that are unused.
+ The other two fields record the NeededEvIds bound by /enclosing/ Implications;
+ that is, the `ic_given` from /this/ implication have been removed.
+
+ Why two fields? See (TRC5) below.
+
+* `computeSolvedStatus` does all the work of computing these fields.
+
+ - It combines the NeededEvIds from the sub-implications, plus
+ those from the bindings.
+
+ - It uses a transitive closure algorithm across the Given bindings
+ so find the transitive needs. E.g. suppose the bindings are
+ [G] d2 = sc_sel d1
+ [G] d3 = sc_sel d2
+ [W] w1 = d3
+ The `ebs_needs` for these bindings will be {d3} (free var of the RHS
+ of the Wanted bindings). But needing d3 needs d2 and needing d2 needs
+ d1. Hence the transitive closure in `findNeededGivenEvVars`.
- - `neededEvVars`: computes which evidence variables are needed by an
implication in `setImplicationStatus`. A variable is needed if
a) It is in the ic_need field of this implication, computed in
@@ -884,15 +923,13 @@ How tracking works:
Wrinkles:
-(TRC1) `pruneImplications` drops any sub-implications of an Implication
- that are irrelevant for error reporting:
- - no unsolved wanteds
- - no sub-implications
- - no redundant givens to report
- But in doing so we must not lose track of the variables that those implications
- needed! So we track the ic_needs of all child implications in `ic_need_implics`.
- Crucially, this set includes things need by child implications that have been
- discarded by `pruneImplications`.
+(TRC1) In `setImplicationStatus`, for a fully-solved Implication, we take
+ the opportunity to discard any fully-solved child implications, using
+ `pruneImplications`. We can't drop /all/ fully-solved children; we can
+ drop a sub-implication only if:
+ - it has empty `ics_dead` (if not, keep the Implication so we can report the
+ redundant givens later
+ - it itself has no sub-implications (presumably with redundant givens)
(TRC2) A Given can be redundant because it is implied by other Givens
f :: (Eq a, Ord a) => blah -- Eq a unnecessary
@@ -914,6 +951,7 @@ Wrinkles:
the one from the user-written Eq a, not the superclass selection. This means
we report the Ord a as redundant with -Wredundant-constraints, not the Eq a.
Getting this wrong was #20602.
+ See Note [Replacement vs keeping] in GHC.Tc.Solver.InertSet
(TRC4) We don't compute redundant givens for *every* implication; only
for those which reply True to `warnRedundantGivens`:
@@ -949,7 +987,7 @@ Wrinkles:
and because of the degnerate instance for `Show (T a)`, we don't need the `Eq a`
constraint. But we don't want to report it as redundant!
-(TRC5) Consider this (#25992), where `op2` has a default method
+(TRC5) Default methods. Consider this (#25992), where `op2` has a default method
class C a where { op1, op2 :: a -> a
; op2 = op1 . op1 }
instance C a => C [a] where
@@ -960,17 +998,22 @@ Wrinkles:
$dmop2 = op1 . op1
$fCList :: forall a. C a => C [a]
- $fCList @a (d::C a) = MkC (\(x:a).x) ($dmop2 @a d)
+ $fCList @a (d::C a) = MkC (\(x:a).x)
+ ($dmop2 @[a] ($fCList @a d))
+
+ Notice that `d` gets passed (indirectly) to `$dmop`: it appears to be
+ "needed". But it's only /really/ needed if some /other/ method or
+ superclass (in this case `op1`) uses it.
- Notice that `d` gets passed to `$dmop`: it is "needed". But it's only
- /really/ needed if some /other/ method (in this case `op1`) uses it.
+ So, in IC_Solved rather than one set of NeededEvIds we have /two/:
+ ics_dm: needed /only/ by default-method calls
+ ics_non_dm: needed by something other than a default-method call
+ Then:
+ - For tracking redundant Givens we use only ics_non_dm
+ - For pruning evidence bindings we use the union of the two
- So, rather than one set of "needed Givens" we use `EvNeedSet` to track
- a /pair/ of sets:
- ens_dms: needed /only/ by default-method calls
- ens_fvs: needed by something other than a default-method call
It's a bit of a palaver, but not really difficult.
- All the logic is localised in `neededEvVars`.
+ All the logic is localised in `computeSolvedStatus`.
But NOTE that this only applies to /vanilla/ default methods.
For /generic/ default methods, like
@@ -979,26 +1022,26 @@ Wrinkles:
the (Eq a) constraint really is needed (e.g. class NFData and #25992).
Hence the `Bool` field of `MethSkol` indicates a /vanilla/ default method.
------ Examples
+----- Examples of reporting redundant Givens
f, g, h :: (Eq a, Ord a) => a -> Bool
f x = x == x
g x = x > x
h x = x == x && x > x
- All of f,g,h will discover that they have two [G] Eq a constraints: one as
- given and one extracted from the Ord a constraint. They will both discard
- the latter; see (TRC3).
+All of f,g,h will discover that they have two [G] Eq a constraints: one as
+given and one extracted from the Ord a constraint. They will both discard
+the latter; see (TRC3).
- The body of f uses the [G] Eq a, but not the [G] Ord a. It will report a
- redundant Ord a.
+* The body of f uses the [G] Eq a, but not the [G] Ord a. It will report a
+ redundant Ord a.
- The body of g uses the [G] Ord a, but not the [G] Eq a. It will report a
- redundant Eq a.
+* The body of g uses the [G] Ord a, but not the [G] Eq a. It will report a
+ redundant Eq a.
- The body of h uses both [G] Ord a and [G] Eq a; each is used in a solved
- Wanted evidence binding. But (TRC2) kicks in and discovers the Eq a
- is redundant.
+* The body of h uses both [G] Ord a and [G] Eq a; each is used in a solved
+ Wanted evidence binding. But (TRC2) kicks in and discovers the Eq a
+ is redundant.
----- Shortcomings
@@ -1010,10 +1053,10 @@ Shortcoming 1. Consider
k :: (Eq a, b ~ a) => a -> Bool
k x = x == x
-Currently (Nov 2021), j issues no warning, while k says that b ~ a
-is redundant. This is because j uses the a ~ b constraint to rewrite
-everything to be in terms of b, while k does none of that. This is
-ridiculous, but I (Richard E) don't see a good fix.
+Currently (Nov 2021), j issues no warning, while k says that b ~ a is
+redundant. This is because j uses the a ~ b constraint to rewrite everything to
+be in terms of b, while k does none of that. This is ridiculous, but I (Richard
+E) don't see a good fix.
Shortcoming 2. Removing a redundant constraint can cause clients to fail to
compile, by making the function more polymorphic. Consider (#16154)
@@ -1645,10 +1688,12 @@ solveWantedQCI mode ct@(CQuantCan (QCI { qci_ev = ev, qci_tvs = tvs
-- carrying a record of which evidence variables are used
-- See Note [Free vars of EvFun] in GHC.Tc.Types.Evidence
do { setWantedDict dest EvCanonical $
- EvFun { et_tvs = skol_tvs, et_given = given_ev_vars
+ EvFun { et_tvs = skol_tvs
+ , et_given = given_ev_vars
, et_binds = TcEvBinds ev_binds_var
- , et_body = wantedCtEvEvId wanted_ev }
+ , et_body = wantedCtEvEvId wanted_ev }
+ ; traceTcS "solveWantedQCI" (ppr imp')
; return (Right imp') }
}
=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -1481,8 +1481,7 @@ Notice that
implication for the whole instance declaration, with the expected
skolems and givens. We need this to get the correct "redundant
constraint" warnings, gathering all the uses from all the methods
- and superclasses. See GHC.Tc.Solver Note [Tracking redundant
- constraints]
+ and superclasses. See GHC.Tc.SolverSolve Note [Tracking needed EvIds]
* The given constraints in the outer implication may generate
evidence, notably by superclass selection. Since the method and
@@ -1947,7 +1946,7 @@ tcMethods _skol_info dfun_id clas tyvars dfun_ev_vars inst_tys
mismatched_meths = bind_nms `minusList` cls_meth_nms
is_vanilla_dm :: DefMethSpec ty -> Bool
- -- See (TRC5) in Note [Tracking redundant constraints]
+ -- See (TRC5) in Note [Tracking needed EvIds]
-- in GHC.Tc.Solver.Solve
is_vanilla_dm VanillaDM = True
is_vanilla_dm (GenericDM {}) = False
@@ -2022,7 +2021,7 @@ Instead, we take the following approach:
------------------------
tcMethodBody :: Bool -- True <=> This is a vanilla default method
- -- See (TRC5) in Note [Tracking redundant constraints]
+ -- See (TRC5) in Note [Tracking needed EvIds]
-- in GHC.Tc.Solver.Solve
-> Class -> [TcTyVar] -> [EvVar] -> [TcType]
-> TcEvBinds -> Bool
=====================================
compiler/GHC/Tc/Types/Constraint.hs
=====================================
@@ -65,7 +65,6 @@ module GHC.Tc.Types.Constraint (
ImplicStatus(..), isInsolubleStatus, isSolvedStatus,
UserGiven, getGivensFromImplics,
HasGivenEqs(..), checkImplicationInvariants,
- EvNeedSet(..), emptyEvNeedSet, unionEvNeedSet, extendEvNeedSet, delGivensFromEvNeedSet,
-- CtLocEnv
CtLocEnv(..), setCtLocEnvLoc, setCtLocEnvLvl, getCtLocEnvLoc, getCtLocEnvLvl, ctLocEnvInGeneratedCode,
@@ -1061,6 +1060,13 @@ mkImplicWC :: Bag Implication -> WantedConstraints
mkImplicWC implic
= emptyWC { wc_impl = implic }
+-- | `isEmptyWC` sees if a `WantedConstraints` is truly empty, including
+-- having no implications.
+--
+-- It's possible that it might have /solved/ implications, which are left around
+-- just so we can report unreachable code. So:
+-- isEmptyWC implies isSolvedWC
+-- but not vice versa
isEmptyWC :: WantedConstraints -> Bool
isEmptyWC (WC { wc_simple = f, wc_impl = i, wc_errors = errors })
= isEmptyBag f && isEmptyBag i && isEmptyBag errors
@@ -1563,45 +1569,9 @@ data Implication
ic_binds :: EvBindsVar, -- Points to the place to fill in the
-- abstraction and bindings.
- -- The ic_need fields keep track of which Given evidence
- -- is used by this implication or its children
- -- See Note [Tracking redundant constraints]
- -- NB: these sets include stuff used by fully-solved nested implications
- -- that have since been discarded
- ic_need :: EvNeedSet, -- All needed Given evidence, from this implication
- -- or outer ones
- -- That is, /after/ deleting the binders of ic_binds,
- -- but /before/ deleting ic_givens
-
- ic_need_implic :: EvNeedSet, -- Union of of the ic_need of all implications in ic_wanted
- -- /including/ any fully-solved implications that have been
- -- discarded by `pruneImplications`. This discarding is why
- -- we need to keep this field in the first place.
-
ic_status :: ImplicStatus
}
-data EvNeedSet = ENS { ens_dms :: VarSet -- Needed only by default methods
- , ens_fvs :: VarSet -- Needed by things /other than/ default methods
- -- See (TRC5) in Note [Tracking redundant constraints]
- }
-
-emptyEvNeedSet :: EvNeedSet
-emptyEvNeedSet = ENS { ens_dms = emptyVarSet, ens_fvs = emptyVarSet }
-
-unionEvNeedSet :: EvNeedSet -> EvNeedSet -> EvNeedSet
-unionEvNeedSet (ENS { ens_dms = dm1, ens_fvs = fv1 })
- (ENS { ens_dms = dm2, ens_fvs = fv2 })
- = ENS { ens_dms = dm1 `unionVarSet` dm2, ens_fvs = fv1 `unionVarSet` fv2 }
-
-extendEvNeedSet :: EvNeedSet -> Var -> EvNeedSet
-extendEvNeedSet ens@(ENS { ens_fvs = fvs }) v = ens { ens_fvs = fvs `extendVarSet` v }
-
-delGivensFromEvNeedSet :: EvNeedSet -> [Var] -> EvNeedSet
-delGivensFromEvNeedSet (ENS { ens_dms = dms, ens_fvs = fvs }) givens
- = ENS { ens_dms = dms `delVarSetList` givens
- , ens_fvs = fvs `delVarSetList` givens }
-
implicationPrototype :: CtLocEnv -> Implication
implicationPrototype ct_loc_env
= Implic { -- These fields must be initialised
@@ -1618,14 +1588,21 @@ implicationPrototype ct_loc_env
, ic_given = []
, ic_wanted = emptyWC
, ic_given_eqs = MaybeGivenEqs
- , ic_status = IC_Unsolved
- , ic_need = emptyEvNeedSet
- , ic_need_implic = emptyEvNeedSet }
+ , ic_status = IC_Unsolved }
data ImplicStatus
= IC_Solved -- All wanteds in the tree are solved, all the way down
- { ics_dead :: [EvVar] } -- Subset of ic_given that are not needed
- -- See Note [Tracking redundant constraints] in GHC.Tc.Solver
+ { ics_dead :: [EvVar] -- Subset of ic_given that are not needed
+
+ , ics_dm :: NeededEvIds -- Enclosing Given EvIds that are needed by
+ -- calls to default methods (typically empty)
+
+ , ics_non_dm :: NeededEvIds -- Enclosing Given EvIds that are needed, other than
+ -- calls to default methods
+ }
+ -- Reporting redundant givens: use ics_non_dm
+ -- Pruning evidence bindings: use ics_dm `union` ics_non_dm
+ -- See Note [Tracking needed EvIds] in GHC.Tc.Solver.Solve
| IC_Insoluble -- At least one insoluble Wanted constraint in the tree
@@ -1714,7 +1691,6 @@ instance Outputable Implication where
, ic_given = given, ic_given_eqs = given_eqs
, ic_wanted = wanted, ic_status = status
, ic_binds = binds
- , ic_need = need, ic_need_implic = need_implic
, ic_info = info })
= hang (text "Implic" <+> lbrace)
2 (sep [ text "TcLevel =" <+> ppr tclvl
@@ -1724,21 +1700,17 @@ instance Outputable Implication where
, hang (text "Given =") 2 (pprEvVars given)
, hang (text "Wanted =") 2 (ppr wanted)
, text "Binds =" <+> ppr binds
- , text "need =" <+> ppr need
- , text "need_implic =" <+> ppr need_implic
, pprSkolInfo info ] <+> rbrace)
-instance Outputable EvNeedSet where
- ppr (ENS { ens_dms = dms, ens_fvs = fvs })
- = text "ENS" <> braces (sep [text "ens_dms =" <+> ppr dms
- , text "ens_fvs =" <+> ppr fvs])
-
instance Outputable ImplicStatus where
ppr IC_Insoluble = text "Insoluble"
ppr IC_BadTelescope = text "Bad telescope"
ppr IC_Unsolved = text "Unsolved"
- ppr (IC_Solved { ics_dead = dead })
- = text "Solved" <+> (braces (text "Dead givens =" <+> ppr dead))
+ ppr (IC_Solved { ics_dead = dead, ics_dm = dm, ics_non_dm = non_dm })
+ = text "Solved" <> (braces $
+ vcat [ text "Dead givens =" <+> ppr dead
+ , text "need_dm =" <+> ppr dm
+ , text "need_non_dm =" <+> ppr non_dm ])
checkTelescopeSkol :: SkolemInfoAnon -> Bool
-- See Note [Checking telescopes]
=====================================
compiler/GHC/Tc/Types/Evidence.hs
=====================================
@@ -14,14 +14,15 @@ module GHC.Tc.Types.Evidence (
optSubTypeHsWrapper,
-- * Evidence bindings
- TcEvBinds(..), EvBindsVar(..),
- EvBindMap(..), emptyEvBindMap, extendEvBinds, unionEvBindMap,
+ TcEvBinds(..), EvBindsVar(..), NeededEvIds,
+ EvBindsState(..), emptyEvBindsState, unionEvBindsState, addNeededEvIdsEBS,
+ EvBindsMap(..), emptyEvBindsMap, extendEvBinds, unionEvBindsMap,
lookupEvBind, evBindMapBinds,
- foldEvBindMap, nonDetStrictFoldEvBindMap,
- filterEvBindMap,
- isEmptyEvBindMap,
+ foldEvBindsMap, nonDetStrictFoldEvBindsMap,
+ filterEvBindsMap,
+ isEmptyEvBindsMap,
evBindMapToVarSet,
- varSetMinusEvBindMap,
+ varSetMinusEvBindsMap,
EvBindInfo(..), EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind,
evBindVar, isCoEvBindsVar,
@@ -725,30 +726,45 @@ data EvBindsVar
ebv_uniq :: Unique,
-- The Unique is for debug printing only
- ebv_binds :: IORef EvBindMap,
+ ebv_binds :: IORef EvBindsState
-- The main payload: the value-level evidence bindings
-- (dictionaries etc)
- -- Some Given, some Wanted
-
- ebv_tcvs :: IORef [TcCoercion]
- -- When we solve a Wanted by filling in a CoercionHole, it is as
- -- if we were adding an evidence binding
- -- co_hole := coercion
- -- We keep all these RHS coercions in a list, alongside `ebv_binds`,
- -- so that we can report unused given constraints,
- -- in GHC.Tc.Solver.neededEvVars
- -- See Note [Tracking redundant constraints] in GHC.Tc.Solver
- -- Also: we garbage-collect unused bindings in `neededEvVars`,
- -- so this matters for correctness too.
+ -- Some Given, some Wanted; this is tracked in the `eb_info`
+ -- field of the `EvBind`.
}
| CoEvBindsVar { -- See Note [Coercion evidence only]
-- See above for comments on ebv_uniq, ebv_tcvs
- ebv_uniq :: Unique,
- ebv_tcvs :: IORef [TcCoercion]
+ ebv_uniq :: Unique,
+ ebv_needs :: IORef NeededEvIds
}
+type NeededEvIds = VarSet
+
+data EvBindsState = EBS { ebs_binds :: EvBindsMap
+ , ebs_needs :: NeededEvIds }
+
+emptyEvBindsState :: EvBindsState
+emptyEvBindsState = EBS { ebs_binds = emptyEvBindsMap
+ , ebs_needs = emptyVarSet }
+
+unionEvBindsState :: EvBindsState -> EvBindsState -> EvBindsState
+unionEvBindsState (EBS { ebs_binds = bs1, ebs_needs = n1 })
+ (EBS { ebs_binds = bs2, ebs_needs = n2 })
+ = EBS { ebs_binds = bs1 `unionEvBindsMap` bs2
+ , ebs_needs = n1 `unionVarSet` n2 }
+
+addNeededEvIdsEBS :: NeededEvIds -> EvBindsState -> EvBindsState
+addNeededEvIdsEBS n1 ebs@(EBS { ebs_needs = n2 })
+ = ebs { ebs_needs = n1 `unionVarSet` n2 }
+
+instance Outputable EvBindsState where
+ ppr (EBS { ebs_binds = bs, ebs_needs = needs })
+ = text "EBS" <> (braces $
+ sep [ text "needs =" <+> ppr needs
+ , text "binds =" <+> ppr bs ])
+
instance Data.Data TcEvBinds where
-- Placeholder; we can't traverse into TcEvBinds
toConstr _ = abstractConstr "TcEvBinds"
@@ -778,8 +794,8 @@ isCoEvBindsVar (CoEvBindsVar {}) = True
isCoEvBindsVar (EvBindsVar {}) = False
-----------------
-newtype EvBindMap
- = EvBindMap {
+newtype EvBindsMap
+ = EvBindsMap {
ev_bind_varenv :: DVarEnv EvBind
} -- Map from evidence variables to evidence terms
-- We use @DVarEnv@ here to get deterministic ordering when we
@@ -801,56 +817,56 @@ newtype EvBindMap
-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why
-- @UniqFM@ can lead to nondeterministic order.
-emptyEvBindMap :: EvBindMap
-emptyEvBindMap = EvBindMap { ev_bind_varenv = emptyDVarEnv }
+emptyEvBindsMap :: EvBindsMap
+emptyEvBindsMap = EvBindsMap { ev_bind_varenv = emptyDVarEnv }
-extendEvBinds :: EvBindMap -> EvBind -> EvBindMap
+extendEvBinds :: EvBindsMap -> EvBind -> EvBindsMap
extendEvBinds bs ev_bind
- = EvBindMap { ev_bind_varenv = extendDVarEnv (ev_bind_varenv bs)
+ = EvBindsMap { ev_bind_varenv = extendDVarEnv (ev_bind_varenv bs)
(eb_lhs ev_bind)
ev_bind }
-- | Union two evidence binding maps
-unionEvBindMap :: EvBindMap -> EvBindMap -> EvBindMap
-unionEvBindMap (EvBindMap env1) (EvBindMap env2) =
- EvBindMap { ev_bind_varenv = plusDVarEnv env1 env2 }
+unionEvBindsMap :: EvBindsMap -> EvBindsMap -> EvBindsMap
+unionEvBindsMap (EvBindsMap env1) (EvBindsMap env2) =
+ EvBindsMap { ev_bind_varenv = plusDVarEnv env1 env2 }
-isEmptyEvBindMap :: EvBindMap -> Bool
-isEmptyEvBindMap (EvBindMap m) = isEmptyDVarEnv m
+isEmptyEvBindsMap :: EvBindsMap -> Bool
+isEmptyEvBindsMap (EvBindsMap m) = isEmptyDVarEnv m
-lookupEvBind :: EvBindMap -> EvVar -> Maybe EvBind
+lookupEvBind :: EvBindsMap -> EvVar -> Maybe EvBind
lookupEvBind bs = lookupDVarEnv (ev_bind_varenv bs)
-evBindMapBinds :: EvBindMap -> Bag EvBind
-evBindMapBinds = foldEvBindMap consBag emptyBag
+evBindMapBinds :: EvBindsMap -> Bag EvBind
+evBindMapBinds = foldEvBindsMap consBag emptyBag
-foldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a
-foldEvBindMap k z bs = foldDVarEnv k z (ev_bind_varenv bs)
+foldEvBindsMap :: (EvBind -> a -> a) -> a -> EvBindsMap -> a
+foldEvBindsMap k z bs = foldDVarEnv k z (ev_bind_varenv bs)
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-nonDetStrictFoldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a
-nonDetStrictFoldEvBindMap k z bs = nonDetStrictFoldDVarEnv k z (ev_bind_varenv bs)
+nonDetStrictFoldEvBindsMap :: (EvBind -> a -> a) -> a -> EvBindsMap -> a
+nonDetStrictFoldEvBindsMap k z bs = nonDetStrictFoldDVarEnv k z (ev_bind_varenv bs)
-filterEvBindMap :: (EvBind -> Bool) -> EvBindMap -> EvBindMap
-filterEvBindMap k (EvBindMap { ev_bind_varenv = env })
- = EvBindMap { ev_bind_varenv = filterDVarEnv k env }
+filterEvBindsMap :: (EvBind -> Bool) -> EvBindsMap -> EvBindsMap
+filterEvBindsMap k (EvBindsMap { ev_bind_varenv = env })
+ = EvBindsMap { ev_bind_varenv = filterDVarEnv k env }
-evBindMapToVarSet :: EvBindMap -> VarSet
-evBindMapToVarSet (EvBindMap dve) = unsafeUFMToUniqSet (mapUFM evBindVar (udfmToUfm dve))
+evBindMapToVarSet :: EvBindsMap -> VarSet
+evBindMapToVarSet (EvBindsMap dve) = unsafeUFMToUniqSet (mapUFM evBindVar (udfmToUfm dve))
-varSetMinusEvBindMap :: VarSet -> EvBindMap -> VarSet
-varSetMinusEvBindMap vs (EvBindMap dve) = vs `uniqSetMinusUDFM` dve
+varSetMinusEvBindsMap :: VarSet -> EvBindsMap -> VarSet
+varSetMinusEvBindsMap vs (EvBindsMap dve) = vs `uniqSetMinusUDFM` dve
-instance Outputable EvBindMap where
- ppr (EvBindMap m) = ppr m
+instance Outputable EvBindsMap where
+ ppr (EvBindsMap m) = ppr m
-data EvBindInfo
- = EvBindGiven { -- See Note [Tracking redundant constraints] in GHC.Tc.Solver
- }
- | EvBindWanted { ebi_canonical :: CanonicalEvidence -- See Note [Desugaring non-canonical evidence]
- }
+data EvBindInfo -- See Note [Tracking needed EvIds] in GHC.Tc.Solver.Solve
+ = EvBindGiven
+ | EvBindWanted
+ { ebi_canonical :: CanonicalEvidence }
+ -- See Note [Desugaring non-canonical evidence]
-----------------
-- All evidence is bound by EvBinds; no side effects
@@ -1334,7 +1350,7 @@ can just squeeze by. Here's how.
* Each EvBindsVar in an et_binds field of an EvFun is /also/ in the
ic_binds field of an Implication
* So we can track usage via the processing for that implication,
- (see Note [Tracking redundant constraints] in GHC.Tc.Solver).
+ (see Note [Tracking needed EvIds] in GHC.Tc.Solver).
We can ignore usage from the EvFun altogether.
* /After/ typechecking `evTermFVs` is used by `GHC.Iface.Ext.Ast`, but by
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -94,7 +94,7 @@ data UserTypeCtxt
-- Also used for types in SPECIALISE pragmas
Name -- Name of the function
ReportRedundantConstraints
- -- See Note [Tracking redundant constraints] in GHC.Tc.Solver
+ -- See Note [Tracking needed EvIds] in GHC.Tc.Solver
-- This field is usually 'WantRCC', but 'NoRCC' for
-- * Record selectors (not important here)
-- * Class and instance methods. Here the code may legitimately
@@ -285,7 +285,7 @@ data SkolemInfoAnon
| MethSkol Name Bool -- Bound by the type of class method op
-- True <=> it's a vanilla default method
-- False <=> it's a user-written, or generic-default, method
- -- See (TRC5) in Note [Tracking redundant constraints]
+ -- See (TRC5) in Note [Tracking needed EvIds]
-- in GHC.Tc.Solver.Solve
| FamInstSkol -- Bound at a family instance decl
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -104,9 +104,10 @@ module GHC.Tc.Utils.Monad(
-- * Type constraints
newTcEvBinds, newNoTcEvBinds, cloneEvBindsVar,
- addTcEvBind, addTcEvBinds, addTopEvBinds,
- getTcEvBindsMap, setTcEvBindsMap, updTcEvBinds,
- getTcEvTyCoVars, chooseUniqueOccTc,
+ addTcEvCoBind, addTcEvBind, addTopEvBinds,
+ getTcEvBindsMap, getTcEvBindsState,
+ setTcEvBindsMap, combineTcEvBinds, addNeededEvIds,
+ chooseUniqueOccTc,
getConstraintVar, setConstraintVar,
emitConstraints, emitSimple, emitSimples,
emitImplication, emitImplications, ensureReflMultiplicityCo,
@@ -118,6 +119,7 @@ module GHC.Tc.Utils.Monad(
getLclTypeEnv, setLclTypeEnv,
traceTcConstraints,
emitNamedTypeHole, IsExtraConstraint(..), emitAnonTypeHole,
+ fillCoercionHole,
-- * Template Haskell context
recordThUse, recordThNeededRuntimeDeps,
@@ -187,12 +189,13 @@ import GHC.Unit.Module.Warnings
import GHC.Unit.Home.PackageTable
import GHC.Core.UsageEnv
-
import GHC.Core.Coercion ( isReflCo )
import GHC.Core.Multiplicity
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Core.Type( mkNumLitTy )
+import GHC.Core.TyCo.Rep( CoercionHole(..) )
+import GHC.Core.TyCo.FVs( coVarsOfCo )
import GHC.Core.TyCon ( TyCon )
import GHC.Driver.Env
@@ -230,6 +233,7 @@ import GHC.Types.SafeHaskell
import GHC.Types.Id
import GHC.Types.TypeEnv
import GHC.Types.Var.Env
+import GHC.Types.Var.Set
import GHC.Types.SrcLoc
import GHC.Types.Name.Env
import GHC.Types.Name.Set
@@ -1661,6 +1665,105 @@ tryTcDiscardingErrs' validate recover_invalid recover_error thing_inside
recover_error
}
+{- Note [Constraints and errors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this (#12124):
+
+ foo :: Maybe Int
+ foo = return (case Left 3 of
+ Left -> 1 -- Hard error here!
+ _ -> 0)
+
+The call to 'return' will generate a (Monad m) wanted constraint; but
+then there'll be "hard error" (i.e. an exception in the TcM monad), from
+the unsaturated Left constructor pattern.
+
+We'll recover in tcPolyBinds, using recoverM. But then the final
+tcSimplifyTop will see that (Monad m) constraint, with 'm' utterly
+un-filled-in, and will emit a misleading error message.
+
+The underlying problem is that an exception interrupts the constraint
+gathering process. Bottom line: if we have an exception, it's best
+simply to discard any gathered constraints. Hence in 'attemptM' we
+capture the constraints in a fresh variable, and only emit them into
+the surrounding context if we exit normally. If an exception is
+raised, simply discard the collected constraints... we have a hard
+error to report. So this capture-the-emit dance isn't as stupid as it
+looks :-).
+
+However suppose we throw an exception inside an invocation of
+captureConstraints, and discard all the constraints. Some of those
+constraints might be "variable out of scope" Hole constraints, and that
+might have been the actual original cause of the exception! For
+example (#12529):
+ f = p @ Int
+Here 'p' is out of scope, so we get an insoluble Hole constraint. But
+the visible type application fails in the monad (throws an exception).
+We must not discard the out-of-scope error.
+
+It's distressingly delicate though:
+
+* If we discard too /many/ constraints we may fail to report the error
+ that led us to interrupt the constraint gathering process.
+
+ One particular example "variable out of scope" Hole constraints. For
+ example (#12529):
+ f = p @ Int
+ Here 'p' is out of scope, so we get an insoluble Hole constraint. But
+ the visible type application fails in the monad (throws an exception).
+ We must not discard the out-of-scope error.
+
+ Also GHC.Tc.Solver.simplifyAndEmitFlatConstraints may fail having
+ emitted some constraints with skolem-escape problems.
+
+* If we discard too /few/ constraints, we may get the misleading
+ class constraints mentioned above.
+
+ We may /also/ end up taking constraints built at some inner level, and
+ emitting them (via the exception catching in `tryCaptureConstraints`) at some
+ outer level, and then breaking the TcLevel invariants See Note [TcLevel
+ invariants] in GHC.Tc.Utils.TcType
+
+So `dropMisleading` has a horridly ad-hoc structure:
+
+* It keeps only /insoluble/ flat constraints (which are unlikely to very visibly
+ trip up on the TcLevel invariant)
+
+* But it keeps all /implication/ constraints (except the class constraints
+ inside them). The implication constraints are OK because they set the ambient
+ level before attempting to solve any inner constraints.
+
+Ugh! I hate this. But it seems to work.
+
+Other wrinkles
+
+(CERR1) Note that freshly-generated constraints like (Int ~ Bool), or
+ ((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as
+ insoluble. The constraint solver does that. So they'll be discarded.
+ That's probably ok; but see th/5358 as a not-so-good example:
+ t1 :: Int
+ t1 x = x -- Manifestly wrong
+
+ foo = $(...raises exception...)
+ We report the exception, but not the bug in t1. Oh well. Possible
+ solution: make GHC.Tc.Utils.Unify.uType spot manifestly-insoluble constraints.
+
+(CERR2) In #26015 I found that from the constraints
+ [W] alpha ~ Int -- A class constraint
+ [W] F alpha ~# Bool -- An equality constraint
+ we were dropping the first (because it's a class constraint) but not the
+ second, and then getting a misleading error message from the second. As
+ #25607 shows, we can get not just one but a zillion bogus messages, which
+ conceal the one genuine error. Boo.
+
+ For now I have added an even more ad-hoc "drop class constraints except
+ equality classes (~) and (~~)"; see `dropMisleading`. That just kicks the can
+ down the road; but this problem seems somewhat rare anyway. The code in
+ `dropMisleading` hasn't changed for years.
+
+It would be great to have a more systematic solution to this entire mess.
+-}
+
{-
************************************************************************
* *
@@ -1855,108 +1958,113 @@ debugTc thing
addTopEvBinds :: Bag EvBind -> TcM a -> TcM a
addTopEvBinds new_ev_binds thing_inside
- =updGblEnv upd_env thing_inside
+ = updGblEnv upd_env thing_inside
where
upd_env tcg_env = tcg_env { tcg_ev_binds = tcg_ev_binds tcg_env
`unionBags` new_ev_binds }
newTcEvBinds :: TcM EvBindsVar
-newTcEvBinds = do { binds_ref <- newTcRef emptyEvBindMap
- ; tcvs_ref <- newTcRef []
+newTcEvBinds = do { binds_ref <- newTcRef emptyEvBindsState
; uniq <- newUnique
; traceTc "newTcEvBinds" (text "unique =" <+> ppr uniq)
; return (EvBindsVar { ebv_binds = binds_ref
- , ebv_tcvs = tcvs_ref
, ebv_uniq = uniq }) }
-- | Creates an EvBindsVar incapable of holding any bindings. It still
--- tracks covar usages (see comments on ebv_tcvs in "GHC.Tc.Types.Evidence"), thus
+-- tracks covar usages (see comments on ebv_needs in "GHC.Tc.Types.Evidence"), thus
-- must be made monadically
newNoTcEvBinds :: TcM EvBindsVar
newNoTcEvBinds
- = do { tcvs_ref <- newTcRef []
+ = do { tcvs_ref <- newTcRef emptyVarSet
; uniq <- newUnique
; traceTc "newNoTcEvBinds" (text "unique =" <+> ppr uniq)
- ; return (CoEvBindsVar { ebv_tcvs = tcvs_ref
- , ebv_uniq = uniq }) }
+ ; return (CoEvBindsVar { ebv_needs = tcvs_ref
+ , ebv_uniq = uniq }) }
cloneEvBindsVar :: EvBindsVar -> TcM EvBindsVar
-- Clone the refs, so that any binding created when
-- solving don't pollute the original
cloneEvBindsVar ebv@(EvBindsVar {})
- = do { binds_ref <- newTcRef emptyEvBindMap
- ; tcvs_ref <- newTcRef []
- ; return (ebv { ebv_binds = binds_ref
- , ebv_tcvs = tcvs_ref }) }
+ = do { binds_ref <- newTcRef emptyEvBindsState
+ ; uniq <- newUnique
+ ; return (ebv { ebv_uniq = uniq
+ , ebv_binds = binds_ref }) }
cloneEvBindsVar ebv@(CoEvBindsVar {})
- = do { tcvs_ref <- newTcRef []
- ; return (ebv { ebv_tcvs = tcvs_ref }) }
+ = do { tcvs_ref <- newTcRef emptyVarSet
+ ; return (ebv { ebv_needs = tcvs_ref }) }
-getTcEvTyCoVars :: EvBindsVar -> TcM [TcCoercion]
-getTcEvTyCoVars ev_binds_var
- = readTcRef (ebv_tcvs ev_binds_var)
+getTcEvBindsMap :: EvBindsVar -> TcM EvBindsMap
+getTcEvBindsMap ebv = do { EBS { ebs_binds = bs } <- getTcEvBindsState ebv
+ ; return bs }
-getTcEvBindsMap :: EvBindsVar -> TcM EvBindMap
-getTcEvBindsMap (EvBindsVar { ebv_binds = ev_ref })
+getTcEvBindsState :: EvBindsVar -> TcM EvBindsState
+getTcEvBindsState (EvBindsVar { ebv_binds = ev_ref })
= readTcRef ev_ref
-getTcEvBindsMap (CoEvBindsVar {})
- = return emptyEvBindMap
-
-setTcEvBindsMap :: EvBindsVar -> EvBindMap -> TcM ()
-setTcEvBindsMap (EvBindsVar { ebv_binds = ev_ref }) binds
- = writeTcRef ev_ref binds
-setTcEvBindsMap v@(CoEvBindsVar {}) ev_binds
- | isEmptyEvBindMap ev_binds
- = return ()
- | otherwise
- = pprPanic "setTcEvBindsMap" (ppr v $$ ppr ev_binds)
-
-updTcEvBinds :: EvBindsVar -> EvBindsVar -> TcM ()
-updTcEvBinds (EvBindsVar { ebv_binds = old_ebv_ref, ebv_tcvs = old_tcv_ref })
- (EvBindsVar { ebv_binds = new_ebv_ref, ebv_tcvs = new_tcv_ref })
+getTcEvBindsState (CoEvBindsVar { ebv_needs = needs_ref })
+ = do { needs <- readTcRef needs_ref
+ ; return (EBS { ebs_binds = emptyEvBindsMap, ebs_needs = needs }) }
+
+setTcEvBindsMap :: EvBindsVar -> EvBindsMap -> TcM ()
+setTcEvBindsMap (EvBindsVar { ebv_binds = ev_ref }) ev_binds
+ = updTcRef ev_ref (\ebs -> ebs { ebs_binds = ev_binds })
+setTcEvBindsMap (CoEvBindsVar {}) ev_binds
+ = assertPpr (isEmptyEvBindsMap ev_binds) (ppr ev_binds) $
+ return ()
+
+combineTcEvBinds :: EvBindsVar -> EvBindsVar -> TcM ()
+combineTcEvBinds (EvBindsVar { ebv_binds = old_ebv_ref })
+ (EvBindsVar { ebv_binds = new_ebv_ref })
= do { new_ebvs <- readTcRef new_ebv_ref
- ; updTcRef old_ebv_ref (`unionEvBindMap` new_ebvs)
- ; new_tcvs <- readTcRef new_tcv_ref
- ; updTcRef old_tcv_ref (new_tcvs ++) }
-updTcEvBinds (EvBindsVar { ebv_tcvs = old_tcv_ref })
- (CoEvBindsVar { ebv_tcvs = new_tcv_ref })
+ ; updTcRef old_ebv_ref (`unionEvBindsState` new_ebvs) }
+combineTcEvBinds (EvBindsVar { ebv_binds = old_tcv_ref })
+ (CoEvBindsVar { ebv_needs = new_tcv_ref })
= do { new_tcvs <- readTcRef new_tcv_ref
- ; updTcRef old_tcv_ref (new_tcvs ++) }
-updTcEvBinds (CoEvBindsVar { ebv_tcvs = old_tcv_ref })
- (CoEvBindsVar { ebv_tcvs = new_tcv_ref })
+ ; updTcRef old_tcv_ref (addNeededEvIdsEBS new_tcvs) }
+combineTcEvBinds (CoEvBindsVar { ebv_needs = old_tcv_ref })
+ (CoEvBindsVar { ebv_needs = new_tcv_ref })
= do { new_tcvs <- readTcRef new_tcv_ref
- ; updTcRef old_tcv_ref (new_tcvs ++) }
-updTcEvBinds old_var new_var
- = pprPanic "updTcEvBinds" (ppr old_var $$ ppr new_var)
+ ; updTcRef old_tcv_ref (unionVarSet new_tcvs) }
+combineTcEvBinds old_var new_var
+ = pprPanic "combineTcEvBinds" (ppr old_var $$ ppr new_var)
-- Terms inside types, no good
+addNeededEvIds :: EvBindsVar -> NeededEvIds -> TcM ()
+addNeededEvIds (EvBindsVar { ebv_binds = bs_ref }) needed
+ = updTcRef bs_ref (addNeededEvIdsEBS needed)
+addNeededEvIds (CoEvBindsVar { ebv_needs = need_ref }) needed
+ = updTcRef need_ref (unionVarSet needed)
+
+addTcEvCoBind :: EvBindsVar -> CoercionHole -> CoercionPlusHoles -> TcM ()
+addTcEvCoBind ebv hole co_plus_holes@(CPH { cph_co = co })
+ = do { fillCoercionHole hole co_plus_holes
+ -- Record usage of the free vars of this coercion
+ ; addNeededEvIds ebv (coVarsOfCo co) }
+
addTcEvBind :: EvBindsVar -> EvBind -> TcM ()
-- Add a binding to the TcEvBinds by side effect
-addTcEvBind (EvBindsVar { ebv_binds = ev_ref, ebv_uniq = u }) ev_bind
- = do { bnds <- readTcRef ev_ref
- ; let bnds' = extendEvBinds bnds ev_bind
+addTcEvBind (EvBindsVar { ebv_binds = ev_ref, ebv_uniq = u })
+ ev_bind@(EvBind { eb_info = info, eb_rhs = rhs })
+ = do { EBS { ebs_binds = bnds, ebs_needs = needs } <- readTcRef ev_ref
+ ; let bnds' = extendEvBinds bnds ev_bind
+ needs' = case info of
+ EvBindWanted {} -> nestedEvIdsOfTerm rhs
+ `unionVarSet` needs
+ EvBindGiven {} -> needs
+
; traceTc "addTcEvBind" $
vcat [ text "EvBindsVar:" <+> ppr u
, text "ev_bind:" <+> ppr ev_bind
, text "bnds:" <+> ppr bnds
- , text "bnds':" <+> ppr bnds' ]
- ; writeTcRef ev_ref bnds' }
+ , text "bnds':" <+> ppr bnds'
+ , text "needs" <+> ppr needs
+ , text "needs'" <+> ppr needs' ]
+
+ ; writeTcRef ev_ref $
+ EBS { ebs_binds = bnds', ebs_needs = needs' } }
+
addTcEvBind (CoEvBindsVar { ebv_uniq = u }) ev_bind
= pprPanic "addTcEvBind CoEvBindsVar" (ppr ev_bind $$ ppr u)
-addTcEvBinds :: EvBindsVar -> EvBindMap -> TcM ()
--- ^ Add a collection of binding to the TcEvBinds by side effect
-addTcEvBinds _ new_ev_binds
- | isEmptyEvBindMap new_ev_binds
- = return ()
-addTcEvBinds (EvBindsVar { ebv_binds = ev_ref, ebv_uniq = u }) new_ev_binds
- = do { traceTc "addTcEvBinds" $ ppr u $$
- ppr new_ev_binds
- ; old_bnds <- readTcRef ev_ref
- ; writeTcRef ev_ref (old_bnds `unionEvBindMap` new_ev_binds) }
-addTcEvBinds (CoEvBindsVar { ebv_uniq = u }) new_ev_binds
- = pprPanic "addTcEvBinds CoEvBindsVar" (ppr new_ev_binds $$ ppr u)
-
chooseUniqueOccTc :: (OccSet -> OccName) -> TcM OccName
chooseUniqueOccTc fn =
do { env <- getGblEnv
@@ -2138,111 +2246,22 @@ emitNamedTypeHole (name, tv)
where
occ = nameOccName name
-{- Note [Constraints and errors]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider this (#12124):
-
- foo :: Maybe Int
- foo = return (case Left 3 of
- Left -> 1 -- Hard error here!
- _ -> 0)
-
-The call to 'return' will generate a (Monad m) wanted constraint; but
-then there'll be "hard error" (i.e. an exception in the TcM monad), from
-the unsaturated Left constructor pattern.
-
-We'll recover in tcPolyBinds, using recoverM. But then the final
-tcSimplifyTop will see that (Monad m) constraint, with 'm' utterly
-un-filled-in, and will emit a misleading error message.
-
-The underlying problem is that an exception interrupts the constraint
-gathering process. Bottom line: if we have an exception, it's best
-simply to discard any gathered constraints. Hence in 'attemptM' we
-capture the constraints in a fresh variable, and only emit them into
-the surrounding context if we exit normally. If an exception is
-raised, simply discard the collected constraints... we have a hard
-error to report. So this capture-the-emit dance isn't as stupid as it
-looks :-).
-
-However suppose we throw an exception inside an invocation of
-captureConstraints, and discard all the constraints. Some of those
-constraints might be "variable out of scope" Hole constraints, and that
-might have been the actual original cause of the exception! For
-example (#12529):
- f = p @ Int
-Here 'p' is out of scope, so we get an insoluble Hole constraint. But
-the visible type application fails in the monad (throws an exception).
-We must not discard the out-of-scope error.
-
-It's distressingly delicate though:
+-- | Put a value in a coercion hole
+fillCoercionHole :: CoercionHole -> CoercionPlusHoles -> TcM ()
+fillCoercionHole (CH { ch_ref = ref, ch_co_var = cv }) co
+ = do { when debugIsOn $
+ do { cts <- readTcRef ref
+ ; whenIsJust cts $ \old_co ->
+ pprPanic "Filling a filled coercion hole" (ppr cv $$ ppr co $$ ppr old_co) }
+ ; traceTc "Filling coercion hole" (ppr cv <+> text ":=" <+> ppr co)
+ ; writeTcRef ref (Just co) }
-* If we discard too /many/ constraints we may fail to report the error
- that led us to interrupt the constraint gathering process.
- One particular example "variable out of scope" Hole constraints. For
- example (#12529):
- f = p @ Int
- Here 'p' is out of scope, so we get an insoluble Hole constraint. But
- the visible type application fails in the monad (throws an exception).
- We must not discard the out-of-scope error.
-
- Also GHC.Tc.Solver.simplifyAndEmitFlatConstraints may fail having
- emitted some constraints with skolem-escape problems.
-
-* If we discard too /few/ constraints, we may get the misleading
- class constraints mentioned above.
-
- We may /also/ end up taking constraints built at some inner level, and
- emitting them (via the exception catching in `tryCaptureConstraints` at some
- outer level, and then breaking the TcLevel invariants See Note [TcLevel
- invariants] in GHC.Tc.Utils.TcType
-
-So `dropMisleading` has a horridly ad-hoc structure:
-
-* It keeps only /insoluble/ flat constraints (which are unlikely to very visibly
- trip up on the TcLevel invariant
-
-* But it keeps all /implication/ constraints (except the class constraints
- inside them). The implication constraints are OK because they set the ambient
- level before attempting to solve any inner constraints.
-
-Ugh! I hate this. But it seems to work.
-
-Other wrinkles
-
-(CERR1) Note that freshly-generated constraints like (Int ~ Bool), or
- ((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as
- insoluble. The constraint solver does that. So they'll be discarded.
- That's probably ok; but see th/5358 as a not-so-good example:
- t1 :: Int
- t1 x = x -- Manifestly wrong
-
- foo = $(...raises exception...)
- We report the exception, but not the bug in t1. Oh well. Possible
- solution: make GHC.Tc.Utils.Unify.uType spot manifestly-insoluble constraints.
-
-(CERR2) In #26015 I found that from the constraints
- [W] alpha ~ Int -- A class constraint
- [W] F alpha ~# Bool -- An equality constraint
- we were dropping the first (becuase it's a class constraint) but not the
- second, and then getting a misleading error message from the second. As
- #25607 shows, we can get not just one but a zillion bogus messages, which
- conceal the one genuine error. Boo.
-
- For now I have added an even more ad-hoc "drop class constraints except
- equality classes (~) and (~~)"; see `dropMisleading`. That just kicks the can
- down the road; but this problem seems somewhat rare anyway. The code in
- `dropMisleading` hasn't changed for years.
-
-It would be great to have a more systematic solution to this entire mess.
-
-
-************************************************************************
+{- *********************************************************************
* *
Template Haskell context
* *
-************************************************************************
--}
+********************************************************************* -}
recordThUse :: TcM ()
recordThUse = do { env <- getGblEnv; writeTcRef (tcg_th_used env) True }
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -341,31 +341,13 @@ newImplication
(implicationPrototype (mkCtLocEnv env))
{ ic_warn_inaccessible = warn_inaccessible && not in_gen_code }
-{-
-************************************************************************
-* *
- Coercion holes
-* *
-************************************************************************
--}
-
newCoercionHole :: TcPredType -> TcM CoercionHole
-- For the Bool, see (EIK2) in Note [Equalities with heterogeneous kinds]
newCoercionHole pred_ty
= do { co_var <- newEvVar pred_ty
; traceTc "New coercion hole:" (ppr co_var <+> dcolon <+> ppr pred_ty)
; ref <- newMutVar Nothing
- ; return $ CoercionHole { ch_co_var = co_var, ch_ref = ref } }
-
--- | Put a value in a coercion hole
-fillCoercionHole :: CoercionHole -> CoercionPlusHoles -> TcM ()
-fillCoercionHole (CoercionHole { ch_ref = ref, ch_co_var = cv }) co
- = do { when debugIsOn $
- do { cts <- readTcRef ref
- ; whenIsJust cts $ \old_co ->
- pprPanic "Filling a filled coercion hole" (ppr cv $$ ppr co $$ ppr old_co) }
- ; traceTc "Filling coercion hole" (ppr cv <+> text ":=" <+> ppr co)
- ; writeTcRef ref (Just co) }
+ ; return $ CH { ch_co_var = co_var, ch_ref = ref } }
{- **********************************************************************
*
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -422,7 +422,8 @@ Some examples:
-}
tcSkolemiseGeneral
- :: DeepSubsumptionFlag
+ :: HasDebugCallStack
+ => DeepSubsumptionFlag
-> UserTypeCtxt
-> TcType -> TcType -- top_ty and expected_ty
-- Here, top_ty is the type we started to skolemise; used only in SigSkol
@@ -450,15 +451,16 @@ tcSkolemiseGeneral ds_flag ctxt top_ty expected_ty thing_inside
; skol_info <- mkSkolemInfo sig_skol }
; let skol_tvs = map (binderVar . snd) tv_prs
- ; traceTc "tcSkolemiseGeneral" (pprUserTypeCtxt ctxt <+> ppr skol_tvs <+> ppr given)
+ ; traceTc "tcSkolemiseGeneral {" (pprUserTypeCtxt ctxt <+> ppr skol_tvs <+> ppr given)
; (ev_binds, result) <- checkConstraints sig_skol skol_tvs given $
thing_inside tv_prs rho_ty
+ ; traceTc "tcSkolemiseGeneral }" (ppr ev_binds $$ traceCallStackDoc)
; return (wrap <.> mkWpLet ev_binds, result) }
-- The ev_binds returned by checkConstraints is very
-- often empty, in which case mkWpLet is a no-op
-tcSkolemiseCompleteSig :: TcCompleteSig
+tcSkolemiseCompleteSig :: HasDebugCallStack => TcCompleteSig
-> ([ExpPatType] -> TcRhoType -> TcM result)
-> TcM (HsWrapper, result)
-- ^ The wrapper has type: spec_ty ~~> expected_ty
@@ -475,7 +477,7 @@ tcSkolemiseCompleteSig (CSig { sig_bndr = poly_id, sig_ctxt = ctxt, sig_loc = lo
tcExtendNameTyVarEnv (map (fmap binderVar) tv_prs) $
thing_inside (map (mkInvisExpPatType . snd) tv_prs) rho_ty }
-tcSkolemiseExpectedType :: TcSigmaType
+tcSkolemiseExpectedType :: HasDebugCallStack => TcSigmaType
-> ([ExpPatType] -> TcRhoType -> TcM result)
-> TcM (HsWrapper, result)
-- Just like tcSkolemiseCompleteSig, except that we don't have a user-written
@@ -487,14 +489,15 @@ tcSkolemiseExpectedType exp_ty thing_inside
= tcSkolemiseGeneral Shallow GenSigCtxt exp_ty exp_ty $ \tv_prs rho_ty ->
thing_inside (map (mkInvisExpPatType . snd) tv_prs) rho_ty
-tcSkolemise :: DeepSubsumptionFlag -> UserTypeCtxt -> TcSigmaType
+tcSkolemise :: HasDebugCallStack => DeepSubsumptionFlag -> UserTypeCtxt -> TcSigmaType
-> (TcRhoType -> TcM result)
-> TcM (HsWrapper, result)
tcSkolemise ds_flag ctxt expected_ty thing_inside
= tcSkolemiseGeneral ds_flag ctxt expected_ty expected_ty $ \_ rho_ty ->
thing_inside rho_ty
-checkConstraints :: SkolemInfoAnon
+checkConstraints :: HasDebugCallStack
+ => SkolemInfoAnon
-> [TcTyVar] -- Skolems
-> [EvVar] -- Given
-> TcM result
@@ -508,14 +511,16 @@ checkConstraints skol_info skol_tvs given thing_inside
; if implication_needed
then do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside
; (implics, ev_binds) <- buildImplicationFor tclvl skol_info skol_tvs given wanted
- ; traceTc "checkConstraints" (ppr tclvl $$ ppr skol_tvs)
+ ; traceTc "checkConstraints A" (ppr tclvl $$ ppr skol_tvs $$ traceCallStackDoc)
; emitImplications implics
; return (ev_binds, result) }
else -- Fast path. We check every function argument with tcCheckPolyExpr,
-- which uses tcTopSkolemise and hence checkConstraints.
-- So this fast path is well-exercised
- do { res <- thing_inside
+ do { traceTc "checkConstraints B" (ppr skol_tvs $$ ppr given $$ ppr skol_info $$
+ traceCallStackDoc)
+ ; res <- thing_inside
; return (emptyTcEvBinds, res) } }
checkTvConstraints :: SkolemInfo
=====================================
compiler/GHC/Tc/Zonk/TcType.hs
=====================================
@@ -236,7 +236,7 @@ zonkCo :: Coercion -> ZonkM Coercion
, tcm_tycon = zonkTcTyCon }
where
hole :: () -> CoercionHole -> ZonkM Coercion
- hole _ hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
+ hole _ hole@(CH { ch_ref = ref, ch_co_var = cv })
= do { contents <- readTcRef ref
; case contents of
Just (CPH { cph_co = co })
@@ -617,7 +617,7 @@ instance Monoid UnfilledCoercionHoleMonoid where
-- | Is a coercion hole filled in?
isFilledCoercionHole :: CoercionHole -> ZonkM Bool
-isFilledCoercionHole (CoercionHole { ch_ref = ref })
+isFilledCoercionHole (CH { ch_ref = ref })
= isJust <$> readTcRef ref
-- | Retrieve the contents of a coercion hole. Panics if the hole
@@ -631,7 +631,7 @@ unpackCoercionHole hole
-- | Retrieve the contents of a coercion hole, if it is filled
unpackCoercionHole_maybe :: CoercionHole -> ZonkM (Maybe CoercionPlusHoles)
-unpackCoercionHole_maybe (CoercionHole { ch_ref = ref }) = readTcRef ref
+unpackCoercionHole_maybe (CH { ch_ref = ref }) = readTcRef ref
{-
=====================================
compiler/GHC/Tc/Zonk/Type.hs
=====================================
@@ -485,7 +485,7 @@ zonkCoVarOcc cv
_ -> mkCoVarCo <$> (lift $ liftZonkM $ zonkCoVar cv) }
zonkCoHole :: CoercionHole -> ZonkTcM Coercion
-zonkCoHole hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
+zonkCoHole hole@(CH { ch_ref = ref, ch_co_var = cv })
= do { contents <- readTcRef ref
; case contents of
Just (CPH { cph_co = co })
@@ -1910,8 +1910,9 @@ zonk_tc_ev_binds (EvBinds bs) = zonkEvBinds bs
zonkEvBindsVar :: EvBindsVar -> ZonkBndrTcM (Bag EvBind)
zonkEvBindsVar (EvBindsVar { ebv_binds = ref })
- = do { bs <- readTcRef ref
+ = do { EBS { ebs_binds = bs } <- readTcRef ref
; zonkEvBinds (evBindMapBinds bs) }
+
zonkEvBindsVar (CoEvBindsVar {}) = return emptyBag
zonkEvBinds :: Bag EvBind -> ZonkBndrTcM (Bag EvBind)
=====================================
compiler/GHC/Types/Var.hs
=====================================
@@ -176,7 +176,7 @@ type KindVar = Var -- Definitely a kind variable
-- See Note [Evidence: EvIds and CoVars]
-- | Evidence Identifier
-type EvId = Id -- Term-level evidence: DictId, IpId, or EqVar
+type EvId = Id -- Term-level evidence: DictId, IpId, or CoVar
-- | Evidence Variable
type EvVar = EvId -- ...historical name for EvId
=====================================
compiler/GHC/Utils/Trace.hs
=====================================
@@ -11,6 +11,7 @@ module GHC.Utils.Trace
, warnPprTraceM
, pprTraceUserWarning
, trace
+ , traceCallStackDoc
)
where
=====================================
testsuite/tests/simplCore/should_compile/T26805.hs
=====================================
@@ -0,0 +1,29 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE TypeData #-}
+module T26805( interpret ) where
+
+import Data.Kind (Type)
+
+data Phantom (sh :: Type) = Phantom -- newtype fails to specialise as well
+
+instance Show (Phantom sh) where
+ show Phantom = "show"
+
+type Foo r = (forall sh. Show (Phantom sh), Num r)
+-- this specialises fine:
+-- type Foo r = (Num r)
+
+type data TK = TKScalar Type
+
+data AstTensor :: TK -> Type where
+ AstInt :: Int -> AstTensor (TKScalar Int)
+ AstPlus :: Foo r => AstTensor (TKScalar r) -> AstTensor (TKScalar r)
+
+plusConcrete :: Foo r => r -> r
+plusConcrete = (+ 1)
+
+interpret :: AstTensor (TKScalar Int) -> Int
+interpret v0 = case v0 of
+ AstInt n -> n
+ AstPlus u -> plusConcrete (interpret u)
=====================================
testsuite/tests/simplCore/should_compile/T26805.stderr
=====================================
@@ -0,0 +1 @@
+
\ No newline at end of file
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -578,3 +578,4 @@ test('T26615', [grep_errmsg(r'fEqList')], multimod_compile, ['T26615', '-O -fsp
# T26722: there should be no reboxing in $wg
test('T26722', [grep_errmsg(r'SPEC')], compile, ['-O -dno-typeable-binds'])
+test('T26805', [grep_errmsg(r'fromInteger')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques'])
=====================================
testsuite/tests/typecheck/should_compile/T26805a.hs
=====================================
@@ -0,0 +1,38 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE RoleAnnotations #-}
+
+-- This is a cut-down version of the failure found in !15389
+-- when compiling the `constraints` package.
+-- We got a Lint error because the NeededEvIds stuff in the
+-- constraint solver forgot some needed variables.
+
+module T26805a where
+
+import GHC.Exts (Constraint)
+import Data.Kind
+
+data Dict :: Constraint -> Type where
+ Dict :: a => Dict a
+
+newtype a :- b = Sub (a => Dict b)
+type role (:-) nominal nominal
+
+-- | Instantiate a quantified @'ForallF' p f@ constraint at type @a@.
+instF :: forall p f a . ForallF p f :- p (f a)
+instF = Sub @(ForallF p f) @(p (f a))
+ (case inst :: Forall (ComposeC p f) :- ComposeC p f a of
+ Sub Dict -> Dict)
+
+class Forall (ComposeC p f) => ForallF (p :: k2 -> Constraint) (f :: k1 -> k2)
+
+class p (f a) => ComposeC (p :: k2 -> Constraint) (f :: k1 -> k2) (a :: k1)
+
+class (forall a. p a) => Forall (p :: k -> Constraint)
+instance (forall a. p a) => Forall (p :: k -> Constraint)
+
+inst :: forall p a. Forall p :- p a
+inst = Sub Dict
+
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -959,3 +959,5 @@ test('T26451', normal, compile, [''])
test('T26582', normal, compile, [''])
test('T26746', normal, compile, [''])
test('T26737', normal, compile, [''])
+test('T26805a', normal, compile, [''])
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d0e6da1225ab5855517ce6437764c1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d0e6da1225ab5855517ce6437764c1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
28 Jan '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
5e0ec555 by sheaf at 2026-01-28T06:56:38-05:00
Add test case for #25679
This commit adds the T25679 test case. The test now passes, thanks to
commit 1e53277af36d3f0b6ad5491f70ffc5593a49dcfd.
Fixes #25679
- - - - -
f1cd1611 by sheaf at 2026-01-28T06:56:38-05:00
Improve defaulting of representational equalities
This commit makes the defaulting of representational equalities, introduced
in 1e53277a, a little bit more robust. Now, instead of calling the eager
unifier, it calls the full-blown constraint solver, which means that it can
handle some subtle situations, e.g. involving functional dependencies and
type-family injectivity annotations, such as:
type family F a = r | r -> a
type instance F Int = Bool
[W] F beta ~R Bool
- - - - -
25edf516 by sheaf at 2026-01-28T06:56:38-05:00
Improve errors for unsolved representational equalities
This commit adds a new field of CtLoc, CtExplanations, which allows the
typechecker to leave some information about what it has done. For the moment,
it is only used to improve error messages for unsolved representational
equalities. The typechecker will now accumulate, when unifying at
representational role:
- out-of-scope newtype constructors,
- type constructors that have nominal role in a certain argument,
- over-saturated type constructors,
- AppTys, e.g. `c a ~R# c b`, to report that we must assume that 'c' has
nominal role in its parameters,
- data family applications that do not reduce, potentially preventing
newtype unwrapping.
Now, instead of having to re-construct the possible errors after the fact,
we simply consult the CtExplanations field.
Additionally, this commit modifies the typechecker error messages that
concern out-of-scope newtype constructors. The error message now depends
on whether we have an import suggestion to provide to the user:
- If we have an import suggestion for the newtype constructor,
the message will be of the form:
The data constructor MkN of the newtype N is out of scope
Suggested fix: add 'MkN' to the import list in the import of 'M'
- If we don't have any import suggestions, the message will be
of the form:
NB: The type 'N' is an opaque newtype, whose constructor is hidden
Fixes #15850, #20289, #20468, #23731, #25949, #26137
- - - - -
67 changed files:
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/TyCon/RecWalk.hs
- compiler/GHC/Data/Maybe.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/CtLoc.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Utils/Monad.hs
- libraries/base/tests/T23454.stderr
- + testsuite/tests/default/T25825.hs
- testsuite/tests/default/all.T
- testsuite/tests/deriving/should_fail/T1496.stderr
- testsuite/tests/deriving/should_fail/T4846.stderr
- testsuite/tests/deriving/should_fail/T5498.stderr
- testsuite/tests/deriving/should_fail/T6147.stderr
- testsuite/tests/deriving/should_fail/T7148.stderr
- testsuite/tests/deriving/should_fail/T7148a.stderr
- 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/gadt/CasePrune.stderr
- testsuite/tests/indexed-types/should_fail/T9580.stderr
- testsuite/tests/linear/should_fail/LinearRole.stderr
- testsuite/tests/roles/should_fail/RolesIArray.stderr
- testsuite/tests/typecheck/should_fail/T10285.stderr
- testsuite/tests/typecheck/should_fail/T10534.stderr
- testsuite/tests/typecheck/should_fail/T10715b.stderr
- testsuite/tests/typecheck/should_fail/T11347.stderr
- testsuite/tests/typecheck/should_fail/T15801.stderr
- + testsuite/tests/typecheck/should_fail/T15850.hs
- + testsuite/tests/typecheck/should_fail/T15850.stderr
- + testsuite/tests/typecheck/should_fail/T15850_Lib.hs
- + testsuite/tests/typecheck/should_fail/T20289.hs
- + testsuite/tests/typecheck/should_fail/T20289.stderr
- + testsuite/tests/typecheck/should_fail/T20289_A.hs
- testsuite/tests/typecheck/should_fail/T22645.stderr
- testsuite/tests/typecheck/should_fail/T22924a.stderr
- + testsuite/tests/typecheck/should_fail/T23731.hs
- + testsuite/tests/typecheck/should_fail/T23731.stderr
- + testsuite/tests/typecheck/should_fail/T23731b.hs
- + testsuite/tests/typecheck/should_fail/T23731b.stderr
- + testsuite/tests/typecheck/should_fail/T23731b_aux.hs
- + testsuite/tests/typecheck/should_fail/T25679.hs
- + testsuite/tests/typecheck/should_fail/T25679.stderr
- + testsuite/tests/typecheck/should_fail/T25949.hs
- + testsuite/tests/typecheck/should_fail/T25949.stderr
- + testsuite/tests/typecheck/should_fail/T25949_aux.hs
- + testsuite/tests/typecheck/should_fail/T26137.hs
- + testsuite/tests/typecheck/should_fail/T26137.stderr
- testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
- testsuite/tests/typecheck/should_fail/TcCoercibleFail3.stderr
- testsuite/tests/typecheck/should_fail/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef35e3ea14d56e1bcd43e3985c33db…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef35e3ea14d56e1bcd43e3985c33db…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/26699] Adding some more modules to cabal file
by recursion-ninja (＠recursion-ninja) 28 Jan '26
by recursion-ninja (＠recursion-ninja) 28 Jan '26
28 Jan '26
recursion-ninja pushed to branch wip/26699 at Glasgow Haskell Compiler / GHC
Commits:
e4bfcc5b by Recursion Ninja at 2026-01-27T23:03:59-05:00
Adding some more modules to cabal file
- - - - -
1 changed file:
- compiler/GHC/Types/ImportLevel.hs
Changes:
=====================================
compiler/GHC/Types/ImportLevel.hs
=====================================
@@ -13,16 +13,16 @@ module GHC.Types.ImportLevel (
import GHC.Prelude
-import GHC.Utils.Outputable
import GHC.Utils.Binary
+import GHC.Utils.Outputable
import Language.Haskell.Syntax.ImpExp
import Data.Data
-- | ImportLevel
-
-data ImportLevel = NormalLevel | SpliceLevel | QuoteLevel deriving (Eq, Ord, Data, Show, Enum, Bounded)
+data ImportLevel = NormalLevel | SpliceLevel | QuoteLevel
+ deriving (Eq, Ord, Data, Show, Enum, Bounded)
instance Outputable ImportLevel where
ppr NormalLevel = text "normal"
@@ -32,7 +32,7 @@ instance Outputable ImportLevel where
deriving via (EnumBinary ImportLevel) instance Binary ImportLevel
allImportLevels :: [ImportLevel]
-allImportLevels = [minBound..maxBound]
+allImportLevels = [minBound .. maxBound]
convImportLevel :: ImportDeclLevelStyle -> ImportLevel
convImportLevel (LevelStylePre level) = convImportLevelSpec level
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4bfcc5b92f45204887faf230c62720…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4bfcc5b92f45204887faf230c62720…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: ci: update darwin boot ghc to 9.10.3
by Marge Bot (＠marge-bot) 28 Jan '26
by Marge Bot (＠marge-bot) 28 Jan '26
28 Jan '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
50761451 by Cheng Shao at 2026-01-27T21:51:23-05:00
ci: update darwin boot ghc to 9.10.3
This patch updates darwin boot ghc to 9.10.3, along with other related
updates, and pays off some technical debt here:
- Update `nixpkgs` and use the `nixpkgs-25.05-darwin` channel.
- Update the `niv` template.
- Update LLVM to 21 and update `llvm-targets` to reflect LLVM 21
layout changes for arm64/x86_64 darwin targets.
- Use `stdenvNoCC` to prevent nix packaged apple sdk from being used
by boot ghc, and manually set `DEVELOPER_DIR`/`SDKROOT` to enforce
the usage of system-wide command line sdk for macos.
- When building nix derivation for boot ghc, run `configure` via the
`arch` command so that `configure` and its subprocesses pick up the
manually specified architecture.
- Remove the previous horrible hack that obliterates `configure` to
make autoconf test result in true. `configure` now properly does its
job.
- Remove the now obsolete configure args and post install settings
file patching logic.
- Use `scheme-small` for texlive to avoid build failures in certain
unused texlive packages, especially on x86_64-darwin.
- - - - -
94dcd15e by Matthew Pickering at 2026-01-27T21:52:05-05: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, exceptions 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.
CLC proposal: https://github.com/haskell/core-libraries-committee/issues/383
Fixes #26751
- - - - -
ef35e3ea by Teo Camarasu at 2026-01-27T21:52:46-05:00
ghc-internal: move all Data instances to Data.Data
Most instances of Data are defined in GHC.Internal.Data.Data.
Let's move all remaining instance there.
This moves other modules down in the dependency hierarchy allowing for
more parallelism, and it decreases the likelihood that we would need to
load this heavy .hi file if we don't actually need it.
Resolves #26830
Metric Decrease:
T12227
T16875
- - - - -
4e1539c7 by sheaf at 2026-01-27T22:25:52-05:00
Add test case for #25679
This commit adds the T25679 test case. The test now passes, thanks to
commit 1e53277af36d3f0b6ad5491f70ffc5593a49dcfd.
Fixes #25679
- - - - -
efd86204 by sheaf at 2026-01-27T22:25:52-05:00
Improve defaulting of representational equalities
This commit makes the defaulting of representational equalities, introduced
in 1e53277a, a little bit more robust. Now, instead of calling the eager
unifier, it calls the full-blown constraint solver, which means that it can
handle some subtle situations, e.g. involving functional dependencies and
type-family injectivity annotations, such as:
type family F a = r | r -> a
type instance F Int = Bool
[W] F beta ~R Bool
- - - - -
a7764410 by sheaf at 2026-01-27T22:25:52-05:00
Improve errors for unsolved representational equalities
This commit adds a new field of CtLoc, CtExplanations, which allows the
typechecker to leave some information about what it has done. For the moment,
it is only used to improve error messages for unsolved representational
equalities. The typechecker will now accumulate, when unifying at
representational role:
- out-of-scope newtype constructors,
- type constructors that have nominal role in a certain argument,
- over-saturated type constructors,
- AppTys, e.g. `c a ~R# c b`, to report that we must assume that 'c' has
nominal role in its parameters,
- data family applications that do not reduce, potentially preventing
newtype unwrapping.
Now, instead of having to re-construct the possible errors after the fact,
we simply consult the CtExplanations field.
Additionally, this commit modifies the typechecker error messages that
concern out-of-scope newtype constructors. The error message now depends
on whether we have an import suggestion to provide to the user:
- If we have an import suggestion for the newtype constructor,
the message will be of the form:
The data constructor MkN of the newtype N is out of scope
Suggested fix: add 'MkN' to the import list in the import of 'M'
- If we don't have any import suggestions, the message will be
of the form:
NB: The type 'N' is an opaque newtype, whose constructor is hidden
Fixes #15850, #20289, #20468, #23731, #25949, #26137
- - - - -
9d07264e by Simon Peyton Jones at 2026-01-27T22:25:53-05:00
Fix two bugs in short-cut constraint solving
There are two main changes here:
* Use `isSolvedWC` rather than `isEmptyWC` in `tryShortCutSolver`
The residual constraint may have some fully-solved, but
still-there implications, and we don't want them to abort short
cut solving! That bug caused #26805.
* In the short-cut solver, we abandon the fully-solved residual
constraint; but we may thereby lose track of Givens that are
needed, and either report them as redundant or prune evidence
bindings that are in fact needed.
This bug stopped the `constraints` package from compiling;
see the trail in !15389.
The second bug led me to (another) significant refactoring
of the mechanism for tracking needed EvIds. See the new
Note [Tracking needed EvIds] in GHC.Tc.Solver.Solve
It's simpler and much less head-scratchy now.
Some particulars:
* An EvBindsVar now tracks NeededEvIds
* We deal with NeededEvIds for an implication only when it is
fully solved. Much simpler!
* `tryShortCutTcS` now takes a `TcM WantedConstraints` rather than
`TcM Bool`, so that is can plumb the needed EvIds correctly.
* Remove `ic_need` and `ic_need_implic` from Implication (hooray),
and add `ics_dm` and `ics_non_dm` to `IC_Solved`.
Pure refactor
* Shorten data constructor `CoercionHole` to `CH`, following
general practice in GHC.
* Rename `EvBindMap` to `EvBindsMap` for consistency
- - - - -
79b8f2a9 by Cheng Shao at 2026-01-27T22:25:54-05:00
ci: use debian validate bindists instead of fedora release bindists in testing stage
This patch changes the `abi-test`, `hadrian-multi` and `perf` jobs in
the full-ci pipeline testing stage to use debian validate bindists
instead of fedora release bindists, to increase pipeline level
parallelism and allow full-ci pipelines to complete earlier. Closes #26818.
- - - - -
4ff8f907 by Cheng Shao at 2026-01-27T22:25:56-05:00
ci: run perf test with -j$cores
This patch makes the perf ci job compile Cabal with -j$cores to speed
up the job.
- - - - -
110 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/darwin/nix/sources.json
- .gitlab/darwin/toolchain.nix
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Core/TyCon/RecWalk.hs
- compiler/GHC/Data/Maybe.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Default.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/CtLoc.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Utils/Monad.hs
- compiler/GHC/Utils/Trace.hs
- libraries/base/changelog.md
- libraries/base/tests/T23454.stderr
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Err.hs
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/tests/stack-annotation/all.T
- + libraries/ghc-internal/tests/stack-annotation/ann_frame005.hs
- + libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout
- llvm-targets
- + testsuite/tests/default/T25825.hs
- testsuite/tests/default/all.T
- testsuite/tests/deriving/should_fail/T1496.stderr
- testsuite/tests/deriving/should_fail/T4846.stderr
- testsuite/tests/deriving/should_fail/T5498.stderr
- testsuite/tests/deriving/should_fail/T6147.stderr
- testsuite/tests/deriving/should_fail/T7148.stderr
- testsuite/tests/deriving/should_fail/T7148a.stderr
- 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/gadt/CasePrune.stderr
- 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
- testsuite/tests/indexed-types/should_fail/T9580.stderr
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/linear/should_fail/LinearRole.stderr
- testsuite/tests/roles/should_fail/RolesIArray.stderr
- + testsuite/tests/simplCore/should_compile/T26805.hs
- + testsuite/tests/simplCore/should_compile/T26805.stderr
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/typecheck/should_compile/T26805a.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T10285.stderr
- testsuite/tests/typecheck/should_fail/T10534.stderr
- testsuite/tests/typecheck/should_fail/T10715b.stderr
- testsuite/tests/typecheck/should_fail/T11347.stderr
- testsuite/tests/typecheck/should_fail/T15801.stderr
- + testsuite/tests/typecheck/should_fail/T15850.hs
- + testsuite/tests/typecheck/should_fail/T15850.stderr
- + testsuite/tests/typecheck/should_fail/T15850_Lib.hs
- + testsuite/tests/typecheck/should_fail/T20289.hs
- + testsuite/tests/typecheck/should_fail/T20289.stderr
- + testsuite/tests/typecheck/should_fail/T20289_A.hs
- testsuite/tests/typecheck/should_fail/T22645.stderr
- testsuite/tests/typecheck/should_fail/T22924a.stderr
- + testsuite/tests/typecheck/should_fail/T23731.hs
- + testsuite/tests/typecheck/should_fail/T23731.stderr
- + testsuite/tests/typecheck/should_fail/T23731b.hs
- + testsuite/tests/typecheck/should_fail/T23731b.stderr
- + testsuite/tests/typecheck/should_fail/T23731b_aux.hs
- + testsuite/tests/typecheck/should_fail/T25679.hs
- + testsuite/tests/typecheck/should_fail/T25679.stderr
- + testsuite/tests/typecheck/should_fail/T25949.hs
- + testsuite/tests/typecheck/should_fail/T25949.stderr
- + testsuite/tests/typecheck/should_fail/T25949_aux.hs
- + testsuite/tests/typecheck/should_fail/T26137.hs
- + testsuite/tests/typecheck/should_fail/T26137.stderr
- testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
- testsuite/tests/typecheck/should_fail/TcCoercibleFail3.stderr
- testsuite/tests/typecheck/should_fail/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1516e93ac12f589397cedacd672374…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1516e93ac12f589397cedacd672374…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] ghc-internal: move all Data instances to Data.Data
by Marge Bot (＠marge-bot) 28 Jan '26
by Marge Bot (＠marge-bot) 28 Jan '26
28 Jan '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
ef35e3ea by Teo Camarasu at 2026-01-27T21:52:46-05:00
ghc-internal: move all Data instances to Data.Data
Most instances of Data are defined in GHC.Internal.Data.Data.
Let's move all remaining instance there.
This moves other modules down in the dependency hierarchy allowing for
more parallelism, and it decreases the likelihood that we would need to
load this heavy .hi file if we don't actually need it.
Resolves #26830
Metric Decrease:
T12227
T16875
- - - - -
9 changed files:
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
Changes:
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
=====================================
@@ -144,6 +144,8 @@ import qualified GHC.Internal.Generics as Generics (Fixity(..))
import GHC.Internal.Generics hiding (Fixity(..))
-- So we can give Data instance for U1, V1, ...
import qualified GHC.Internal.TH.Syntax as TH
+import GHC.Internal.Functor.ZipList (ZipList(..))
+import GHC.Internal.Exts (SpecConstrAnnotation(..))
------------------------------------------------------------------------------
--
@@ -1414,3 +1416,9 @@ deriving instance Data TH.TySynEqn
deriving instance Data TH.Type
deriving instance Data TH.TypeFamilyHead
deriving instance Data flag => Data (TH.TyVarBndr flag)
+
+-- | @since base-4.14.0.0
+deriving instance Data a => Data (ZipList a)
+
+-- | @since base-4.3.0.0
+deriving instance Data SpecConstrAnnotation
=====================================
libraries/ghc-internal/src/GHC/Internal/Exts.hs
=====================================
@@ -5,7 +5,6 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE Unsafe #-}
-{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK print-explicit-runtime-reps #-}
-----------------------------------------------------------------------------
@@ -317,7 +316,6 @@ import GHC.Internal.IsList (IsList(..)) -- for re-export
import qualified GHC.Internal.Data.Coerce
import GHC.Internal.Data.String
import GHC.Internal.Data.OldList
-import GHC.Internal.Data.Data
import GHC.Internal.Data.Ord
import qualified GHC.Internal.Debug.Trace
import GHC.Internal.Unsafe.Coerce ( unsafeCoerce# ) -- just for re-export
@@ -384,8 +382,7 @@ traceEvent = GHC.Internal.Debug.Trace.traceEventIO
-- entire ghc package at runtime
data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr
- deriving ( Data -- ^ @since base-4.3.0.0
- , Eq -- ^ @since base-4.3.0.0
+ deriving ( Eq -- ^ @since base-4.3.0.0
)
=====================================
libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
=====================================
@@ -3,7 +3,6 @@
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveDataTypeable #-}
module GHC.Internal.Functor.ZipList (ZipList(..)) where
@@ -14,7 +13,6 @@ import GHC.Internal.Read (Read)
import GHC.Internal.Show (Show)
import GHC.Internal.Data.Foldable (Foldable)
import GHC.Internal.Data.Traversable (Traversable(..))
-import GHC.Internal.Data.Data (Data)
-- | Lists, but with an 'Applicative' functor based on zipping.
--
@@ -76,7 +74,3 @@ instance Alternative ZipList where
go (x:xs) (_:ys) = x : go xs ys
go [] ys = ys
go xs _ = xs
-
--- | @since base-4.14.0.0
-deriving instance Data a => Data (ZipList a)
-
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -11603,7 +11603,6 @@ instance GHC.Internal.Control.Monad.Zip.MonadZip Data.Complex.Complex -- Defined
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Zip.MonadZip f, GHC.Internal.Control.Monad.Zip.MonadZip g) => GHC.Internal.Control.Monad.Zip.MonadZip (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (a :: * -> * -> *) b c. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable b, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable c, GHC.Internal.Data.Data.Data (a b c)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedArrow a b c) -- Defined in ‘Control.Applicative’
instance forall (m :: * -> *) a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable m, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Data.Data.Data (m a)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedMonad m a) -- Defined in ‘Control.Applicative’
-instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’
instance GHC.Internal.Data.Data.Data Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
instance forall s. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable s => GHC.Internal.Data.Data.Data (Data.Array.Byte.MutableByteArray s) -- Defined in ‘Data.Array.Byte’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
@@ -11706,6 +11705,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceStrictness --
instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Specificity -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Stmt -- Defined in ‘GHC.Internal.Data.Data’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Semigroup.Internal.Sum a) -- Defined in ‘GHC.Internal.Data.Data’
@@ -11731,6 +11731,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word32 -- Defined in ‘G
instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word64 -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word8 -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Data.Data’
+instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Data.Data’
instance forall k (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a) => GHC.Internal.Data.Data.Data (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
instance forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k1, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k2, GHC.Internal.Data.Data.Data (f (g a))) => GHC.Internal.Data.Data.Data (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Product.Product f g a) -- Defined in ‘Data.Functor.Product’
@@ -11741,7 +11742,6 @@ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Data.Data.Data m => GHC.Internal.Data.Data.Data (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
-instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’
instance forall m. GHC.Internal.Data.Foldable.Foldable (GHC.Internal.Data.Functor.Const.Const m) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance GHC.Internal.Data.Foldable.Foldable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Foldable.Foldable f, GHC.Internal.Data.Foldable.Foldable g) => GHC.Internal.Data.Foldable.Foldable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Foldable’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -11630,7 +11630,6 @@ instance GHC.Internal.Control.Monad.Zip.MonadZip Data.Complex.Complex -- Defined
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Zip.MonadZip f, GHC.Internal.Control.Monad.Zip.MonadZip g) => GHC.Internal.Control.Monad.Zip.MonadZip (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (a :: * -> * -> *) b c. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable b, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable c, GHC.Internal.Data.Data.Data (a b c)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedArrow a b c) -- Defined in ‘Control.Applicative’
instance forall (m :: * -> *) a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable m, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Data.Data.Data (m a)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedMonad m a) -- Defined in ‘Control.Applicative’
-instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’
instance GHC.Internal.Data.Data.Data Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
instance forall s. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable s => GHC.Internal.Data.Data.Data (Data.Array.Byte.MutableByteArray s) -- Defined in ‘Data.Array.Byte’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
@@ -11733,6 +11732,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceStrictness --
instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Specificity -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Stmt -- Defined in ‘GHC.Internal.Data.Data’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Semigroup.Internal.Sum a) -- Defined in ‘GHC.Internal.Data.Data’
@@ -11758,6 +11758,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word32 -- Defined in ‘G
instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word64 -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word8 -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Data.Data’
+instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Data.Data’
instance forall k (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a) => GHC.Internal.Data.Data.Data (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
instance forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k1, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k2, GHC.Internal.Data.Data.Data (f (g a))) => GHC.Internal.Data.Data.Data (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Product.Product f g a) -- Defined in ‘Data.Functor.Product’
@@ -11768,7 +11769,6 @@ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Data.Data.Data m => GHC.Internal.Data.Data.Data (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
-instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’
instance forall m. GHC.Internal.Data.Foldable.Foldable (GHC.Internal.Data.Functor.Const.Const m) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance GHC.Internal.Data.Foldable.Foldable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Foldable.Foldable f, GHC.Internal.Data.Foldable.Foldable g) => GHC.Internal.Data.Foldable.Foldable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Foldable’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -11861,7 +11861,6 @@ instance GHC.Internal.Control.Monad.Zip.MonadZip Data.Complex.Complex -- Defined
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Zip.MonadZip f, GHC.Internal.Control.Monad.Zip.MonadZip g) => GHC.Internal.Control.Monad.Zip.MonadZip (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (a :: * -> * -> *) b c. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable b, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable c, GHC.Internal.Data.Data.Data (a b c)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedArrow a b c) -- Defined in ‘Control.Applicative’
instance forall (m :: * -> *) a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable m, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Data.Data.Data (m a)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedMonad m a) -- Defined in ‘Control.Applicative’
-instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’
instance GHC.Internal.Data.Data.Data Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
instance forall s. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable s => GHC.Internal.Data.Data.Data (Data.Array.Byte.MutableByteArray s) -- Defined in ‘Data.Array.Byte’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
@@ -11964,6 +11963,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceStrictness --
instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Specificity -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Stmt -- Defined in ‘GHC.Internal.Data.Data’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Semigroup.Internal.Sum a) -- Defined in ‘GHC.Internal.Data.Data’
@@ -11989,6 +11989,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word32 -- Defined in ‘G
instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word64 -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word8 -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Data.Data’
+instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Data.Data’
instance forall k (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a) => GHC.Internal.Data.Data.Data (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
instance forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k1, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k2, GHC.Internal.Data.Data.Data (f (g a))) => GHC.Internal.Data.Data.Data (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Product.Product f g a) -- Defined in ‘Data.Functor.Product’
@@ -11999,7 +12000,6 @@ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Data.Data.Data m => GHC.Internal.Data.Data.Data (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
-instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’
instance forall m. GHC.Internal.Data.Foldable.Foldable (GHC.Internal.Data.Functor.Const.Const m) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance GHC.Internal.Data.Foldable.Foldable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Foldable.Foldable f, GHC.Internal.Data.Foldable.Foldable g) => GHC.Internal.Data.Foldable.Foldable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Foldable’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -11603,7 +11603,6 @@ instance GHC.Internal.Control.Monad.Zip.MonadZip Data.Complex.Complex -- Defined
instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Zip.MonadZip f, GHC.Internal.Control.Monad.Zip.MonadZip g) => GHC.Internal.Control.Monad.Zip.MonadZip (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
instance forall (a :: * -> * -> *) b c. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable b, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable c, GHC.Internal.Data.Data.Data (a b c)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedArrow a b c) -- Defined in ‘Control.Applicative’
instance forall (m :: * -> *) a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable m, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Data.Data.Data (m a)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedMonad m a) -- Defined in ‘Control.Applicative’
-instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’
instance GHC.Internal.Data.Data.Data Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
instance forall s. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable s => GHC.Internal.Data.Data.Data (Data.Array.Byte.MutableByteArray s) -- Defined in ‘Data.Array.Byte’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
@@ -11706,6 +11705,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceStrictness --
instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Specificity -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Stmt -- Defined in ‘GHC.Internal.Data.Data’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Semigroup.Internal.Sum a) -- Defined in ‘GHC.Internal.Data.Data’
@@ -11731,6 +11731,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word32 -- Defined in ‘G
instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word64 -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word8 -- Defined in ‘GHC.Internal.Data.Data’
instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Data.Data’
+instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Data.Data’
instance forall k (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a) => GHC.Internal.Data.Data.Data (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
instance forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k1, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k2, GHC.Internal.Data.Data.Data (f (g a))) => GHC.Internal.Data.Data.Data (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’
instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Product.Product f g a) -- Defined in ‘Data.Functor.Product’
@@ -11741,7 +11742,6 @@ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Data.Data.Data m => GHC.Internal.Data.Data.Data (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
-instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’
instance forall m. GHC.Internal.Data.Foldable.Foldable (GHC.Internal.Data.Functor.Const.Const m) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance GHC.Internal.Data.Foldable.Foldable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Foldable.Foldable f, GHC.Internal.Data.Foldable.Foldable g) => GHC.Internal.Data.Foldable.Foldable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Foldable’
=====================================
testsuite/tests/interface-stability/ghc-experimental-exports.stdout
=====================================
@@ -11186,7 +11186,6 @@ instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.FunPtr a) -- Defin
instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.Ptr a) -- Defined in ‘GHC.Internal.Ptr’
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Classes.Ord GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
-instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’
instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’
instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’
instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’
=====================================
testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
=====================================
@@ -11189,7 +11189,6 @@ instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.FunPtr a) -- Defin
instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.Ptr a) -- Defined in ‘GHC.Internal.Ptr’
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Classes.Ord GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
-instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’
instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’
instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’
instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef35e3ea14d56e1bcd43e3985c33dbe…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef35e3ea14d56e1bcd43e3985c33dbe…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Evaluate backtraces for "error" exceptions at the moment they are thrown
by Marge Bot (＠marge-bot) 28 Jan '26
by Marge Bot (＠marge-bot) 28 Jan '26
28 Jan '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
94dcd15e by Matthew Pickering at 2026-01-27T21:52:05-05: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, exceptions 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.
CLC proposal: https://github.com/haskell/core-libraries-committee/issues/383
Fixes #26751
- - - - -
9 changed files:
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/Err.hs
- libraries/ghc-internal/tests/stack-annotation/all.T
- + libraries/ghc-internal/tests/stack-annotation/ann_frame005.hs
- + libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout
- 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/base/changelog.md
=====================================
@@ -24,6 +24,7 @@
* Remove `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329)
* Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376))
* Add a new module `System.IO.OS` with operations for obtaining operating-system handles (file descriptors, Windows handles). ([CLC proposal #369](https://github.com/haskell/core-libraries-committee/issues/369))
+ * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383))
## 4.22.0.0 *TBA*
* Shipped with GHC 9.14.1
=====================================
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 =
+ -- See Note [Capturing the backtrace in throw] and Note [Hiding precise exception signature in 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,10 @@ 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 =
+ -- See Note [Capturing the backtrace in throw] and Note [Hiding precise exception signature in throw]
+ let !se = noinline (errorCallWithCallStackException "Prelude.undefined" ?callStack)
+ in raise# se
-- | Used for compiler-generated error message;
-- encoding saves bytes of string junk.
=====================================
libraries/ghc-internal/tests/stack-annotation/all.T
=====================================
@@ -8,3 +8,4 @@ test('ann_frame001', ann_frame_opts, compile_and_run, [''])
test('ann_frame002', ann_frame_opts, compile_and_run, [''])
test('ann_frame003', ann_frame_opts, compile_and_run, [''])
test('ann_frame004', ann_frame_opts, compile_and_run, [''])
+test('ann_frame005', ann_frame_opts, compile_and_run, [''])
=====================================
libraries/ghc-internal/tests/stack-annotation/ann_frame005.hs
=====================================
@@ -0,0 +1,73 @@
+import Control.Concurrent.STM
+import Control.Exception
+import Control.Exception.Backtrace (BacktraceMechanism(IPEBacktrace), setBacktraceMechanismState)
+import Control.Exception.Context (displayExceptionContext)
+import Control.Monad
+import Data.List (isInfixOf)
+import TestUtils
+
+data SimpleBoom = SimpleBoom deriving (Show)
+
+instance Exception SimpleBoom
+
+main :: IO ()
+main = do
+ setBacktraceMechanismState IPEBacktrace True
+ mapM_ (uncurry runCase)
+ [ ("throwIO SimpleBoom", throwIOAction)
+ , ("undefined", undefinedAction)
+ , ("error", errorAction)
+ , ("throwSTM", throwSTMAction)
+ ]
+
+runCase :: String -> IO () -> IO ()
+runCase label action = do
+ putStrLn ("=== " ++ label ++ " ===")
+ annotateCallStackIO $
+ annotateStackStringIO ("catch site for " ++ label) $
+ catch action (handler label)
+
+throwIOAction :: IO ()
+throwIOAction =
+ annotateStackStringIO "raising action" $
+ annotateStackStringIO "throwIO SimpleBoom" $
+ throwIO SimpleBoom
+
+undefinedAction :: IO ()
+undefinedAction =
+ annotateStackStringIO "raising undefined action" $
+ void $
+ evaluate $
+ annotateStackString "undefined thunk" (undefined :: Int)
+
+errorAction :: IO ()
+errorAction =
+ annotateStackStringIO "raising error action" $
+ void $
+ evaluate $
+ annotateStackString "error thunk" (error "error from annotateStackString" :: Int)
+
+throwSTMAction :: IO ()
+throwSTMAction =
+ annotateStackStringIO "raising throwSTM action" $
+ atomically $
+ annotateStackString "throwSTM SimpleBoom" $
+ throwSTM SimpleBoom
+
+handler :: String -> SomeException -> IO ()
+handler label se =
+ annotateStackStringIO ("handler for " ++ label) $
+ annotateStackStringIO ("forcing SomeException for " ++ label) $ do
+ message <- evaluate (displayException se)
+ putStrLn ("Caught exception: " ++ message)
+ let ctx = displayExceptionContext (someExceptionContext se)
+ ctxLines = lines ctx
+ putStrLn "Exception context:"
+ case ctxLines of
+ [] -> putStrLn "<empty>"
+ ls -> mapM_ (putStrLn . ("- " ++)) ls
+ let handlerTag = "handler for " ++ label
+ -- Check that the callstack is from the callsite, not the handling site
+ when (any (handlerTag `isInfixOf`) ctxLines) $
+ error $ "handler annotation leaked into context for " ++ label
+ putStrLn "Handler annotation not present in context"
=====================================
libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout
=====================================
@@ -0,0 +1,45 @@
+=== throwIO SimpleBoom ===
+Caught exception: SimpleBoom
+Exception context:
+- IPE backtrace:
+- throwIO SimpleBoom
+- raising action
+- catch site for throwIO SimpleBoom
+- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main
+- HasCallStack backtrace:
+- throwIO, called at ann_frame005.hs:34:7 in main:Main
+Handler annotation not present in context
+=== undefined ===
+Caught exception: Prelude.undefined
+Exception context:
+- IPE backtrace:
+- undefined thunk
+- raising undefined action
+- catch site for undefined
+- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main
+- HasCallStack backtrace:
+- undefined, called at ann_frame005.hs:41:48 in main:Main
+Handler annotation not present in context
+=== error ===
+Caught exception: error from annotateStackString
+Exception context:
+- IPE backtrace:
+- error thunk
+- raising error action
+- catch site for error
+- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main
+- HasCallStack backtrace:
+- error, called at ann_frame005.hs:48:44 in main:Main
+Handler annotation not present in context
+=== throwSTM ===
+Caught exception: SimpleBoom
+Exception context:
+- IPE backtrace:
+- raising throwSTM action
+- catch site for throwSTM
+- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main
+- HasCallStack backtrace:
+- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception
+- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/STM.hs:190:26 in ghc-internal:GHC.Internal.STM
+- throwSTM, called at ann_frame005.hs:55:9 in main:Main
+Handler annotation not present in context
=====================================
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/94dcd15e54146abecf9b4f5e47d258c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94dcd15e54146abecf9b4f5e47d258c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
28 Jan '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
50761451 by Cheng Shao at 2026-01-27T21:51:23-05:00
ci: update darwin boot ghc to 9.10.3
This patch updates darwin boot ghc to 9.10.3, along with other related
updates, and pays off some technical debt here:
- Update `nixpkgs` and use the `nixpkgs-25.05-darwin` channel.
- Update the `niv` template.
- Update LLVM to 21 and update `llvm-targets` to reflect LLVM 21
layout changes for arm64/x86_64 darwin targets.
- Use `stdenvNoCC` to prevent nix packaged apple sdk from being used
by boot ghc, and manually set `DEVELOPER_DIR`/`SDKROOT` to enforce
the usage of system-wide command line sdk for macos.
- When building nix derivation for boot ghc, run `configure` via the
`arch` command so that `configure` and its subprocesses pick up the
manually specified architecture.
- Remove the previous horrible hack that obliterates `configure` to
make autoconf test result in true. `configure` now properly does its
job.
- Remove the now obsolete configure args and post install settings
file patching logic.
- Use `scheme-small` for texlive to avoid build failures in certain
unused texlive packages, especially on x86_64-darwin.
- - - - -
3 changed files:
- .gitlab/darwin/nix/sources.json
- .gitlab/darwin/toolchain.nix
- llvm-targets
Changes:
=====================================
.gitlab/darwin/nix/sources.json
=====================================
@@ -1,26 +1,14 @@
{
- "niv": {
- "branch": "master",
- "description": "Easy dependency management for Nix projects",
- "homepage": "https://github.com/nmattia/niv",
- "owner": "nmattia",
- "repo": "niv",
- "rev": "e0ca65c81a2d7a4d82a189f1e23a48d59ad42070",
- "sha256": "1pq9nh1d8nn3xvbdny8fafzw87mj7gsmp6pxkdl65w2g18rmcmzx",
- "type": "tarball",
- "url": "https://github.com/nmattia/niv/archive/e0ca65c81a2d7a4d82a189f1e23a48d59ad4…",
- "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
- },
"nixpkgs": {
- "branch": "nixos-unstable",
+ "branch": "nixpkgs-25.05-darwin",
"description": "Nix Packages collection",
"homepage": "",
"owner": "nixos",
"repo": "nixpkgs",
- "rev": "2893f56de08021cffd9b6b6dfc70fd9ccd51eb60",
- "sha256": "1anwxmjpm21msnnlrjdz19w31bxnbpn4kgf93sn3npihi7wf4a8h",
+ "rev": "3e3f3c7f9977dc123c23ee21e8085ed63daf8c37",
+ "sha256": "0jnmv6gpzhqb0jyhj7qi7vjfwbn4cqs5blm5xia7q5i0ma2bbkcd",
"type": "tarball",
- "url": "https://github.com/nixos/nixpkgs/archive/2893f56de08021cffd9b6b6dfc70fd9ccd…",
+ "url": "https://github.com/nixos/nixpkgs/archive/3e3f3c7f9977dc123c23ee21e8085ed63d…",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
}
}
=====================================
.gitlab/darwin/toolchain.nix
=====================================
@@ -11,69 +11,67 @@ let
hsPkgs = pkgs.haskellPackages;
alex = hsPkgs.alex;
happy = hsPkgs.happy;
- targetTriple = pkgs.stdenv.targetPlatform.config;
+ targetTriple = pkgs.stdenvNoCC.targetPlatform.config;
ghcBindists = let version = ghc.version; in {
- aarch64-darwin = hostPkgs.fetchurl {
+ aarch64-darwin = hostPkgs.fetchzip {
url = "https://downloads.haskell.org/ghc/${version}/ghc-${version}-aarch64-apple-d…";
- sha256 = "sha256-/6+DtdeossBJIMbjkJwL4h3eJ7rzgNCV+ifoQKOi6AQ=";
+ hash = "sha512-xUlt7zc/OT3a1SR0BxmFFgrabPkWUENATdw4NbQwEi5+nH5yPau+HSrGI5UUoKdO4gdpgZlPaxtI7eSk0fx1+g==";
};
- x86_64-darwin = hostPkgs.fetchurl {
+ x86_64-darwin = hostPkgs.fetchzip {
url = "https://downloads.haskell.org/ghc/${version}/ghc-${version}-x86_64-apple-da…";
- sha256 = "sha256-jPIhiJMOENesUnDUJeIaPatgavc6ZVSTY5NFIAxlC+k=";
+ hash = "sha512-4/INeJwPPGbOj9MepwnIvIg2lvFkqS8w/3U/I8f6gCsoNlgwPr78iyY9vd6vfMONR1GxNQU3L/lxE07F3P0Qag==";
};
-
};
- ghc = pkgs.stdenv.mkDerivation rec {
- version = "9.10.1";
+ ghc = pkgs.stdenvNoCC.mkDerivation rec {
+ version = "9.10.3";
name = "ghc";
- src = ghcBindists.${pkgs.stdenv.hostPlatform.system};
+ src = ghcBindists.${pkgs.stdenvNoCC.hostPlatform.system};
+
+ dontUpdateAutotoolsGnuConfigScripts = true;
+
configureFlags = [
- "CC=/usr/bin/clang"
- "CLANG=/usr/bin/clang"
"AR=/usr/bin/ar"
- "LLC=${llvm}/bin/llc"
- "OPT=${llvm}/bin/opt"
- "LLVMAS=${llvm_clang}/bin/clang"
- "CONF_CC_OPTS_STAGE2=--target=${targetTriple}"
- "CONF_CXX_OPTS_STAGE2=--target=${targetTriple}"
- "CONF_GCC_LINKER_OPTS_STAGE2=--target=${targetTriple}"
+ "CC=/usr/bin/clang"
+ "CXX=/usr/bin/clang++"
+ "INSTALL=/usr/bin/install"
+ "INSTALL_NAME_TOOL=/usr/bin/install_name_tool"
+ "MergeObjsCmd=/usr/bin/ld"
+ "NM=/usr/bin/nm"
+ "OTOOL=/usr/bin/otool"
+ "RANLIB=/usr/bin/ranlib"
];
- buildPhase = "true";
-
- # This is a horrible hack because the configure script invokes /usr/bin/clang
- # without a `--target` flag. Then depending on whether the `nix` binary itself is
- # a native x86 or arm64 binary means that /usr/bin/clang thinks it needs to run in
- # x86 or arm64 mode.
-
- # The correct answer for the check in question is the first one we try, so by replacing
- # the condition to true; we select the right C++ standard library still.
- preConfigure = ''
- sed "s/\"\$CC\" -o actest actest.o \''${1} 2>\/dev\/null/true/i" configure > configure.new
- mv configure.new configure
- chmod +x configure
- cat configure
+ # Use the arch command to explicitly specify architecture, so that
+ # configure and its subprocesses would pick up the architecture we
+ # choose via the system argument.
+ preConfigure = pkgs.lib.optionalString (system == "aarch64-darwin") ''
+ substituteInPlace configure \
+ --replace-fail "#! /bin/sh" "#!/usr/bin/env -S /usr/bin/arch -arm64 /bin/sh"
+ '' + pkgs.lib.optionalString (system == "x86_64-darwin") ''
+ substituteInPlace configure \
+ --replace-fail "#! /bin/sh" "#!/usr/bin/env -S /usr/bin/arch -x86_64 /bin/sh"
+ '' + ''
+ unset DEVELOPER_DIR SDKROOT
+ export DEVELOPER_DIR="$(/usr/bin/xcode-select --print-path)"
+ export SDKROOT="$(/usr/bin/xcrun --sdk macosx --show-sdk-path)"
'';
+ dontPatchShebangsInConfigure = true;
+
# N.B. Work around #20253.
nativeBuildInputs = [ pkgs.gnused ];
- postInstallPhase = ''
- settings="$out/lib/ghc-${version}/settings"
- sed -i -e "s%\"llc\"%\"${llvm}/bin/llc\"%" $settings
- sed -i -e "s%\"opt\"%\"${llvm}/bin/opt\"%" $settings
- sed -i -e "s%\"clang\"%\"/usr/bin/clang\"%" $settings
- sed -i -e 's%("C compiler command", "")%("C compiler command", "/usr/bin/clang")%' $settings
- sed -i -e 's%("C compiler flags", "")%("C compiler flags", "--target=${targetTriple}")%' $settings
- sed -i -e 's%("C++ compiler flags", "")%("C++ compiler flags", "--target=${targetTriple}")%' $settings
- sed -i -e 's%("C compiler link flags", "")%("C compiler link flags", "--target=${targetTriple}")%' $settings
- '';
+
+ dontBuild = true;
+
+ enableParallelInstalling = true;
+
+ dontFixup = true;
# Sanity check: verify that we can compile hello world.
doInstallCheck = true;
installCheckPhase = ''
- unset DYLD_LIBRARY_PATH
$out/bin/ghc --info
cd $TMP
mkdir test-ghc; cd test-ghc
@@ -91,13 +89,13 @@ let
ourtexlive = with pkgs;
texlive.combine {
inherit (texlive)
- scheme-medium collection-xetex fncychap titlesec tabulary varwidth
+ scheme-small collection-xetex fncychap tex-gyre titlesec tabulary varwidth
framed capt-of wrapfig needspace dejavu-otf helvetic upquote;
};
fonts = with pkgs; makeFontsConf { fontDirectories = [ dejavu_fonts ]; };
- llvm = pkgs.llvm_15;
- llvm_clang = pkgs.llvmPackages_15.clang-unwrapped;
+ llvm = pkgs.llvm_21;
+ llvm_clang = pkgs.llvmPackages_21.clang-unwrapped;
in
pkgs.writeTextFile {
name = "toolchain";
=====================================
llvm-targets
=====================================
@@ -44,8 +44,8 @@
,("riscv64-unknown-linux", ("e-m:e-p:64:64-i64:64-i128:128-n64-S128", "", "+m +a +f +d +c +relax"))
,("loongarch64-unknown-linux-gnu", ("e-m:e-p:64:64-i64:64-i128:128-n64-S128", "", "+f +d"))
,("loongarch64-unknown-linux", ("e-m:e-p:64:64-i64:64-i128:128-n64-S128", "", "+f +d"))
-,("x86_64-apple-darwin", ("e-m:o-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "penryn", ""))
-,("arm64-apple-darwin", ("e-m:o-i64:64-i128:128-n32:64-S128", "generic", "+v8.3a +fp-armv8 +neon +crc +crypto +fullfp16 +ras +lse +rdm +rcpc +zcm +zcz +sha2 +aes"))
+,("x86_64-apple-darwin", ("e-m:o-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", "core2", ""))
+,("arm64-apple-darwin", ("e-m:o-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-n32:64-S128-Fn32", "apple-m1", "+v8.4a +aes +altnzcv +ccdp +ccpp +complxnum +crc +dotprod +flagm +fp-armv8 +fp16fml +fptoint +fullfp16 +jsconv +lse +neon +pauth +perfmon +predres +ras +rcpc +rdm +sb +sha2 +sha3 +specrestrict +ssbs"))
,("aarch64-apple-ios", ("e-m:o-i64:64-i128:128-n32:64-S128", "apple-a7", "+fp-armv8 +neon +crypto +zcm +zcz +sha2 +aes"))
,("x86_64-apple-ios", ("e-m:o-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "core2", ""))
,("amd64-portbld-freebsd", ("e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5076145148541cc4e38cace52745e90…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5076145148541cc4e38cace52745e90…
You're receiving this email because of your account on gitlab.haskell.org.
1
0