[Git][ghc/ghc][wip/sjakobi/upsert] 25 commits: Bump default language edition to GHC2024
by Simon Jakobi (＠sjakobi2) 07 Apr '26
by Simon Jakobi (＠sjakobi2) 07 Apr '26
07 Apr '26
Simon Jakobi pushed to branch wip/sjakobi/upsert at Glasgow Haskell Compiler / GHC
Commits:
7fbb4fcb by Rodrigo Mesquita at 2026-04-01T12:16:33+00:00
Bump default language edition to GHC2024
As per the accepted ghc-proposal#632
Fixes #26039
- - - - -
5ae43275 by Peng Fan at 2026-04-01T19:01:06-04:00
NCG/LA64: add cmpxchg and xchg primops
And append some new instructions for LA664 uarch.
Apply fix to cmpxchg-prim by Andreas Klebinger.
Suggestions in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15515
- - - - -
8f95534a by Duncan Coutts at 2026-04-01T19:01:52-04:00
Remove signal-based ticker implementations
Fixes issue #27073
All supported platforms should work with the pthreads + nanosleep based
ticker implementation. This avoids all the problems with using signals.
In practice, all supported platforms were probably using the non-signal
tickers already, which is probably why we do not get lots of reports
about deadlocks and other weirdness: we were definately using functions
that are not async signal safe in the tick handler (such as fflush to
flussh the eventlog).
Only Solaris was explicitly using the timer_create ticker impl, and even
Solaris could probably use the pthreads one (if anyone cared: Solaris is
no longer a Teir 3 supported platform).
Plausibly the only supported platform that this will change will be AIX,
which should now use the pthreads impl.
- - - - -
51b32b0d by Duncan Coutts at 2026-04-01T19:01:52-04:00
Tidy up some timer/ticker comments elsewhere
- - - - -
7562bcd7 by Duncan Coutts at 2026-04-01T19:01:52-04:00
Remove now-unused install_vtalrm_handler
Support function used by both of the signal-based ticker
implementations.
- - - - -
6da127c7 by Duncan Coutts at 2026-04-01T19:01:52-04:00
No longer probe for timer_create in rts/configure
It was only used by the TimerCreate.c ticker impl.
- - - - -
3fd490fa by Duncan Coutts at 2026-04-01T19:01:53-04:00
Note that rtsTimerSignal is deprecated.
- - - - -
63099b0f by Simon Jakobi at 2026-04-01T19:02:39-04:00
Add perf test for #13960
Closes #13960.
- - - - -
58009c14 by Apoorv Ingle at 2026-04-02T09:51:24+01:00
Streamline expansions using HsExpansion (#25001)
Notes added [Error Context Stack] [Typechecking by expansion: overview]
Notes updated Note [Expanding HsDo with XXExprGhcRn] [tcApp: typechecking applications]
-------------------------
Metric Decrease:
T9020
-------------------------
There are 2 key changes:
1. `HsExpand` datatype mediates between expansions
2. Replace `ErrCtxtM` to a simpler `HsCtxt` that does not depend on a `TidyEnv`
This has some consequences detailed below:
1. `HsExpand` datatype mediates between expansions
* Simplifies the implementations of `tcExpr` to work on `XExpr`
* Removes `VACtxt` (and its associated `VAExpansion` and `VACall`) datatype, it is subsumed by simply a `SrcSpan`.
* Removes the function `addHeadCtxt` as it is now mearly setting a location
* The function `tcValArgs` does its own argument number management
* move `splitHsTypes` out of `tcApp`
* Removes special case of tcBody from `tcLambdaMatches`
* Removes special case of `dsExpr` for `ExpandedThingTc`
* Renames `tcMonoExpr` -> `tcMonoLExpr`, `tcMonoExprNC` -> `tcMonoLExpr`
* Renames `EValArg`, `EValArgQL` fields: `ea_ctxt` -> `ea_loc_span` and `eaql_ctx` -> `eaql_loc_span`
* Remove `PopErrCtxt` from `XXExprGhcRn`
* `fun_orig` in tcInstFun depends on the SrcSpan of the head of the application chain (similar to addArgCtxt)
- it references the application chain head if it is user located, or
uses the error context stack as a fallback if it's a generated
location
* Make a new variant `GeneratedSrcSpan` in `SrcSpan` for HIEAst Nodes
- Expressions wrapped around `GeneratedSrcSpan` are ignored and never added to the error context stack
- In Explicit list expansion `fromListN` is wrapped with a `GeneratedSrcSpan` with `GeneratedSrcSpanDetails` field to store the original srcspan
2. Replace `ErrCtxtM` to a simpler `HsCtxt` that does not depend on a `TidyEnv`
* Merge `HsThingRn` to `HsCtxt`
* Landmark Error messages are now just computed on the fly
* Make HsExpandedRn and HsExpandedTc payload a located HsExpr GhcRn
* `HsCtxt` are tidied and zonked at the end right before printing
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
bc4b4487 by Zubin Duggal at 2026-04-03T14:22:27-04:00
driver: recognise .dyn_o as a valid object file to link if passed on the command line.
This allows plugins compiled with this suffix to run.
Fixes #24486
- - - - -
5ebb9121 by Simon Jakobi at 2026-04-03T14:23:11-04:00
Add regression test for #16145
Closes #16145.
- - - - -
c1fc1c44 by Simon Peyton Jones at 2026-04-03T19:56:07-04:00
Refactor eta-expansion in Prep
The Prep pass does eta-expansion but I found cases where it was
doing bad things. So I refactored and simplified it quite a bit.
In the new design
* There is no distinction between `rhs` and `body`; in particular,
lambdas can now appear anywhere, rather than just as the RHS of
a let-binding.
* This change led to a significant simplification of Prep, and
a more straightforward explanation of eta-expansion. See the new
Note [Eta expansion]
* The consequences is that CoreToStg needs to handle naked lambdas.
This is very easy; but it does need a unique supply, which forces
some simple refactoring. Having a unique supply to hand is probably
a good thing anyway.
- - - - -
21beda2c by Simon Peyton Jones at 2026-04-03T19:56:07-04:00
Clarify Note [Interesting dictionary arguments]
Ticket #26831 ended up concluding that the code for
GHC.Core.Opt.Specialise.interestingDict was good, but the
commments were a bit inadequate.
This commit improves the comments slightly.
- - - - -
3eaac1f2 by Simon Peyton Jones at 2026-04-03T19:56:07-04:00
Make inlining a bit more eager for overloaded functions
If we have
f d = ... (class-op d x y) ...
we should be eager to inline `f`, because that may change the
higher order call (class-op d x y) into a call to a statically
known function.
See the discussion on #26831.
Even though this does a bit /more/ inlining, compile times
decrease by an average of 0.4%.
Compile time changes:
DsIncompleteRecSel3(normal) 431,786,104 -2.2%
ManyAlternatives(normal) 670,883,768 -1.6%
ManyConstructors(normal) 3,758,493,832 -2.6% GOOD
MultilineStringsPerf(normal) 29,900,576 -2.8%
T14052Type(ghci) 1,047,600,848 -1.2%
T17836(normal) 392,852,328 -5.2%
T18478(normal) 442,785,768 -1.4%
T21839c(normal) 341,536,992 -14.1% GOOD
T3064(normal) 174,086,152 +5.3% BAD
T5631(normal) 506,867,800 +1.0%
hard_hole_fits(normal) 209,530,736 -1.3%
info_table_map_perf(normal) 19,523,093,184 -1.2%
parsing001(normal) 377,810,528 -1.1%
pmcOrPats(normal) 60,075,264 -0.5%
geo. mean -0.4%
minimum -14.1%
maximum +5.3%
Runtime changes
haddock.Cabal(normal) 27,351,988,792 -0.7%
haddock.base(normal) 26,997,212,560 -0.6%
haddock.compiler(normal) 219,531,332,960 -1.0%
Metric Decrease:
LinkableUsage01
ManyConstructors
T17949
T21839c
T13035
TcPlugin_RewritePerf
hard_hole_fits
Metric Increase:
T3064
- - - - -
5cbc2c82 by Matthew Pickering at 2026-04-03T19:57:02-04:00
bytecode: Add magic header/version to bytecode files
In order to avoid confusing errors when using stale interface files (ie
from an older compiler version), we add a simple header/version check
like the one for interface files.
Fixes #27068
- - - - -
d95a1936 by fendor at 2026-04-03T19:57:02-04:00
Add constants for bytecode in-memory buffer size
Introduce a common constant for the default size of the .gbc and
.bytecodelib binary buffer.
The buffer is by default set to 1 MB.
- - - - -
b822c30a by mangoiv at 2026-04-03T19:57:49-04:00
testsuite: filter stderr for static001 on darwin
This reactivates the test on x86_64 darwin as this should have been done
long ago and ignores warnings emitted by ranlib on newer version of the
darwin toolchain since they are benign. (no symbols for stub libraries)
Fixes #27116
- - - - -
28ce1f8a by Andreas Klebinger at 2026-04-03T19:58:44-04:00
Give the Data instance for ModuleName a non-bottom toConstr implementation.
I've also taken the liberty to add Note [Data.Data instances for GHC AST Types]
describing some of the uses of Data.Data I could find.
Fixes #27129
- - - - -
8ca41ffe by mangoiv at 2026-04-03T19:59:30-04:00
issue template: fix add bug label
- - - - -
3981db0c by Sylvain Henry at 2026-04-03T20:00:33-04:00
Add more canned GC functions for common register patterns (#27142)
Based on analysis of heap-check sites across the GHC compiler and Cabal,
the following patterns were not covered by existing canned GC functions
but occurred frequently enough to warrant specialisation:
stg_gc_ppppp -- 5 GC pointers
stg_gc_ip -- unboxed word + GC pointer
stg_gc_pi -- GC pointer + unboxed word
stg_gc_ii -- two unboxed words
stg_gc_bpp -- byte (I8) + two GC pointers
Adding these reduces the fraction of heap-check sites falling back to
the generic GC path from ~1.4% to ~0.4% when compiling GHC itself.
Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com>
- - - - -
d17d1435 by Matthew Pickering at 2026-04-03T20:01:19-04:00
Make home unit dependencies stored as sets
Co-authored-by: Wolfgang Jeltsch <wolfgang(a)well-typed.com>
- - - - -
92a97015 by Simon Peyton Jones at 2026-04-05T00:58:57+01:00
Add Invariant (NoTypeShadowing) to Core
This commit addresses #26868, by adding
a new invariant (NoTypeShadowing) to Core.
See Note [No type-shadowing in Core] in GHC.Core
- - - - -
8b5a5020 by Simon Peyton Jones at 2026-04-05T00:58:57+01:00
Major refactor of free-variable functions
For some time we have had two free-variable mechanims for types:
* The "FV" mechanism, embodied in GHC.Utils.FV, which worked OK, but
was fragile where eta-expansion was concerned.
* The TyCoFolder mechanism, using a one-shot EndoOS accumulator
I finally got tired of this and refactored the whole thing, thereby
addressing #27080. Now we have
* `GHC.Types.Var.FV`, which has a composable free-variable result type,
very much in the spirit of the old `FV`, but much more robust.
(It uses the "one shot trick".)
* GHC.Core.TyCo.FVs now has just one technology for free variables.
All this led to a lot of renaming.
There are couple of error-message changes. The change in T18451
makes an already-poor error message even more mysterious. But
it really needs a separate look.
We also now traverse the AST in a different order leading to a different
but still deterministic order for FVs and test output has been adjusted
accordingly.
- - - - -
4bf040c6 by sheaf at 2026-04-05T14:56:29-04:00
Add utility pprTrace_ function
This function is useful for quick debugging, as it can be added to a
where clause to pretty-print debugging information:
fooBar x y
| cond = body1
| otherwise = body2
where
!_ = pprTrace_ "fooBar" $
vcat [ text "x:" <+> ppr x
, text "y:" <+> ppr y
, text "cond:" <+> ppr cond
]
- - - - -
941b4641 by Simon Jakobi at 2026-04-07T06:05:12+02:00
Use upsert for non-deleting map updates
Some compiler functions were using `alter`, despite never removing
any entries: they only update an existing entry or insert a new one.
These functions are converted to using `upsert`:
alter :: (Maybe a -> Maybe a) -> Key -> Map a -> Map a
upsert :: (Maybe a -> a) -> Key -> Map a -> Map a
`upsert` variants are also added to APIs of the various Word64Map
wrapper types.
The precedent for this `upsert` operation is in the containers library:
see https://github.com/haskell/containers/pull/1145
Metrics: compile_time/bytes allocated
-------------------------------------
geo. mean: -0.1%
minimum: -0.5%
maximum: +0.0%
Resolves #27140.
- - - - -
385 changed files:
- .gitlab/ci.sh
- .gitlab/issue_templates/default.md
- compiler/GHC.hs
- compiler/GHC/Builtin/PrimOps.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/Cmm/Dataflow/Graph.hs
- compiler/GHC/Cmm/Dataflow/Label.hs
- compiler/GHC/CmmToAsm/CFG.hs
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/LA64/Instr.hs
- compiler/GHC/CmmToAsm/LA64/Ppr.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/RoughMap.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/Tidy.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCon/Env.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Data/FastString/Env.hs
- compiler/GHC/Data/Word64Map/Internal.hs
- compiler/GHC/Data/Word64Map/Lazy.hs
- compiler/GHC/Data/Word64Map/Strict.hs
- compiler/GHC/Data/Word64Map/Strict/Internal.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Phases.hs
- compiler/GHC/Hs/DocString.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Expr.hs-boot
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Expr.hs-boot
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Lit.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Splice.hs-boot
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Stg/Lint.hs
- compiler/GHC/StgToCmm/Heap.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Do.hs
- + compiler/GHC/Tc/Gen/Expand.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs-boot
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Match.hs-boot
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Instance/FunDeps.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/Solver/Types.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Class.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/BasicTypes.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/CtLoc.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Types/Origin.hs-boot
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/TcType.hs-boot
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Types/Error.hs
- + compiler/GHC/Types/Error.hs-boot
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/Name/Env.hs
- compiler/GHC/Types/Name/Occurrence.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/Name/Set.hs
- compiler/GHC/Types/SrcLoc.hs
- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Var/Env.hs
- + compiler/GHC/Types/Var/FV.hs
- compiler/GHC/Types/Var/Set.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/State.hs
- + compiler/GHC/Unit/State.hs-boot
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/EndoOS.hs
- − compiler/GHC/Utils/FV.hs
- compiler/GHC/Utils/Logger.hs
- compiler/GHC/Utils/Trace.hs
- compiler/GHC/Wasm/ControlFlow/FromCmm.hs
- compiler/Language/Haskell/Syntax/Module/Name.hs
- compiler/ghc.cabal.in
- docs/users_guide/exts/control.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
- − m4/fp_check_timer_create.m4
- rts/HeapStackCheck.cmm
- rts/RtsSymbols.c
- rts/Timer.c
- rts/configure.ac
- rts/include/rts/Timer.h
- rts/include/stg/MiscClosures.h
- rts/include/stg/SMP.h
- rts/posix/Signals.c
- rts/posix/Signals.h
- rts/posix/Ticker.c
- − rts/posix/ticker/Setitimer.c
- − rts/posix/ticker/TimerCreate.c
- testsuite/driver/testlib.py
- testsuite/tests/ado/ado004.hs
- testsuite/tests/annotations/should_fail/annfail02.hs
- testsuite/tests/annotations/should_fail/annfail02.stderr
- testsuite/tests/arityanal/should_compile/Arity01.stderr
- testsuite/tests/arityanal/should_compile/Arity05.stderr
- testsuite/tests/arityanal/should_compile/Arity08.stderr
- testsuite/tests/arityanal/should_compile/Arity11.stderr
- testsuite/tests/arityanal/should_compile/Arity14.stderr
- testsuite/tests/array/should_run/arr020.hs
- testsuite/tests/core-to-stg/T19700.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/cpranal/should_compile/T18401.stderr
- testsuite/tests/deSugar/should_fail/DsStrictFail.hs
- testsuite/tests/deriving/should_compile/T15798b.hs
- testsuite/tests/deriving/should_compile/T15798c.hs
- testsuite/tests/deriving/should_compile/T15798c.stderr
- testsuite/tests/deriving/should_compile/T24955a.hs
- testsuite/tests/deriving/should_compile/T24955a.stderr
- testsuite/tests/deriving/should_compile/T24955b.hs
- testsuite/tests/deriving/should_compile/T24955c.hs
- testsuite/tests/deriving/should_fail/T10598_fail4.hs
- testsuite/tests/deriving/should_fail/T10598_fail4.stderr
- testsuite/tests/deriving/should_fail/T10598_fail5.hs
- testsuite/tests/deriving/should_fail/T10598_fail5.stderr
- testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr
- testsuite/tests/dmdanal/sigs/T22241.hs
- testsuite/tests/driver/all.T
- testsuite/tests/driver/bytecode-object/Makefile
- testsuite/tests/driver/bytecode-object/all.T
- testsuite/tests/gadt/T20485.hs
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/ghci.debugger/scripts/break012.hs
- testsuite/tests/ghci.debugger/scripts/break012.stdout
- testsuite/tests/ghci/prog-mhu001/prog-mhu001c.stdout
- testsuite/tests/ghci/prog-mhu002/all.T
- testsuite/tests/ghci/scripts/Makefile
- testsuite/tests/ghci/should_run/all.T
- testsuite/tests/indexed-types/should_compile/T15322.hs
- testsuite/tests/indexed-types/should_compile/T15322.stderr
- testsuite/tests/indexed-types/should_fail/T2693.stderr
- testsuite/tests/indexed-types/should_fail/T5439.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/linear/should_fail/T18888.hs
- testsuite/tests/module/T20007.hs
- testsuite/tests/module/T20007.stderr
- testsuite/tests/module/mod90.hs
- testsuite/tests/module/mod90.stderr
- testsuite/tests/monadfail/MonadFailErrors.stderr
- testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.hs
- testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.hs
- testsuite/tests/overloadedrecflds/should_fail/T26480b.stderr
- testsuite/tests/overloadedrecflds/should_fail/all.T
- testsuite/tests/parser/should_fail/ParserNoLambdaCase.hs
- testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr
- testsuite/tests/parser/should_fail/T16270h.hs
- testsuite/tests/parser/should_fail/T16270h.stderr
- testsuite/tests/parser/should_fail/readFail001.hs
- testsuite/tests/parser/should_fail/readFail001.stderr
- testsuite/tests/partial-sigs/should_compile/SomethingShowable.hs
- testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
- testsuite/tests/partial-sigs/should_compile/T10403.stderr
- testsuite/tests/partial-sigs/should_compile/T12844.stderr
- testsuite/tests/partial-sigs/should_compile/T15039a.stderr
- testsuite/tests/partial-sigs/should_compile/T15039b.stderr
- testsuite/tests/partial-sigs/should_compile/T15039c.stderr
- testsuite/tests/partial-sigs/should_compile/T15039d.stderr
- testsuite/tests/partial-sigs/should_fail/T10999.stderr
- testsuite/tests/partial-sigs/should_fail/T12634.stderr
- + testsuite/tests/perf/compiler/T13960.hs
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/plugins/Makefile
- + testsuite/tests/plugins/T24486-plugin/Makefile
- + testsuite/tests/plugins/T24486-plugin/Setup.hs
- + testsuite/tests/plugins/T24486-plugin/T24486-plugin.cabal
- + testsuite/tests/plugins/T24486-plugin/T24486_Plugin.hs
- + testsuite/tests/plugins/T24486.hs
- + testsuite/tests/plugins/T24486_Helper.hs
- testsuite/tests/plugins/all.T
- testsuite/tests/plugins/late-plugin/LatePlugin.hs
- testsuite/tests/plugins/test-defaulting-plugin.stderr
- testsuite/tests/polykinds/T15789.stderr
- testsuite/tests/polykinds/T18451.stderr
- testsuite/tests/polykinds/T7151.hs
- testsuite/tests/polykinds/T7151.stderr
- testsuite/tests/polykinds/T7328.stderr
- testsuite/tests/polykinds/T7433.hs
- testsuite/tests/polykinds/T7433.stderr
- testsuite/tests/printer/T17697.stderr
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/programs/andy_cherry/test.T
- testsuite/tests/rebindable/rebindable6.stderr
- testsuite/tests/rename/should_fail/T10668.hs
- testsuite/tests/rename/should_fail/T10668.stderr
- testsuite/tests/rename/should_fail/T12681.hs
- testsuite/tests/rename/should_fail/T12681.stderr
- testsuite/tests/rename/should_fail/T13568.hs
- testsuite/tests/rename/should_fail/T13568.stderr
- testsuite/tests/rename/should_fail/T13644.hs
- testsuite/tests/rename/should_fail/T13644.stderr
- testsuite/tests/rename/should_fail/T13847.hs
- testsuite/tests/rename/should_fail/T13847.stderr
- testsuite/tests/rename/should_fail/T14032c.hs
- testsuite/tests/rename/should_fail/T19843l.hs
- testsuite/tests/rename/should_fail/T19843l.stderr
- testsuite/tests/rename/should_fail/T25901_imp_hq_fail_5.stderr
- testsuite/tests/rename/should_fail/T25901_imp_sq_fail_2.stderr
- testsuite/tests/rename/should_fail/T5385.hs
- testsuite/tests/rename/should_fail/T5385.stderr
- testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr
- testsuite/tests/roles/should_fail/Roles5.hs
- testsuite/tests/roles/should_fail/Roles5.stderr
- testsuite/tests/runghc/Makefile
- + testsuite/tests/runghc/T16145.hs
- + testsuite/tests/runghc/T16145.stdout
- + testsuite/tests/runghc/T16145_aux.hs
- testsuite/tests/runghc/all.T
- testsuite/tests/showIface/DocsInHiFile.hs
- testsuite/tests/showIface/DocsInHiFile1.stdout
- testsuite/tests/showIface/DocsInHiFileTH.hs
- testsuite/tests/showIface/DocsInHiFileTH.stdout
- testsuite/tests/showIface/DocsInHiFileTHExternal.hs
- testsuite/tests/showIface/HaddockIssue849.hs
- testsuite/tests/showIface/HaddockIssue849.stdout
- testsuite/tests/showIface/HaddockOpts.hs
- testsuite/tests/showIface/HaddockOpts.stdout
- testsuite/tests/showIface/HaddockSpanIssueT24378.hs
- testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
- testsuite/tests/showIface/MagicHashInHaddocks.hs
- testsuite/tests/showIface/MagicHashInHaddocks.stdout
- testsuite/tests/showIface/Makefile
- testsuite/tests/showIface/NoExportList.hs
- testsuite/tests/showIface/NoExportList.stdout
- testsuite/tests/showIface/PragmaDocs.stdout
- testsuite/tests/showIface/ReExports.stdout
- testsuite/tests/simplCore/T9646/test.T
- testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr
- testsuite/tests/simplCore/should_compile/T15205.stderr
- testsuite/tests/simplCore/should_compile/T21960.hs
- testsuite/tests/simplCore/should_compile/T24229a.stderr
- testsuite/tests/simplCore/should_compile/T24229b.stderr
- testsuite/tests/simplCore/should_compile/T24359a.stderr
- testsuite/tests/simplCore/should_compile/T26116.stderr
- testsuite/tests/simplCore/should_compile/T26709.stderr
- testsuite/tests/simplCore/should_compile/T4908.stderr
- testsuite/tests/simplCore/should_compile/spec-inline.stderr
- testsuite/tests/th/TH_Promoted1Tuple.hs
- testsuite/tests/th/TH_Roles1.hs
- testsuite/tests/typecheck/no_skolem_info/T20063.stderr
- + testsuite/tests/typecheck/should_compile/ExpansionQLIm.hs
- testsuite/tests/typecheck/should_compile/MutRec.hs
- testsuite/tests/typecheck/should_compile/T10770a.hs
- testsuite/tests/typecheck/should_compile/T11339.hs
- testsuite/tests/typecheck/should_compile/T11397.hs
- testsuite/tests/typecheck/should_compile/T13526.hs
- testsuite/tests/typecheck/should_compile/T14590.stderr
- testsuite/tests/typecheck/should_compile/T18467.hs
- testsuite/tests/typecheck/should_compile/T18467.stderr
- testsuite/tests/typecheck/should_compile/T25180.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/tc081.hs
- testsuite/tests/typecheck/should_compile/tc141.hs
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion1.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
- testsuite/tests/typecheck/should_fail/T10971d.stderr
- testsuite/tests/typecheck/should_fail/T12589.stderr
- testsuite/tests/typecheck/should_fail/T13311.stderr
- testsuite/tests/typecheck/should_fail/T17773.stderr
- testsuite/tests/typecheck/should_fail/T23427.hs
- testsuite/tests/typecheck/should_fail/T2846b.stderr
- testsuite/tests/typecheck/should_fail/T3323.stderr
- testsuite/tests/typecheck/should_fail/T3613.stderr
- testsuite/tests/typecheck/should_fail/T6069.stderr
- testsuite/tests/typecheck/should_fail/T6078.hs
- testsuite/tests/typecheck/should_fail/T7453.hs
- testsuite/tests/typecheck/should_fail/T7453.stderr
- testsuite/tests/typecheck/should_fail/T7851.stderr
- testsuite/tests/typecheck/should_fail/T7857.stderr
- testsuite/tests/typecheck/should_fail/T8570.hs
- testsuite/tests/typecheck/should_fail/T8570.stderr
- testsuite/tests/typecheck/should_fail/T8603.stderr
- testsuite/tests/typecheck/should_fail/T9612.stderr
- testsuite/tests/typecheck/should_fail/tcfail083.hs
- testsuite/tests/typecheck/should_fail/tcfail083.stderr
- testsuite/tests/typecheck/should_fail/tcfail084.hs
- testsuite/tests/typecheck/should_fail/tcfail084.stderr
- testsuite/tests/typecheck/should_fail/tcfail094.hs
- testsuite/tests/typecheck/should_fail/tcfail094.stderr
- testsuite/tests/typecheck/should_fail/tcfail102.stderr
- testsuite/tests/typecheck/should_fail/tcfail128.stderr
- testsuite/tests/typecheck/should_fail/tcfail140.stderr
- testsuite/tests/typecheck/should_fail/tcfail181.stderr
- testsuite/tests/typecheck/should_run/T1735.hs
- testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs
- testsuite/tests/typecheck/should_run/T3731.hs
- testsuite/tests/vdq-rta/should_fail/T24159_type_syntax_th_fail.script
- testsuite/tests/warnings/should_fail/CaretDiagnostics1.hs
- testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
- testsuite/tests/warnings/should_fail/T24396c.hs
- testsuite/tests/warnings/should_fail/T24396c.stderr
- testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b4929afd25b22f91ed92f80457bd8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b4929afd25b22f91ed92f80457bd8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sjakobi/upsert] Use upsert for non-deleting map updates
by Simon Jakobi (＠sjakobi2) 07 Apr '26
by Simon Jakobi (＠sjakobi2) 07 Apr '26
07 Apr '26
Simon Jakobi pushed to branch wip/sjakobi/upsert at Glasgow Haskell Compiler / GHC
Commits:
0b4929af by Simon Jakobi at 2026-04-07T05:58:46+02:00
Use upsert for non-deleting map updates
Some compiler functions were using `alter`, despite never removing
any entries: they only update an existing entry or insert a new one.
These functions are converted to using `upsert`:
alter :: (Maybe a -> Maybe a) -> Key -> Map a -> Map a
upsert :: (Maybe a -> a) -> Key -> Map a -> Map a
`upsert` variants are also added to APIs of the various Word64Map
wrapper types.
The precedent for this `upsert` operation is in the containers library:
see https://github.com/haskell/containers/pull/1145
Metrics: compile_time/bytes allocated
-------------------------------------
geo. mean: -0.1%
minimum: -0.5%
maximum: +0.0%
Resolves #27140.
- - - - -
20 changed files:
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/Cmm/Dataflow/Graph.hs
- compiler/GHC/Cmm/Dataflow/Label.hs
- compiler/GHC/CmmToAsm/CFG.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/RoughMap.hs
- compiler/GHC/Core/TyCon/Env.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Data/FastString/Env.hs
- compiler/GHC/Data/Word64Map/Internal.hs
- compiler/GHC/Data/Word64Map/Lazy.hs
- compiler/GHC/Data/Word64Map/Strict.hs
- compiler/GHC/Data/Word64Map/Strict/Internal.hs
- compiler/GHC/Tc/Solver/Types.hs
- compiler/GHC/Types/Name/Env.hs
- compiler/GHC/Types/Name/Occurrence.hs
- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Var/Env.hs
- compiler/GHC/Wasm/ControlFlow/FromCmm.hs
Changes:
=====================================
compiler/GHC/Cmm/CommonBlockElim.hs
=====================================
@@ -307,6 +307,6 @@ groupByInt :: (a -> Int) -> [a] -> [[a]]
groupByInt f xs = nonDetEltsUFM $ List.foldl' go emptyUFM xs
-- See Note [Unique Determinism and code generation]
where
- go m x = alterUFM addEntry m (f x)
+ go m x = strictUpsertUFM addEntry m (f x)
where
- addEntry xs = Just $! maybe [x] (x:) xs
+ addEntry = maybe [x] (x:)
=====================================
compiler/GHC/Cmm/Dataflow/Graph.hs
=====================================
@@ -56,10 +56,10 @@ bodyToBlockList body = mapElems body
addBlock
:: (NonLocal block, HasDebugCallStack)
=> block C C -> LabelMap (block C C) -> LabelMap (block C C)
-addBlock block body = mapAlter add lbl body
+addBlock block body = mapUpsert add lbl body
where
lbl = entryLabel block
- add Nothing = Just block
+ add Nothing = block
add _ = error $ "duplicate label " ++ show lbl ++ " in graph"
=====================================
compiler/GHC/Cmm/Dataflow/Label.hs
=====================================
@@ -38,6 +38,7 @@ module GHC.Cmm.Dataflow.Label
, mapInsertWith
, mapDelete
, mapAlter
+ , mapUpsert
, mapAdjust
, mapUnion
, mapUnions
@@ -207,6 +208,9 @@ mapDelete (Label k) (LM m) = LM (M.delete k m)
mapAlter :: (Maybe v -> Maybe v) -> Label -> LabelMap v -> LabelMap v
mapAlter f (Label k) (LM m) = LM (M.alter f k m)
+mapUpsert :: (Maybe v -> v) -> Label -> LabelMap v -> LabelMap v
+mapUpsert f (Label k) (LM m) = LM (M.upsert f k m)
+
mapAdjust :: (v -> v) -> Label -> LabelMap v -> LabelMap v
mapAdjust f (Label k) (LM m) = LM (M.adjust f k m)
=====================================
compiler/GHC/CmmToAsm/CFG.hs
=====================================
@@ -357,15 +357,14 @@ addImmediateSuccessor weights node follower cfg
-- | Adds a new edge, overwrites existing edges if present
addEdge :: BlockId -> BlockId -> EdgeInfo -> CFG -> CFG
addEdge from to info cfg =
- mapAlter addFromToEdge from $
- mapAlter addDestNode to cfg
+ mapUpsert addFromToEdge from $
+ mapUpsert addDestNode to cfg
where
-- Simply insert the edge into the edge list.
- addFromToEdge Nothing = Just $ mapSingleton to info
- addFromToEdge (Just wm) = Just $ mapInsert to info wm
+ addFromToEdge Nothing = mapSingleton to info
+ addFromToEdge (Just wm) = mapInsert to info wm
-- We must add the destination node explicitly
- addDestNode Nothing = Just $ mapEmpty
- addDestNode n@(Just _) = n
+ addDestNode = fromMaybe mapEmpty
-- | Adds a edge with the given weight to the cfg
@@ -610,11 +609,11 @@ getCfg platform weights graph =
edgelessCfg = mapFromList $ zip (map G.entryLabel blocks) (repeat mapEmpty)
insertEdge :: CFG -> ((BlockId,BlockId),EdgeInfo) -> CFG
insertEdge m ((from,to),weight) =
- mapAlter f from m
+ mapUpsert f from m
where
- f :: Maybe (LabelMap EdgeInfo) -> Maybe (LabelMap EdgeInfo)
- f Nothing = Just $ mapSingleton to weight
- f (Just destMap) = Just $ mapInsert to weight destMap
+ f :: Maybe (LabelMap EdgeInfo) -> LabelMap EdgeInfo
+ f Nothing = mapSingleton to weight
+ f (Just destMap) = mapInsert to weight destMap
getBlockEdges :: CmmBlock -> [((BlockId,BlockId),EdgeInfo)]
getBlockEdges block =
case branch of
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -4297,7 +4297,7 @@ unconditional-inlining for join points.
postInlineUnconditionally is primarily to push allocation into cold
branches; but a join point doesn't allocate, so that's a non-motivation.
-(DJ2) In mkDupableAlt and mkDupableStrictBind, generate an alterative for /all/
+(DJ2) In mkDupableAlt and mkDupableStrictBind, generate an alternative for /all/
alternatives, /except/ for ones that will definitely inline unconditionally
straight away. (In that case it's silly to make a join point in the first
place; it just takes an extra Simplifier iteration to undo.) This choice is
=====================================
compiler/GHC/Core/RoughMap.hs
=====================================
@@ -39,6 +39,7 @@ import GHC.Types.Name.Env
import Control.Monad (join)
import Data.Data (Data)
+import Data.Maybe (fromMaybe)
import GHC.Utils.Panic
{-
@@ -449,10 +450,9 @@ insertRM [] v rm@(RM {}) =
rm { rm_empty = v `consBag` rm_empty rm }
insertRM (RM_KnownTc k : ks) v rm@(RM {}) =
- rm { rm_known = alterDNameEnv f (rm_known rm) k }
+ rm { rm_known = upsertDNameEnv f (rm_known rm) k }
where
- f Nothing = Just $ (insertRM ks v emptyRM)
- f (Just m) = Just $ (insertRM ks v m)
+ f = insertRM ks v . fromMaybe emptyRM
insertRM (RM_WildCard : ks) v rm@(RM {}) =
rm { rm_wild = insertRM ks v (rm_wild rm) }
=====================================
compiler/GHC/Core/TyCon/Env.hs
=====================================
@@ -19,7 +19,7 @@ module GHC.Core.TyCon.Env (
extendTyConEnv_C, extendTyConEnv_Acc, extendTyConEnv,
extendTyConEnvList, extendTyConEnvList_C,
filterTyConEnv, anyTyConEnv,
- plusTyConEnv, plusTyConEnv_C, plusTyConEnv_CD, plusTyConEnv_CD2, alterTyConEnv,
+ plusTyConEnv, plusTyConEnv_C, plusTyConEnv_CD, plusTyConEnv_CD2, upsertTyConEnv, alterTyConEnv,
lookupTyConEnv, lookupTyConEnv_NF, delFromTyConEnv, delListFromTyConEnv,
elemTyConEnv, mapTyConEnv, disjointTyConEnv,
@@ -29,7 +29,7 @@ module GHC.Core.TyCon.Env (
lookupDTyConEnv,
delFromDTyConEnv, filterDTyConEnv,
mapDTyConEnv, mapMaybeDTyConEnv,
- adjustDTyConEnv, alterDTyConEnv, extendDTyConEnv, foldDTyConEnv
+ adjustDTyConEnv, upsertDTyConEnv, alterDTyConEnv, extendDTyConEnv, foldDTyConEnv
) where
import GHC.Prelude
@@ -57,6 +57,7 @@ mkTyConEnv :: [(TyCon,a)] -> TyConEnv a
mkTyConEnvWith :: (a -> TyCon) -> [a] -> TyConEnv a
nonDetTyConEnvElts :: TyConEnv a -> [a]
alterTyConEnv :: (Maybe a-> Maybe a) -> TyConEnv a -> TyCon -> TyConEnv a
+upsertTyConEnv :: (Maybe a -> a) -> TyConEnv a -> TyCon -> TyConEnv a
extendTyConEnv_C :: (a->a->a) -> TyConEnv a -> TyCon -> a -> TyConEnv a
extendTyConEnv_Acc :: (a->b->b) -> (a->b) -> TyConEnv b -> TyCon -> a -> TyConEnv b
extendTyConEnv :: TyConEnv a -> TyCon -> a -> TyConEnv a
@@ -85,6 +86,7 @@ extendTyConEnv x y z = addToUFM x y z
extendTyConEnvList x l = addListToUFM x l
lookupTyConEnv x y = lookupUFM x y
alterTyConEnv = alterUFM
+upsertTyConEnv = upsertUFM
mkTyConEnv l = listToUFM l
mkTyConEnvWith f = mkTyConEnv . map (\a -> (f a, a))
elemTyConEnv x y = elemUFM x y
@@ -137,6 +139,9 @@ adjustDTyConEnv = adjustUDFM
alterDTyConEnv :: (Maybe a -> Maybe a) -> DTyConEnv a -> TyCon -> DTyConEnv a
alterDTyConEnv = alterUDFM
+upsertDTyConEnv :: (Maybe a -> a) -> DTyConEnv a -> TyCon -> DTyConEnv a
+upsertDTyConEnv = upsertUDFM
+
extendDTyConEnv :: DTyConEnv a -> TyCon -> a -> DTyConEnv a
extendDTyConEnv = addToUDFM
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -2211,10 +2211,10 @@ extendFamEnv tc tys ty = UM $ \state ->
Unifiable (state { um_fam_env = extend (um_fam_env state) tc }, ())
where
extend :: FamSubstEnv -> TyCon -> FamSubstEnv
- extend = alterTyConEnv alter_tm
+ extend = upsertTyConEnv alter_tm
- alter_tm :: Maybe (ListMap TypeMap Type) -> Maybe (ListMap TypeMap Type)
- alter_tm m_elt = Just (alterTM tys (\_ -> Just ty) (m_elt `orElse` emptyTM))
+ alter_tm :: Maybe (ListMap TypeMap Type) -> ListMap TypeMap Type
+ alter_tm m_elt = alterTM tys (\_ -> Just ty) (m_elt `orElse` emptyTM)
umRnBndr2 :: UMEnv -> TyCoVar -> TyCoVar -> UMEnv
umRnBndr2 env v1 v2
=====================================
compiler/GHC/Data/FastString/Env.hs
=====================================
@@ -16,7 +16,7 @@ module GHC.Data.FastString.Env (
extendFsEnv_C, extendFsEnv_Acc, extendFsEnv,
extendFsEnvList, extendFsEnvList_C,
filterFsEnv,
- plusFsEnv, plusFsEnv_C, alterFsEnv,
+ plusFsEnv, plusFsEnv_C, alterFsEnv, upsertFsEnv,
lookupFsEnv, lookupFsEnv_NF, delFromFsEnv, delListFromFsEnv,
elemFsEnv, mapFsEnv, strictMapFsEnv, mapMaybeFsEnv,
nonDetFoldFsEnv,
@@ -46,6 +46,7 @@ type FastStringEnv a = UniqFM FastString a -- Domain is FastString
emptyFsEnv :: FastStringEnv a
mkFsEnv :: [(FastString,a)] -> FastStringEnv a
alterFsEnv :: (Maybe a-> Maybe a) -> FastStringEnv a -> FastString -> FastStringEnv a
+upsertFsEnv :: (Maybe a -> a) -> FastStringEnv a -> FastString -> FastStringEnv a
extendFsEnv_C :: (a->a->a) -> FastStringEnv a -> FastString -> a -> FastStringEnv a
extendFsEnv_Acc :: (a->b->b) -> (a->b) -> FastStringEnv b -> FastString -> a -> FastStringEnv b
extendFsEnv :: FastStringEnv a -> FastString -> a -> FastStringEnv a
@@ -69,6 +70,7 @@ extendFsEnv x y z = addToUFM x y z
extendFsEnvList x l = addListToUFM x l
lookupFsEnv x y = lookupUFM x y
alterFsEnv = alterUFM
+upsertFsEnv = upsertUFM
mkFsEnv l = listToUFM l
elemFsEnv x y = elemUFM x y
plusFsEnv x y = plusUFM x y
=====================================
compiler/GHC/Data/Word64Map/Internal.hs
=====================================
@@ -98,6 +98,7 @@ module GHC.Data.Word64Map.Internal (
, adjustWithKey
, update
, updateWithKey
+ , upsert
, updateLookupWithKey
, alter
, alterLookup
@@ -941,6 +942,24 @@ updateWithKey f k t@(Tip ky y)
| otherwise = t
updateWithKey _ _ Nil = Nil
+-- | \(O(\min(n,W))\). Update the value at a key or insert a value if the key is
+-- not in the map.
+--
+-- @
+-- let inc = maybe 1 (+1)
+-- upsert inc 100 (fromList [(100,1),(300,2)]) == fromList [(100,2),(300,2)]
+-- upsert inc 200 (fromList [(100,1),(300,2)]) == fromList [(100,1),(200,1),(300,2)]
+-- @
+upsert :: (Maybe a -> a) -> Key -> Word64Map a -> Word64Map a
+upsert f !k t@(Bin p m l r)
+ | nomatch k p m = link k (Tip k (f Nothing)) p t
+ | zero k m = Bin p m (upsert f k l) r
+ | otherwise = Bin p m l (upsert f k r)
+upsert f !k t@(Tip ky y)
+ | k == ky = Tip ky (f (Just y))
+ | otherwise = link k (Tip k (f Nothing)) ky t
+upsert f !k Nil = Tip k (f Nothing)
+
-- | \(O(\min(n,W))\). Lookup and update.
-- The function returns original value, if it is updated.
-- This is different behavior than 'Data.Map.updateLookupWithKey'.
=====================================
compiler/GHC/Data/Word64Map/Lazy.hs
=====================================
@@ -91,6 +91,7 @@ module GHC.Data.Word64Map.Lazy (
, adjustWithKey
, update
, updateWithKey
+ , upsert
, updateLookupWithKey
, alter
, alterLookup
=====================================
compiler/GHC/Data/Word64Map/Strict.hs
=====================================
@@ -109,6 +109,7 @@ module GHC.Data.Word64Map.Strict (
, adjustWithKey
, update
, updateWithKey
+ , upsert
, updateLookupWithKey
, alter
, alterF
=====================================
compiler/GHC/Data/Word64Map/Strict/Internal.hs
=====================================
@@ -111,6 +111,7 @@ module GHC.Data.Word64Map.Strict.Internal (
, adjustWithKey
, update
, updateWithKey
+ , upsert
, updateLookupWithKey
, alter
, alterF
@@ -536,6 +537,24 @@ updateWithKey f !k t =
| otherwise -> t
Nil -> Nil
+-- | \(O(\min(n,W))\). Update the value at a key or insert a value if the key is
+-- not in the map.
+--
+-- @
+-- let inc = maybe 1 (+1)
+-- upsert inc 100 (fromList [(100,1),(300,2)]) == fromList [(100,2),(300,2)]
+-- upsert inc 200 (fromList [(100,1),(300,2)]) == fromList [(100,1),(200,1),(300,2)]
+-- @
+upsert :: (Maybe a -> a) -> Key -> Word64Map a -> Word64Map a
+upsert f !k t@(Bin p m l r)
+ | nomatch k p m = link k (Tip k $! f Nothing) p t
+ | zero k m = Bin p m (upsert f k l) r
+ | otherwise = Bin p m l (upsert f k r)
+upsert f !k t@(Tip ky y)
+ | k == ky = Tip ky $! f (Just y)
+ | otherwise = link k (Tip k (f Nothing)) ky t
+upsert f !k Nil = Tip k $! f Nothing
+
-- | \(O(\min(n,W))\). Lookup and update.
-- The function returns original value, if it is updated.
-- This is different behavior than 'Data.Map.updateLookupWithKey'.
=====================================
compiler/GHC/Tc/Solver/Types.hs
=====================================
@@ -89,15 +89,15 @@ delTcApp :: TcAppMap a -> TyCon -> [Type] -> TcAppMap a
delTcApp m tc tys = adjustDTyConEnv (deleteTM tys) m tc
insertTcApp :: TcAppMap a -> TyCon -> [Type] -> a -> TcAppMap a
-insertTcApp m tc tys ct = alterDTyConEnv alter_tm m tc
+insertTcApp m tc tys ct = upsertDTyConEnv alter_tm m tc
where
- alter_tm mb_tm = Just (insertTM tys ct (mb_tm `orElse` emptyTM))
+ alter_tm mb_tm = insertTM tys ct (mb_tm `orElse` emptyTM)
alterTcApp :: forall a. TcAppMap a -> TyCon -> [Type] -> XT a -> TcAppMap a
-alterTcApp m tc tys upd = alterDTyConEnv alter_tm m tc
+alterTcApp m tc tys upd = upsertDTyConEnv alter_tm m tc
where
- alter_tm :: Maybe (ListMap LooseTypeMap a) -> Maybe (ListMap LooseTypeMap a)
- alter_tm m_elt = Just (alterTM tys upd (m_elt `orElse` emptyTM))
+ alter_tm :: Maybe (ListMap LooseTypeMap a) -> ListMap LooseTypeMap a
+ alter_tm m_elt = alterTM tys upd (m_elt `orElse` emptyTM)
filterTcAppMap :: forall a. (a -> Bool) -> TcAppMap a -> TcAppMap a
filterTcAppMap f m = mapMaybeDTyConEnv one_tycon m
=====================================
compiler/GHC/Types/Name/Env.hs
=====================================
@@ -19,7 +19,7 @@ module GHC.Types.Name.Env (
filterNameEnv, anyNameEnv,
mapMaybeNameEnv,
extendNameEnvListWith,
- plusNameEnv, plusNameEnv_C, plusNameEnv_CD, plusNameEnv_CD2, alterNameEnv,
+ plusNameEnv, plusNameEnv_C, plusNameEnv_CD, plusNameEnv_CD2, alterNameEnv, upsertNameEnv,
plusNameEnvList, plusNameEnvListWith,
lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
elemNameEnv, mapNameEnv, disjointNameEnv,
@@ -32,7 +32,10 @@ module GHC.Types.Name.Env (
lookupDNameEnv,
delFromDNameEnv, filterDNameEnv,
mapDNameEnv,
- adjustDNameEnv, alterDNameEnv, extendDNameEnv,
+ adjustDNameEnv,
+ upsertDNameEnv,
+ alterDNameEnv,
+ extendDNameEnv,
eltsDNameEnv, extendDNameEnv_C,
plusDNameEnv_C,
foldDNameEnv,
@@ -107,6 +110,7 @@ mkNameEnvWith :: (a -> Name) -> [a] -> NameEnv a
fromUniqMap :: UniqMap Name a -> NameEnv a
nonDetNameEnvElts :: NameEnv a -> [a]
alterNameEnv :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
+upsertNameEnv :: (Maybe a -> a) -> NameEnv a -> Name -> NameEnv a
extendNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
extendNameEnv_Acc :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv :: NameEnv a -> Name -> a -> NameEnv a
@@ -141,6 +145,7 @@ extendNameEnvList x l = addListToUFM x l
extendNameEnvListWith f x l = addListToUFM x (map (\a -> (f a, a)) l)
lookupNameEnv x y = lookupUFM x y
alterNameEnv = alterUFM
+upsertNameEnv = upsertUFM
mkNameEnv l = listToUFM l
mkNameEnvWith f = mkNameEnv . map (\a -> (f a, a))
fromUniqMap = mapUFM snd . getUniqMap
@@ -198,6 +203,9 @@ adjustDNameEnv = adjustUDFM
alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
alterDNameEnv = alterUDFM
+upsertDNameEnv :: (Maybe a -> a) -> DNameEnv a -> Name -> DNameEnv a
+upsertDNameEnv = upsertUDFM
+
extendDNameEnv :: DNameEnv a -> Name -> a -> DNameEnv a
extendDNameEnv = addToUDFM
=====================================
compiler/GHC/Types/Name/Occurrence.hs
=====================================
@@ -732,7 +732,7 @@ extendOccEnv_Acc f g (MkOccEnv env) (OccName ns s) =
MkOccEnv . extendFsEnv_Acc f' g' env s
where
f' :: a -> UniqFM NameSpace b -> UniqFM NameSpace b
- f' a bs = alterUFM (Just . \ case { Nothing -> g a ; Just b -> f a b }) bs ns
+ f' a bs = upsertUFM (\ case { Nothing -> g a ; Just b -> f a b }) bs ns
g' a = unitUFM ns (g a)
-- | Delete one element from an 'OccEnv'.
=====================================
compiler/GHC/Types/Unique/DFM.hs
=====================================
@@ -32,6 +32,7 @@ module GHC.Types.Unique.DFM (
delListFromUDFM,
adjustUDFM,
adjustUDFM_Directly,
+ upsertUDFM,
alterUDFM,
alterUDFM_L,
mapUDFM,
@@ -451,6 +452,23 @@ alterUDFM f (UDFM m i) k =
inject Nothing = Nothing
inject (Just v) = Just $ TaggedVal v i
+-- | The expression (@'upsertUDFM' f map k@) updates the value at @k@ or inserts
+-- a new value if @k@ is absent.
+--
+-- Like 'alterUDFM', updating an existing entry assigns it the current tag, so it
+-- becomes the newest element in deterministic iteration order.
+upsertUDFM
+ :: Uniquable key
+ => (Maybe elt -> elt) -- ^ How to adjust the element
+ -> UniqDFM key elt -- ^ Old 'UniqDFM'
+ -> key -- ^ @key@ of the element to adjust
+ -> UniqDFM key elt -- ^ New element at @key@ and modified 'UniqDFM'
+upsertUDFM f (UDFM m i) k =
+ UDFM (MS.upsert upsertf (getKey $ getUnique k) m) (i + 1)
+ where
+ upsertf Nothing = TaggedVal (f Nothing) i
+ upsertf (Just (TaggedVal v _)) = TaggedVal (f (Just v)) i
+
-- | The expression (@'alterUDFM_L' f map k@) alters value @x@ at @k@, or absence
-- thereof and returns the new element at @k@ if there is any.
-- 'alterUDFM_L' can be used to insert, delete, or update a value in
=====================================
compiler/GHC/Types/Unique/FM.hs
=====================================
@@ -42,8 +42,9 @@ module GHC.Types.Unique.FM (
addListToUFM,addListToUFM_C,
addToUFM_Directly,
addListToUFM_Directly,
- adjustUFM, alterUFM, alterUFM_L, alterUFM_Directly,
- adjustUFM_Directly,
+ adjustUFM, adjustUFM_Directly,
+ upsertUFM, strictUpsertUFM,
+ alterUFM, alterUFM_L, alterUFM_Directly,
delFromUFM,
delFromUFM_Directly,
delListFromUFM,
@@ -226,6 +227,22 @@ alterUFM
-> UniqFM key elt -- ^ result
alterUFM f (UFM m) k = UFM (M.alter f (getKey $ getUnique k) m)
+upsertUFM
+ :: Uniquable key
+ => (Maybe elt -> elt) -- ^ How to adjust
+ -> UniqFM key elt -- ^ old
+ -> key -- ^ new
+ -> UniqFM key elt -- ^ result
+upsertUFM f (UFM m) k = UFM (M.upsert f (getKey $ getUnique k) m)
+
+strictUpsertUFM
+ :: Uniquable key
+ => (Maybe elt -> elt) -- ^ How to adjust
+ -> UniqFM key elt -- ^ old
+ -> key -- ^ new
+ -> UniqFM key elt -- ^ result
+strictUpsertUFM f (UFM m) k = UFM (MS.upsert f (getKey $ getUnique k) m)
+
alterUFM_L
:: Uniquable key
=> (Maybe elt -> Maybe elt) -- ^ How to adjust
=====================================
compiler/GHC/Types/Var/Env.hs
=====================================
@@ -15,7 +15,7 @@ module GHC.Types.Var.Env (
strictPlusVarEnv, plusVarEnv, plusVarEnv_C,
strictPlusVarEnv_C, strictPlusVarEnv_C_Directly,
plusVarEnv_CD, plusMaybeVarEnv_C,
- plusVarEnvList, alterVarEnv,
+ plusVarEnvList, alterVarEnv, upsertVarEnv,
delVarEnvList, delVarEnv,
minusVarEnv,
lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
@@ -40,7 +40,7 @@ module GHC.Types.Var.Env (
isEmptyDVarEnv, foldDVarEnv, nonDetStrictFoldDVarEnv,
mapDVarEnv, filterDVarEnv,
modifyDVarEnv,
- alterDVarEnv,
+ alterDVarEnv, upsertDVarEnv,
plusDVarEnv, plusDVarEnv_C,
unitDVarEnv,
delDVarEnv,
@@ -509,6 +509,7 @@ mkVarEnv_Directly :: [(Unique, a)] -> VarEnv a
zipVarEnv :: [Var] -> [a] -> VarEnv a
unitVarEnv :: Var -> a -> VarEnv a
alterVarEnv :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> VarEnv a
+upsertVarEnv :: (Maybe a -> a) -> VarEnv a -> Var -> VarEnv a
extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b
@@ -548,6 +549,7 @@ elemVarEnv = elemUFM
elemVarEnvByKey = elemUFM_Directly
disjointVarEnv = disjointUFM
alterVarEnv = alterUFM
+upsertVarEnv = upsertUFM
extendVarEnv = addToUFM
extendVarEnv_C = addToUFM_C
extendVarEnv_Acc = addToUFM_Acc
@@ -671,6 +673,9 @@ mapMaybeDVarEnv f = mapMaybeUDFM f
alterDVarEnv :: (Maybe a -> Maybe a) -> DVarEnv a -> Var -> DVarEnv a
alterDVarEnv = alterUDFM
+upsertDVarEnv :: (Maybe a -> a) -> DVarEnv a -> Var -> DVarEnv a
+upsertDVarEnv = upsertUDFM
+
plusDVarEnv :: DVarEnv a -> DVarEnv a -> DVarEnv a
plusDVarEnv = plusUDFM
=====================================
compiler/GHC/Wasm/ControlFlow/FromCmm.hs
=====================================
@@ -330,9 +330,9 @@ smartPlus platform e k =
where width = cmmExprWidth platform e
addToList :: ([a] -> [a]) -> Label -> LabelMap [a] -> LabelMap [a]
-addToList consx = mapAlter add
- where add Nothing = Just (consx [])
- add (Just xs) = Just (consx xs)
+addToList consx = mapUpsert add
+ where add Nothing = consx []
+ add (Just xs) = consx xs
------------------------------------------------------------------
--- everything below here is for diagnostics in case of panic
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b4929afd25b22f91ed92f80457bd8f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b4929afd25b22f91ed92f80457bd8f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
06 Apr '26
Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC
Commits:
e7e805a2 by Simon Peyton Jones at 2026-04-07T00:51:06+01:00
Wibble
- - - - -
1 changed file:
- utils/check-exact/Utils.hs
Changes:
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -557,15 +557,13 @@ isSymbolRdrName n = isSymOcc $ rdrNameOcc n
rdrName2String :: RdrName -> String
rdrName2String r =
- case rdrNameExactName_maybe r of
- Just n -> name2String n
- Nothing ->
case r of
Unqual occ -> occNameString occ
Qual modname occ -> moduleNameString modname ++ "."
++ occNameString occ
- Orig _ occ -> occNameString occ
- Exact n -> getOccString n
+ Orig _ occ -> occNameString occ
+ Exact (ExactOcc occ) -> occNameString occ
+ Exact (ExactName n) -> name2String n
name2String :: Name -> String
name2String = showPprUnsafe
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7e805a2ed26a86d343e54b101c9fc1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7e805a2ed26a86d343e54b101c9fc1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/T27156] move SectionL and SectionR into tcExpand
by Apoorv Ingle (＠ani) 06 Apr '26
by Apoorv Ingle (＠ani) 06 Apr '26
06 Apr '26
Apoorv Ingle pushed to branch wip/ani/T27156 at Glasgow Haskell Compiler / GHC
Commits:
d56976e2 by Apoorv Ingle at 2026-04-06T18:39:54-05:00
move SectionL and SectionR into tcExpand
Work on #27156
- - - - -
2 changed files:
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Tc/Gen/Expand.hs
Changes:
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -50,7 +50,6 @@ import GHC.Unit.Module ( isInteractiveModule )
import GHC.Types.Basic (TypeOrKind (TypeLevel))
import GHC.Types.FieldLabel
-import GHC.Types.Id.Make
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Reader
@@ -714,25 +713,14 @@ rnSection section@(SectionR x op expr)
= do { (op', fvs_op) <- rnLExpr op
; (expr', fvs_expr) <- rnLExpr expr
; checkSectionPrec InfixR section op' expr'
- ; let rn_section = SectionR x op' expr'
- ds_section = genHsApps rightSectionName [op',expr']
- ; return ( mkExpandedExpr rn_section ds_section
- , fvs_op `plusFN` fvs_expr) }
+ ; return $ (SectionR x op' expr' , fvs_op `plusFN` fvs_expr) }
rnSection section@(SectionL x expr op)
-- See Note [Left and right sections]
= do { (expr', fvs_expr) <- rnLExpr expr
; (op', fvs_op) <- rnLExpr op
; checkSectionPrec InfixL section op' expr'
- ; postfix_ops <- xoptM LangExt.PostfixOperators
- -- Note [Left and right sections]
- ; let rn_section = SectionL x expr' op'
- ds_section
- | postfix_ops = HsApp noExtField op' expr'
- | otherwise = genHsApps leftSectionName
- [wrapGenSpan $ HsApp noExtField op' expr']
- ; return ( mkExpandedExpr rn_section ds_section
- , fvs_op `plusFN` fvs_expr) }
+ ; return $ (SectionL x expr' op', fvs_op `plusFN` fvs_expr) }
rnSection other = pprPanic "rnSection" (ppr other)
=====================================
compiler/GHC/Tc/Gen/Expand.hs
=====================================
@@ -16,8 +16,12 @@ import GHC.Hs
import GHC.Tc.Utils.Monad
import GHC.Tc.Types.ErrCtxt
+import GHC.Types.Id.Make
+
import GHC.Rename.Utils
+import qualified GHC.LanguageExtensions as LangExt
+
{- Note [Typechecking by expansion: overview]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For many constructs, rather than typechecking the user-written code
@@ -110,6 +114,23 @@ tcExpand e@(OpApp _ arg1 op arg2)
where
ap f a = wrapGenSpan (HsApp noExtField f a)
+tcExpand e@(SectionR _ op expr)
+ = return $ Just $
+ HSE { hse_ctxt = ExprCtxt e
+ , hse_exp = wrapGenSpan $ genHsApps rightSectionName [op, expr] }
+
+tcExpand e@(SectionL _ expr op)
+ = do { postfix_ops <- xoptM LangExt.PostfixOperators
+ -- Note [Left and right sections]
+ ; let ds_section
+ | postfix_ops = HsApp noExtField op expr
+ | otherwise = genHsApps leftSectionName
+ [wrapGenSpan $ HsApp noExtField op expr]
+ ; return $ Just $
+ HSE { hse_ctxt = ExprCtxt e
+ , hse_exp = wrapGenSpan ds_section } }
+
+
tcExpand (XExpr (ExpandedThingRn hse))
= return (Just hse)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d56976e240ef0126160a6d9771d8272…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d56976e240ef0126160a6d9771d8272…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: base: improve error message for Data.Char.chr
by Marge Bot (＠marge-bot) 06 Apr '26
by Marge Bot (＠marge-bot) 06 Apr '26
06 Apr '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
ba49d2eb by Andrew Lelechenko at 2026-04-06T19:26:44-04:00
base: improve error message for Data.Char.chr
As per https://github.com/haskell/core-libraries-committee/issues/384
- - - - -
84c751d4 by Simon Peyton Jones at 2026-04-06T19:26:45-04:00
Refactor FunResCtxt a bit
Fixes #27154
- - - - -
10 changed files:
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- libraries/base/changelog.md
- libraries/base/tests/enum01.stdout
- libraries/base/tests/enum01.stdout-alpha-dec-osf3
- libraries/base/tests/enum01.stdout-ws-64
- libraries/ghc-internal/src/GHC/Internal/Char.hs
Changes:
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -7710,12 +7710,8 @@ pprHsCtxt = \case
PatSigErrCtxt sig_ty res_ty ->
vcat [ hang (text "When checking that the pattern signature:")
4 (ppr sig_ty)
- , nest 2 (hang (text "fits the type of its context:") 2 pp_res_ty) ]
- where
- -- Zonking will have turned Infer into Check
- pp_res_ty = case res_ty of
- Check ty -> ppr ty
- Infer ir -> text "OOPS" <+> ppr ir
+ , nest 2 (hang (text "fits the type of its context:")
+ 2 (ppr (getCheckExpType res_ty))) ]
PatCtxt pat ->
hang (text "In the pattern:") 2 (ppr pat)
@@ -7777,7 +7773,7 @@ pprHsCtxt = \case
full_herald = pprExpectedFunTyHerald herald
<+> speakNOf n_vis_args_in_call (text "visible argument")
-- What are "visible" arguments? See Note [Visibility and arity] in GHC.Types.Basic
- FunResCtxt fun n_val_args res_fun res_env n_fun n_env
+ FunResCtxt fun n_val_args fun_res_ty env_ty
| -- Check for too few args
-- fun_tau = a -> b, res_tau = Int
n_fun > n_env
@@ -7801,6 +7797,18 @@ pprHsCtxt = \case
-> empty
-- text "Debug" <+> vcat [ppr fun, ppr n_val_args, ppr res_fun, ppr res_env, ppr n_fun, ppr n_env]
where
+ -- See Note [Splitting nested sigma types in mismatched
+ -- function types]
+ -- env_ty is an ExpRhoTy, but with simple subsumption it
+ -- is not /deeply/ skolemised, so still use tcSplitNestedSigmaTys
+
+ (_,_,fun_tau) = tcSplitNestedSigmaTys fun_res_ty
+ (_, _, env_tau) = tcSplitNestedSigmaTys (getCheckExpType env_ty)
+ (args_fun, res_fun) = tcSplitFunTys fun_tau
+ (args_env, res_env) = tcSplitFunTys env_tau
+ n_fun = length args_fun
+ n_env = length args_env
+
not_fun ty -- ty is definitely not an arrow type,
-- and cannot conceivably become one
= case tcSplitTyConApp_maybe ty of
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -68,7 +68,6 @@ import GHC.Builtin.Names
import GHC.Driver.DynFlags
import GHC.Utils.Misc
import GHC.Utils.Outputable as Outputable
-import GHC.Utils.Panic
import GHC.Data.Maybe
@@ -961,7 +960,8 @@ See Note [-fno-code mode].
* *
********************************************************************* -}
-addFunResCtxt :: HsExpr GhcTc -> [HsExprArg p]
+addFunResCtxt :: HasDebugCallStack
+ => HsExpr GhcTc -> [HsExprArg p]
-> TcType -> ExpRhoType
-> TcM a -> TcM a
-- When we have a mis-match in the return type of a function
@@ -969,33 +969,10 @@ addFunResCtxt :: HsExpr GhcTc -> [HsExprArg p]
-- But not in generated code, where we don't want
-- to mention internal (rebindable syntax) function names
addFunResCtxt fun args fun_res_ty env_ty thing_inside
- = do { env_tv <- newFlexiTyVarTy liftedTypeKind
- ; dumping <- doptM Opt_D_dump_tc_trace
- ; msg <- mk_msg dumping env_tv
- ; addErrCtxt msg thing_inside }
+ = addErrCtxt (FunResCtxt fun (count isValArg args) fun_res_ty env_ty) $
+ thing_inside
-- NB: use a landmark error context, so that an empty context
-- doesn't suppress some more useful context
- where
- mk_msg dumping env_tv
- = do { mb_env_ty <- readExpType_maybe env_ty
- -- by the time the message is rendered, the ExpType
- -- will be filled in (except if we're debugging)
- ; env' <- case mb_env_ty of
- Just env_ty -> return env_ty
- Nothing -> do { massert dumping; return env_tv }
- ; let -- See Note [Splitting nested sigma types in mismatched
- -- function types]
- (_, _, fun_tau) = tcSplitNestedSigmaTys fun_res_ty
- (_, _, env_tau) = tcSplitNestedSigmaTys env'
- -- env_ty is an ExpRhoTy, but with simple subsumption it
- -- is not deeply skolemised, so still use tcSplitNestedSigmaTys
- (args_fun, res_fun) = tcSplitFunTys fun_tau
- (args_env, res_env) = tcSplitFunTys env_tau
- info =
- FunResCtxt fun (count isValArg args) res_fun res_env
- (length args_fun) (length args_env)
- ; return info }
-
{-
Note [Splitting nested sigma types in mismatched function types]
=====================================
compiler/GHC/Tc/Types/ErrCtxt.hs
=====================================
@@ -251,7 +251,10 @@ data HsCtxt
-- | In the instance type signature of a class method.
| MethSigCtxt !Name !TcType !TcType
-- | In a pattern type signature.
+
| PatSigErrCtxt !TcType !ExpType
+ -- ExpType: see Note [ExpType in HsCtxt]
+
-- | In a pattern.
| PatCtxt !(Pat GhcRn)
-- | In a pattern synonym declaration.
@@ -268,7 +271,10 @@ data HsCtxt
-- | In a function call.
| FunTysCtxt !ExpectedFunTyCtxt !Type !Int !Int
-- | In the result of a function call.
- | FunResCtxt !(HsExpr GhcTc) !Int !Type !Type !Int !Int
+
+ | FunResCtxt !(HsExpr GhcTc) !Int !TcType !ExpType
+ -- ExpType: see Note [ExpType in HsCtxt]
+
-- | In the declaration of a type constructor.
| TyConDeclCtxt !Name !(TyConFlavour TyCon)
-- | In a type or data family instance (or default instance).
@@ -377,3 +383,14 @@ isHsCtxtLandmark (DerivBindCtxt{}) = True
isHsCtxtLandmark (FunResCtxt{}) = True
isHsCtxtLandmark (VDQWarningCtxt{}) = True
isHsCtxtLandmark _ = False
+
+{- Note [ExpType in HsCtxt]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A couple of HsCtxt constructors have ExpTypes in them. When zonking the
+Infer{} case we read the hole, which should be filled in by now, and zonk
+that type. Now we want to put it back: we use (Check ty') for this, so that
+clients of a zonked HsCtxt don't need to be monadic.
+
+Result: after zonking, these ExpTypes are always (Check ty). It woudl be nice
+to guarantee this statically, but it's hard to do so.
+-}
=====================================
compiler/GHC/Tc/Utils/TcType.hs
=====================================
@@ -28,7 +28,7 @@ module GHC.Tc.Utils.TcType (
ExpType(..), ExpKind, InferResult(..), InferInstFlag(..), InferFRRFlag(..),
ExpTypeFRR, ExpSigmaType, ExpSigmaTypeFRR,
ExpRhoType, ExpRhoTypeFRR,
- mkCheckExpType,
+ mkCheckExpType, getCheckExpType,
checkingExpType_maybe, checkingExpType,
ExpPatType(..), mkCheckExpFunPatTy, mkInvisExpPatType,
@@ -440,11 +440,12 @@ data InferInstFlag -- Specifies whether the inference should return an uninstan
| IIF_ShallowRho -- Trying to infer a shallow RhoType (no foralls or => at the top)
-- Top-instantiate (only, regardless of DeepSubsumption) before filling the hole
- -- Typically used when inferring the type of an expression
+ -- Used only for view patterns; see Note [View patterns and polymorphism]
| IIF_DeepRho -- Trying to infer a possibly-deep RhoType (depending on DeepSubsumption)
-- If DeepSubsumption is off, same as IIF_ShallowRho
-- If DeepSubsumption is on, instantiate deeply before filling the hole
+ -- Typically used when inferring the type of an expression
type ExpSigmaType = ExpType
type ExpRhoType = ExpType
@@ -490,6 +491,12 @@ instance Outputable InferResult where
mkCheckExpType :: TcType -> ExpType
mkCheckExpType = Check
+getCheckExpType :: HasDebugCallStack => ExpType -> TcType
+-- Expect a (Check ty).
+-- See Note [ExpType in HsCtxt] in GHC.Tc.Types.ErrCtxt
+getCheckExpType (Check ty) = ty
+getCheckExpType (Infer ir) = pprPanic "getCheckExpType" (ppr ir)
+
-- | Returns the expected type when in checking mode.
checkingExpType_maybe :: ExpType -> Maybe TcType
checkingExpType_maybe (Check ty) = Just ty
=====================================
compiler/GHC/Tc/Zonk/TcType.hs
=====================================
@@ -818,19 +818,26 @@ zonkTidyHsCtxt env e@(FunAppCtxt{}) = return (env, e)
zonkTidyHsCtxt env (FunTysCtxt ctxt ty i1 i2) = do
(env', ty') <- zonkTidyTcType env ty
return $ (env', FunTysCtxt ctxt ty' i1 i2)
-zonkTidyHsCtxt env (FunResCtxt e i1 ty1 ty2 i2 i3) = do
- (env', ty1') <- zonkTidyTcType env ty1
- (env', ty2') <- zonkTidyTcType env' ty2
- return $ (env', FunResCtxt e i1 ty1' ty2' i2 i3)
+zonkTidyHsCtxt env (FunResCtxt e n ty1 env_ty) = do
+ (env', ty1') <- zonkTidyTcType env ty1
+ (env', env_ty') <- zonkExpType env' env_ty
+ return $ (env', FunResCtxt e n ty1' env_ty')
zonkTidyHsCtxt env (PatSigErrCtxt sig_ty res_ty) = do
(env', sig_ty') <- zonkTidyTcType env sig_ty
- (env', res_ty') <-
- case res_ty of
- Check ty -> zonkTidyTcType env' ty
- Infer (IR {ir_ref = ref}) -> do -- inlining readExpTyp_maybe to avoid module dep loops
- mb_ty <- liftIO $ readIORef ref
- case mb_ty of
- Nothing -> error "zonkTidyHsCtxt PatSigErrCtxt"
- Just ty -> zonkTidyTcType env' ty
- return (env', PatSigErrCtxt sig_ty' (Check res_ty'))
+ (env', res_ty') <- zonkExpType env' res_ty
+ return (env', PatSigErrCtxt sig_ty' res_ty')
zonkTidyHsCtxt env p = return (env, p)
+
+zonkExpType :: TidyEnv -> ExpType -> ZonkM (TidyEnv, ExpType)
+-- Zonk Infer{} to Check. The hole should have been filled in by now
+zonkExpType env (Check ty)
+ = do { (env', ty') <- zonkTidyTcType env ty
+ ; return (env', Check ty') }
+zonkExpType env (Infer ir@(IR { ir_ref = ref }))
+ = do { -- inlining readExpTyp_maybe to avoid module dep loops
+ ; mb_ty <- liftIO $ readIORef ref
+ ; case mb_ty of
+ Nothing -> pprPanic "zonkTidyHsCtxt PatSigErrCtxt" (ppr ir)
+ Just ty -> do { (env', ty') <- zonkTidyTcType env ty
+ ; return (env', Check ty') } }
+
=====================================
libraries/base/changelog.md
=====================================
@@ -28,6 +28,7 @@
* Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387))
* Change `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. ([CLC proposal #371](github.com/haskell/core-libraries-committee/issues/371))
* Annotate `onException` continuation with `WhileHandling`. ([CLC Proposal #397](https://github.com/haskell/core-libraries-committee/issues/397))
+ * Improve error message for `Data.Char.chr`. ([CLC Proposal #384](https://github.com/haskell/core-libraries-committee/issues/384))
## 4.22.0.0 *TBA*
* Shipped with GHC 9.14.1
=====================================
libraries/base/tests/enum01.stdout
=====================================
@@ -81,7 +81,7 @@ Testing Enum Char:
pred (maxBound::Char) = '\1114110'
pred (minBound::Char) = error "Prelude.Enum.Char.pred: bad argument"
(map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]) = "{\NUL\1114111"
- (toEnum::Int->Char) (minBound::Int) = error "Prelude.chr: bad argument: (-2147483648)"
+ (toEnum::Int->Char) (minBound::Int) = error "Data.Char.chr: argument outside Unicode range: 0..1114111: (-2147483648)"
(map fromEnum ['X',minBound,maxBound]) = [88,0,1114111]
(take 7 ['\NUL' .. ]) = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK"
(take 7 ['\250' .. ]) = "\250\251\252\253\254\255\256"
=====================================
libraries/base/tests/enum01.stdout-alpha-dec-osf3
=====================================
@@ -65,7 +65,7 @@ Testing Enum Char:
pred (maxBound::Char) = '\1114110'
pred (minBound::Char) = error "Prelude.Enum.Char.pred: bad argument"
(map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]) = "{\NUL\1114111"
- (toEnum::Int->Char) (minBound::Int) = error "Prelude.chr: bad argument"
+ (toEnum::Int->Char) (minBound::Int) = error "Data.Char.chr: argument outside Unicode range: 0..1114111:"
(map fromEnum ['X',minBound,maxBound]) = [88,0,1114111]
(take 7 ['\NUL' .. ]) = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK"
(take 7 ['\250' .. ]) = "\250\251\252\253\254\255\256"
=====================================
libraries/base/tests/enum01.stdout-ws-64
=====================================
@@ -81,7 +81,7 @@ Testing Enum Char:
pred (maxBound::Char) = '\1114110'
pred (minBound::Char) = error "Prelude.Enum.Char.pred: bad argument"
(map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]) = "{\NUL\1114111"
- (toEnum::Int->Char) (minBound::Int) = error "Prelude.chr: bad argument: (-9223372036854775808)"
+ (toEnum::Int->Char) (minBound::Int) = error "Data.Char.chr: argument outside Unicode range: 0..1114111: (-9223372036854775808)"
(map fromEnum ['X',minBound,maxBound]) = [88,0,1114111]
(take 7 ['\NUL' .. ]) = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK"
(take 7 ['\250' .. ]) = "\250\251\252\253\254\255\256"
=====================================
libraries/ghc-internal/src/GHC/Internal/Char.hs
=====================================
@@ -12,7 +12,7 @@ module GHC.Internal.Char
import GHC.Internal.Classes (eqChar, neChar)
import GHC.Internal.Base (otherwise, (++))
-import GHC.Internal.Err (errorWithoutStackTrace)
+import GHC.Internal.Err (error)
import GHC.Internal.Show
import GHC.Internal.Prim (chr#, int2Word#, leWord#, Int#, Char#)
import GHC.Internal.Types (Char(..), Int(..), isTrue#)
@@ -29,4 +29,7 @@ safe_chr# i#
{-# NOINLINE chr_error #-}
chr_error :: Int# -> Char#
-chr_error i# = errorWithoutStackTrace ("Prelude.chr: bad argument: " ++ showSignedInt (I# 9#) (I# i#) "")
+chr_error i# = error ("Data.Char.chr: argument outside Unicode range: 0..1114111: " ++ showSignedInt (I# 9#) (I# i#) "")
+-- It's not really "Data.Char", but we assume that
+-- the majority of users will import it from "base:Data.Char"
+-- and not from "ghc-internal:GHC.Internal.Char".
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb2d16cb2e3c13178ad709a6bd90b4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb2d16cb2e3c13178ad709a6bd90b4…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/T27156] 4 commits: Add Invariant (NoTypeShadowing) to Core
by Apoorv Ingle (＠ani) 06 Apr '26
by Apoorv Ingle (＠ani) 06 Apr '26
06 Apr '26
Apoorv Ingle pushed to branch wip/ani/T27156 at Glasgow Haskell Compiler / GHC
Commits:
92a97015 by Simon Peyton Jones at 2026-04-05T00:58:57+01:00
Add Invariant (NoTypeShadowing) to Core
This commit addresses #26868, by adding
a new invariant (NoTypeShadowing) to Core.
See Note [No type-shadowing in Core] in GHC.Core
- - - - -
8b5a5020 by Simon Peyton Jones at 2026-04-05T00:58:57+01:00
Major refactor of free-variable functions
For some time we have had two free-variable mechanims for types:
* The "FV" mechanism, embodied in GHC.Utils.FV, which worked OK, but
was fragile where eta-expansion was concerned.
* The TyCoFolder mechanism, using a one-shot EndoOS accumulator
I finally got tired of this and refactored the whole thing, thereby
addressing #27080. Now we have
* `GHC.Types.Var.FV`, which has a composable free-variable result type,
very much in the spirit of the old `FV`, but much more robust.
(It uses the "one shot trick".)
* GHC.Core.TyCo.FVs now has just one technology for free variables.
All this led to a lot of renaming.
There are couple of error-message changes. The change in T18451
makes an already-poor error message even more mysterious. But
it really needs a separate look.
We also now traverse the AST in a different order leading to a different
but still deterministic order for FVs and test output has been adjusted
accordingly.
- - - - -
4bf040c6 by sheaf at 2026-04-05T14:56:29-04:00
Add utility pprTrace_ function
This function is useful for quick debugging, as it can be added to a
where clause to pretty-print debugging information:
fooBar x y
| cond = body1
| otherwise = body2
where
!_ = pprTrace_ "fooBar" $
vcat [ text "x:" <+> ppr x
, text "y:" <+> ppr y
, text "cond:" <+> ppr cond
]
- - - - -
cc06edd6 by Apoorv Ingle at 2026-04-06T18:07:30-05:00
move SectionL and SectionR into tcExpand
Work on #27156
- - - - -
92 changed files:
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Expr.hs-boot
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Lit.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Splice.hs-boot
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expand.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Instance/FunDeps.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Types/Name/Set.hs
- + compiler/GHC/Types/Var/FV.hs
- compiler/GHC/Types/Var/Set.hs
- compiler/GHC/Utils/EndoOS.hs
- − compiler/GHC/Utils/FV.hs
- compiler/GHC/Utils/Trace.hs
- compiler/ghc.cabal.in
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/cpranal/should_compile/T18401.stderr
- testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr
- testsuite/tests/indexed-types/should_fail/T2693.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/partial-sigs/should_compile/T10403.stderr
- testsuite/tests/partial-sigs/should_compile/T12844.stderr
- testsuite/tests/partial-sigs/should_compile/T15039a.stderr
- testsuite/tests/partial-sigs/should_compile/T15039b.stderr
- testsuite/tests/partial-sigs/should_compile/T15039c.stderr
- testsuite/tests/partial-sigs/should_compile/T15039d.stderr
- testsuite/tests/partial-sigs/should_fail/T10999.stderr
- testsuite/tests/partial-sigs/should_fail/T12634.stderr
- testsuite/tests/polykinds/T15789.stderr
- testsuite/tests/polykinds/T18451.stderr
- testsuite/tests/polykinds/T7328.stderr
- testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr
- testsuite/tests/simplCore/should_compile/T24229a.stderr
- testsuite/tests/simplCore/should_compile/T24229b.stderr
- testsuite/tests/simplCore/should_compile/T24359a.stderr
- testsuite/tests/simplCore/should_compile/T26116.stderr
- testsuite/tests/simplCore/should_compile/T4908.stderr
- testsuite/tests/simplCore/should_compile/spec-inline.stderr
- testsuite/tests/typecheck/no_skolem_info/T20063.stderr
- testsuite/tests/typecheck/should_compile/T25180.stderr
- testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T10971d.stderr
- testsuite/tests/typecheck/should_fail/T12589.stderr
- testsuite/tests/typecheck/should_fail/T13311.stderr
- testsuite/tests/typecheck/should_fail/T17773.stderr
- testsuite/tests/typecheck/should_fail/T2846b.stderr
- testsuite/tests/typecheck/should_fail/T7851.stderr
- testsuite/tests/typecheck/should_fail/T8603.stderr
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a045c0a7ca4eec8a1c9ac55ef070d1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a045c0a7ca4eec8a1c9ac55ef070d1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-reinstallable-base] Wibble check-exact
by Simon Peyton Jones (＠simonpj) 06 Apr '26
by Simon Peyton Jones (＠simonpj) 06 Apr '26
06 Apr '26
Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC
Commits:
89f87d1c by Simon Peyton Jones at 2026-04-07T00:02:22+01:00
Wibble check-exact
- - - - -
1 changed file:
- utils/check-exact/Utils.hs
Changes:
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -557,7 +557,7 @@ isSymbolRdrName n = isSymOcc $ rdrNameOcc n
rdrName2String :: RdrName -> String
rdrName2String r =
- case isExact_maybe r of
+ case rdrNameExactName_maybe r of
Just n -> name2String n
Nothing ->
case r of
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89f87d1ca7c23a459a8f71ee046cba9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89f87d1ca7c23a459a8f71ee046cba9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
06 Apr '26
Simon Peyton Jones pushed to branch wip/T26989 at Glasgow Haskell Compiler / GHC
Commits:
6afeb99e by Simon Peyton Jones at 2026-04-06T23:59:01+01:00
Getting there [skip ci]
- - - - -
6 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Rules.hs
- utils/check-exact/Utils.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -2294,11 +2294,12 @@ simplOutExpr :: SimplEnvIS -> OutExpr -> SimplCont -> SimplM (SimplFloats, OutEx
simplOutExpr env expr cont
= case fun of
Var v -> simplOutId env v cont'
- Lam {} | not (null args) -> simplLam env fun cont' -- We have a beta-redex
+ Lam {} | not (null args) -> simplLam env occ_fun cont' -- We have a beta-redex
_ -> rebuild_go env expr cont
where
- (fun, args) <- collectArgs expr
+ (fun, args) = collectArgs expr
cont' = pushArgs env Simplified (expType fun) args cont
+ occ_fun = occurAnalyseExpr fun -- ToDo:explain; c.f. Note [Occurrence-analyse after rule firing]
---------------------------------------------------------
simplOutId :: SimplEnvIS -> OutId -> SimplCont -> SimplM (SimplFloats, OutExpr)
@@ -2645,18 +2646,18 @@ See Note [No free join points in arityType] in GHC.Core.Opt.Arity
tryRules :: SimplEnv -> [CoreRule]
-> OutId -> [OutExpr]
- -> SimplM (Maybe (FullArgCount, CoreExpr))
+ -> SimplM (Maybe (FullArgCount, CoreExpr, [CoreExpr]))
tryRules env rules fn args
- | Just (rule, rule_rhs) <- lookupRule ropts in_scope_env
- act_fun fn args rules
+ | Just (rule, rule_rhs, rule_args) <- lookupRule ropts in_scope_env
+ act_fun fn args rules
-- Fire a rule for the function
= do { logger <- getLogger
; checkedTick (RuleFired (ruleName rule))
- ; let occ_anald_rhs = occurAnalyseExpr rule_rhs
- -- See Note [Occurrence-analyse after rule firing]
+-- ; let occ_anald_rhs = occurAnalyseExpr rule_rhs
+-- -- See Note [Occurrence-analyse after rule firing]
; dump logger rule rule_rhs
- ; return (Just (ruleArity rule, occ_anald_rhs)) }
+ ; return (Just (ruleArity rule, rhs_rhs, rule_args)) }
| otherwise -- No rule fires
= do { logger <- getLogger
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -22,7 +22,7 @@ module GHC.Core.Opt.Simplify.Utils (
-- The continuation type
SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv,
- isSimplified, contIsStop, contHasArgs,
+ isSimplified, contIsStop,
contIsDupable, contResultType, contHoleType, contHoleScaling,
contIsTrivial, contArgs, contIsRhs,
countArgs, contOutArgs, dropContArgs,
@@ -33,7 +33,7 @@ module GHC.Core.Opt.Simplify.Utils (
ArgInfo(..), ArgSpec(..), mkArgInfo,
addValArgTo, addTyArgTo,
argInfoExpr, argSpecArg,
- pushSimplifiedArgs, pushArgSpecs,
+ pushArgs, pushArgSpecs,
isStrictArgInfo, lazyArgContext,
abstractFloats,
@@ -389,13 +389,12 @@ pushArgs _env _dup _fun_ty [] cont
= cont
pushArgs env dup fun_ty (arg:args) cont
| Type ty <- arg
- = ApplyToType { sc_hole_ty = fun_ty
- , sc_arg_ty = ty, sc_env = env
- , sc_cont = pushArgs env dup (piResultTy fun_ty ty) args }
+ = ApplyToTy { sc_hole_ty = fun_ty, sc_arg_ty = ty
+ , sc_cont = pushArgs env dup (piResultTy fun_ty ty) args cont }
| otherwise
= ApplyToVal { sc_dup = dup, sc_hole_ty = fun_ty
, sc_arg = arg, sc_env = env
- , sc_cont = pushArgs env dup (funResultTy fun_ty) args }
+ , sc_cont = pushArgs env dup (funResultTy fun_ty) args cont}
pushArgSpecs :: SimplEnvIS -- Barely needed, since sc_dup = Simplified
-> [ArgSpec] -- In normal, forward order
@@ -451,11 +450,6 @@ contIsRhs (Stop _ (RhsCtxt is_rec) _) = Just is_rec
contIsRhs (CastIt { sc_cont = k }) = contIsRhs k -- For f = e |> co, treat e as Rhs context
contIsRhs _ = Nothing
--------------------
-contHasArgs (ApplyToTy {}) = True
-contHasArgs (ApplyToVal {}) = True
-contHasArgs _ = False
-
-------------------
contIsStop :: SimplCont -> Bool
contIsStop (Stop {}) = True
=====================================
compiler/GHC/Core/Opt/SpecConstr.hs
=====================================
@@ -2906,8 +2906,8 @@ betterPat is (CP { cp_qvars = vs1, cp_args = as1 })
(CP { cp_qvars = vs2, cp_args = as2 })
| equalLength as1 as2
= case matchExprs ise vs1 as1 as2 of
- Just (_, ms) -> all exprIsTrivial ms
- Nothing -> False
+ Just (ms,_,_) -> all exprIsTrivial ms
+ Nothing -> False
| otherwise -- We must handle patterns of unequal length separately (#24282)
= False -- For the pattern with more args, the last arg is "interesting"
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -1801,7 +1801,7 @@ alreadyCovered :: SpecEnv
alreadyCovered env bndrs fn args is_active rules
= case specLookupRule env fn args is_active rules of
Nothing -> False
- Just (rule, _)
+ Just (rule, _,_)
| isAutoRule rule -> -- Discard identical rules
-- We know that (fn args) is an instance of RULE
-- Check if RULE is an instance of (fn args)
@@ -1820,7 +1820,8 @@ specLookupRule env fn args is_active rules
| null rules
= Nothing -- Saves building a few thunks in the common case
| otherwise
- = lookupRule ropts in_scope_env is_active fn args rules
+ = case lookupRule ropts in_scope_env is_active fn args rules of
+ Just (rule, rule_rhs, rule_args) -> Just (rule, mkApps rule_rhs rule_args)
where
dflags = se_dflags env
in_scope = substInScopeSet (se_subst env)
=====================================
compiler/GHC/Core/Rules.hs
=====================================
@@ -9,7 +9,7 @@
-- The 'CoreRule' datatype itself is declared elsewhere.
module GHC.Core.Rules (
-- ** Looking up rules
- lookupRule, matchExprs, ruleLhsIsMoreSpecific,
+ RuleMatch(..), lookupRule, matchExprs, ruleLhsIsMoreSpecific,
-- ** RuleBase, RuleEnv
RuleBase, RuleEnv(..), mkRuleEnv, emptyRuleEnv,
@@ -542,6 +542,23 @@ map.
************************************************************************
-}
+data RuleMatch
+ = RM { rm_rule :: CoreRule
+ , rm_rhs :: CoreExpr
+ , rm_args :: [CoreExpr]
+ , rm_binds :: BindWrapper -- Floated let-bindings
+ -- See Note [Matching lets]
+ , rm_bndrs :: [Var] -- Binders of rm_binds
+ }
+ -- E.g. match r = RULE forall x,y. f (Just (y,x)) = g x y True
+ -- target f (let v = ev in Just (ey, ex)) ez
+ -- We get the RuleMatch
+ -- RMM { rm_rule = r, rm_rhs = \xy. g x y True
+ -- , rm_args = [ex, ey]
+ -- , rm_binds = Let v=ev, rm_bndrs = [v] )
+ -- The leftover `ez` is not returned; the caller is responsible for
+ -- counting (ruleArity r) arguments
+
-- | The main rule matching function. Attempts to apply all (active)
-- supplied rules to this instance of an application in a given
-- context, returning the rule applied and the resulting expression if
@@ -552,7 +569,7 @@ lookupRule :: HasDebugCallStack
-> Id -- Function head
-> [CoreExpr] -- Args
-> [CoreRule] -- Rules
- -> Maybe (CoreRule, CoreExpr)
+ -> Maybe RuleMatch
-- See Note [Extra args in the target]
-- See comments on matchRule
@@ -564,17 +581,17 @@ lookupRule opts rule_env@(ISE in_scope _) is_active fn args rules
where
rough_args = map roughTopName args
- -- Strip ticks from arguments, see Note [Tick annotations in RULE
- -- matching]. We only collect ticks if a rule actually matches -
+ -- Strip ticks from arguments, see Note [Tick annotations in RULE matching]
+ -- We only collect ticks if a rule actually matches -
-- this matters for performance tests.
args' = map (stripTicksTopE tickishFloatable) args
ticks = concatMap (stripTicksTopT tickishFloatable) args
- go :: [(CoreRule,CoreExpr)] -> [CoreRule] -> [(CoreRule,CoreExpr)]
+ go :: [RuleMatch] -> [CoreRule] -> [RuleMatch]
go ms [] = ms
go ms (r:rs)
- | Just e <- matchRule opts rule_env is_active fn args' rough_args r
- = go ((r,mkTicks ticks e):ms) rs
+ | Just rm <- matchRule opts rule_env is_active fn args' rough_args r
+ = go (rm { rm_binds = mkTicks ticks . rm_binds rm } : ms) rs
| otherwise
= -- pprTrace "match failed" (ppr r $$ ppr args $$
-- ppr [ (arg_id, maybeUnfoldingTemplate unf)
@@ -583,35 +600,38 @@ lookupRule opts rule_env@(ISE in_scope _) is_active fn args rules
-- , isCheapUnfolding unf] )
go ms rs
-findBest :: InScopeSet -> (Id, [CoreExpr])
- -> (CoreRule,CoreExpr) -> [(CoreRule,CoreExpr)] -> (CoreRule,CoreExpr)
+findBest :: InScopeSet
+ -> (Id, [CoreExpr]) -- Target, just for overlap reporting
+ -> RuleMatch -- Most specific so far
+ -> [RuleMatch]
+ -> RuleMatch
-- All these pairs matched the expression
-- Return the pair the most specific rule
-- The (fn,args) is just for overlap reporting
-findBest _ _ (rule,ans) [] = (rule,ans)
-findBest in_scope target (rule1,ans1) ((rule2,ans2):prs)
- | ruleIsMoreSpecific in_scope rule1 rule2 = findBest in_scope target (rule1,ans1) prs
- | ruleIsMoreSpecific in_scope rule2 rule1 = findBest in_scope target (rule2,ans2) prs
- | debugIsOn = let pp_rule rule
+findBest _ _ rm [] = rm
+findBest in_scope target rm1 (rm2: rms)
+ | ruleIsMoreSpecific in_scope rm1 rm2 = findBest in_scope target rm1 rms
+ | ruleIsMoreSpecific in_scope rm2 rm1 = findBest in_scope target rm2 rms
+ | debugIsOn = let pp_rule (RM { rm_rule = rule })
= ifPprDebug (ppr rule)
(doubleQuotes (ftext (ruleName rule)))
in pprTrace "Rules.findBest: rule overlap (Rule 1 wins)"
(vcat [ whenPprDebug $
text "Expression to match:" <+> ppr fn
<+> sep (map ppr args)
- , text "Rule 1:" <+> pp_rule rule1
- , text "Rule 2:" <+> pp_rule rule2]) $
- findBest in_scope target (rule1,ans1) prs
- | otherwise = findBest in_scope target (rule1,ans1) prs
+ , text "Rule 1:" <+> pp_rule rm1
+ , text "Rule 2:" <+> pp_rule rm2]) $
+ findBest in_scope target rm1 rms
+ | otherwise = findBest in_scope target rm1 rms
where
(fn,args) = target
-ruleIsMoreSpecific :: InScopeSet -> CoreRule -> CoreRule -> Bool
+ruleIsMoreSpecific :: InScopeSet -> RuleMatch -> RuleMatch -> Bool
-- The call (rule1 `ruleIsMoreSpecific` rule2)
-- sees if rule2 can be instantiated to look like rule1
-- See Note [ruleIsMoreSpecific]
-ruleIsMoreSpecific in_scope rule1 rule2
+ruleIsMoreSpecific in_scope (RM { rm_rule = rule1 }) (RM { rm_rule = rule2 })
= case rule1 of
BuiltinRule {} -> False
Rule { ru_bndrs = bndrs1, ru_args = args1 }
@@ -682,7 +702,7 @@ start, in general eta expansion wastes work. SLPJ July 99
matchRule :: HasDebugCallStack
=> RuleOpts -> InScopeEnv -> (ActivationGhc -> Bool)
-> Id -> [CoreExpr] -> [Maybe Name]
- -> CoreRule -> Maybe CoreExpr
+ -> CoreRule -> Maybe RuleMatch
-- If (matchRule rule args) returns Just (name,rhs)
-- then (f args) matches the rule, and the corresponding
@@ -708,26 +728,7 @@ matchRule :: HasDebugCallStack
--
-- NB: The 'surplus' argument e4 in the input is simply dropped.
-- See Note [Extra args in the target]
-
-matchRule opts rule_env _is_active fn args _rough_args
- (BuiltinRule { ru_try = match_fn })
- | not (roBuiltinRules opts) = Nothing
- | otherwise = match_fn opts rule_env fn args
-
-matchRule _ rule_env is_active _ args rough_args
- (Rule { ru_name = rule_name, ru_act = act, ru_rough = tpl_tops
- , ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs })
- | not (is_active act) = Nothing
- | ruleCantMatch tpl_tops rough_args = Nothing
- | otherwise = matchN rule_env rule_name tpl_vars tpl_args args rhs
-
-
----------------------------------------
-matchN :: HasDebugCallStack
- => InScopeEnv
- -> RuleName -> [Var] -> [CoreExpr]
- -> [CoreExpr] -> CoreExpr -- ^ Target; can have more elements than the template
- -> Maybe CoreExpr
+--
-- For a given match template and context, find bindings to wrap around
-- the entire result and what should be substituted for each template variable.
--
@@ -738,24 +739,43 @@ matchN :: HasDebugCallStack
-- trailing ones, returning the result of applying the rule to a prefix
-- of the actual arguments.
-matchN ise _rule_name tmpl_vars tmpl_es target_es rhs
- = do { (bind_wrapper, matched_es) <- matchExprs ise tmpl_vars tmpl_es target_es
- ; return (bind_wrapper $
- mkLams tmpl_vars rhs `mkApps` matched_es) }
+matchRule opts rule_env _is_active fn args _rough_args
+ rule@(BuiltinRule { ru_try = match_fn })
+ = do { guard (roBuiltinRules opts)
+ ; rhs <- match_fn opts rule_env fn args
+ ; return (RM { rm_rule = rule
+ , rm_rhs = rhs
+ , rm_args = []
+ , rm_binds = id
+ , rm_bndrs = [] }) }
+
+matchRule _opts rule_env is_active _fn target_es rough_args
+ rule@(Rule { ru_act = act, ru_rough = tpl_tops
+ , ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs })
+ | not (is_active act)
+ = Nothing
+ | ruleCantMatch tpl_tops rough_args
+ = Nothing
+ | otherwise
+ = do { (matched_es, bind_wrapper, wrap_bndrs)
+ <- matchExprs rule_env tpl_vars tpl_args target_es
+
+ ; return (RM { rm_rule = rule
+ , rm_rhs = mkLams tpl_vars rhs
+ , rm_args = matched_es
+ , rm_binds = bind_wrapper
+ , rm_bndrs = wrap_bndrs }) }
matchExprs :: HasDebugCallStack
=> InScopeEnv -> [Var] -> [CoreExpr] -> [CoreExpr]
- -> Maybe (BindWrapper, [CoreExpr]) -- 1-1 with the [Var]
+ -> Maybe ( [CoreExpr] -- 1-1 with the incoming [Var]
+ , BindWrapper, [Var]) -- Floated binds
matchExprs (ISE in_scope id_unf) tmpl_vars tmpl_es target_es
= do { rule_subst <- match_exprs init_menv emptyRuleSubst tmpl_es target_es
; let (_, matched_es) = mapAccumL (lookup_tmpl rule_subst)
(mkEmptySubst in_scope) $
tmpl_vars `zip` tmpl_vars1
-
- ; let bind_wrapper = rs_binds rule_subst
- -- Floated bindings; see Note [Matching lets]
-
- ; return (bind_wrapper, matched_es) }
+ ; return (matched_es, rs_binds rule_subst, rs_bndrs rule_subst) }
where
(init_rn_env, tmpl_vars1) = mapAccumL rnBndrL (mkRnEnv2 in_scope) tmpl_vars
-- See Note [Cloning the template binders]
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -556,7 +556,7 @@ isSymbolRdrName n = isSymOcc $ rdrNameOcc n
rdrName2String :: RdrName -> String
rdrName2String r =
- case isExact_maybe r of
+ case rdrNameExactName_maybe r of
Just n -> name2String n
Nothing ->
case r of
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6afeb99e9275295910474fa153bf6d1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6afeb99e9275295910474fa153bf6d1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Apoorv Ingle pushed new branch wip/ani/T27156 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ani/T27156
You're receiving this email because of your account on gitlab.haskell.org.
1
0
06 Apr '26
Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC
Commits:
d0530203 by Simon Peyton Jones at 2026-04-06T20:05:45+01:00
Wibbles
- - - - -
6 changed files:
- compiler/GHC/Builtin.hs
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- docs/users_guide/separate_compilation.rst
- libraries/base/src/GHC/KnownKeyNames.hs
Changes:
=====================================
compiler/GHC/Builtin.hs
=====================================
@@ -14,9 +14,10 @@
--
-- * given a 'Unique', looking up its corresponding known-key 'Name'
--
--- See Note [Known-key names] and Note [Oerview of wired-in things] for information
--- about the two types of prelude things in GHC.
---
+-- See Note [Overview of known-key entities]
+-- and Note [Overview of wired-in things] for information
+-- about the types of "known" things in GHC.
+
module GHC.Builtin (
-- * Main exports
wiredInNames, wiredInIds, ghcPrimIds,
@@ -386,6 +387,12 @@ Note [Overview of wired-in things]
* GHC.Iface.Make prunes out wired-in things before putting them in an interface file.
So interface files never contain wired-in things.
+
+See also
+ - Note [Drop wired-in things] in GHC.Iface.Tidy
+ - Note [Loading instances for wired-in things] in GHC.Iface.Load
+ - Note [Related uniques for wired-in things] in GHC.Builtin.Uniques
+ - Note [Declarations for wired-in things] in GHC.Tc.TyCl
-}
-- | This list is used to ensure that when you say "Prelude.map" in your source
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -591,7 +591,7 @@ gHC_INTERNAL_BASE, gHC_INTERNAL_ENUM,
gHC_INTERNAL_FLOAT, gHC_INTERNAL_TOP_HANDLER, gHC_INTERNAL_SYSTEM_IO, gHC_INTERNAL_DYNAMIC,
gHC_INTERNAL_TYPEABLE, gHC_INTERNAL_TYPEABLE_INTERNAL, gHC_INTERNAL_GENERICS,
gHC_INTERNAL_READ_PREC, gHC_INTERNAL_LEX, gHC_INTERNAL_INT, gHC_INTERNAL_WORD, gHC_INTERNAL_MONAD, gHC_INTERNAL_MONAD_FIX, gHC_INTERNAL_MONAD_FAIL,
- gHC_INTERNAL_ARROW, gHC_INTERNAL_DESUGAR, gHC_INTERNAL_RANDOM, gHC_INTERNAL_EXTS,
+ gHC_INTERNAL_ARROW, gHC_INTERNAL_DESUGAR, gHC_INTERNAL_RANDOM, gHC_INTERNAL_EXTS,
gHC_INTERNAL_CONTROL_EXCEPTION_BASE, gHC_INTERNAL_TYPEERROR, gHC_INTERNAL_TYPELITS, gHC_INTERNAL_TYPELITS_INTERNAL,
gHC_INTERNAL_TYPENATS, gHC_INTERNAL_TYPENATS_INTERNAL,
gHC_INTERNAL_DATA_COERCE, gHC_INTERNAL_DEBUG_TRACE, gHC_INTERNAL_UNSAFE_COERCE, gHC_INTERNAL_FOREIGN_C_CONSTPTR,
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -2427,12 +2427,12 @@ rep2X lift_dsm get_wrap n xs = do
; return (MkC $ (foldl' App (wrap (Var rep_id)) xs)) }
-krep2M :: KnownOcc -> [CoreExpr] -> MetaM (Core (M a))
+-- krep2M :: KnownOcc -> [CoreExpr] -> MetaM (Core (M a))
krep2 :: KnownOcc -> [CoreExpr] -> MetaM (Core (M a))
krep2_nw :: NotM a => KnownOcc -> [CoreExpr] -> MetaM (Core a)
krep2_nwDsM :: NotM a => KnownOcc -> [CoreExpr] -> DsM (Core a)
krep2 = krep2X lift (asks quoteWrapper)
-krep2M = krep2X lift (asks monadWrapper)
+-- krep2M = krep2X lift (asks monadWrapper)
krep2_nw n xs = lift (krep2_nwDsM n xs)
krep2_nwDsM = krep2X id (return id)
=====================================
compiler/GHC/Tc/Deriv/Utils.hs
=====================================
@@ -66,7 +66,6 @@ import GHC.Types.SrcLoc
import GHC.Types.Var.Set
import GHC.Builtin.Names
-import GHC.Builtin.RdrNames( compose_RDR )
import GHC.Builtin.Names.TH (liftClassKey)
import GHC.Utils.Misc
=====================================
docs/users_guide/separate_compilation.rst
=====================================
@@ -1656,7 +1656,7 @@ defined in the libraries ``ghc-internal`` or ``base``. These include the classe
``Num``, ``Show``, etc, the types ``Rational``, ``Ratio`` etc, and much
more. These entities have so-called "known-key" names.
-You can read ``Note [Overview of known-key names]`` in GHC's source code
+You can read ``Note [Overview of known-key entities]`` in GHC's source code
to understand more. The behaviour of known-key names is controlled by two
flags:
@@ -1681,4 +1681,10 @@ flags:
called "Rational" in this module is *the* known-key ``Rational`` and not
some other random type or class that happens to be called "Rational".
+.. ghc-flag:: -fexclude-known-key-define=(name)
+ :shortdesc: Do not treat a definition of (name) as a definition of a known-key entity
+ :type: dynamic
+ :category:
+
+ You can use this flag multiple times to excludes several names.
=====================================
libraries/base/src/GHC/KnownKeyNames.hs
=====================================
@@ -1,8 +1,5 @@
{-# LANGUAGE MagicHash, Trustworthy, RankNTypes #-}
-{-# OPTIONS_GHC -fdefines-known-key-names #-}
- -- See Note [Known-key names and IsList]
-
-- |
--
-- Module : GHC.KnownKeyNames
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d053020348a091e5ef5da0b81face2f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d053020348a091e5ef5da0b81face2f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0