Simon Peyton Jones pushed new branch wip/T26349 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T26349
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/26264] compiler: Attempt to systematize Unique tags by introducing an ADT for each different tag
by Zubin (＠wz1000) 09 Sep '25
by Zubin (＠wz1000) 09 Sep '25
09 Sep '25
Zubin pushed to branch wip/26264 at Glasgow Haskell Compiler / GHC
Commits:
ae584a58 by Zubin Duggal at 2025-09-09T17:30:24+05:30
compiler: Attempt to systematize Unique tags by introducing an ADT for each different tag
Fixes #26264
- - - - -
32 changed files:
- compiler/GHC/Builtin/Uniques.hs
- compiler/GHC/Cmm/Info.hs
- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Cmm/UniqueRenamer.hs
- compiler/GHC/CmmToLlvm/Base.hs
- compiler/GHC/Core/Opt/Monad.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/Simplify/Monad.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/HsToCore/Foreign/JavaScript.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Rename.hs
- compiler/GHC/JS/JStg/Monad.hs
- compiler/GHC/Platform/Reg.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Stg/EnforceEpt.hs
- compiler/GHC/Stg/Pipeline.hs
- compiler/GHC/StgToCmm/ExtCode.hs
- compiler/GHC/StgToCmm/Monad.hs
- compiler/GHC/StgToJS/CodeGen.hs
- compiler/GHC/StgToJS/Ids.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Name/Cache.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Types/Unique/DSM.hs
- compiler/GHC/Types/Unique/Supply.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae584a589a00ffb611eacc4ff20deb0…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae584a589a00ffb611eacc4ff20deb0…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/26264] 22 commits: cleanup: Move dehydrateCgBreakInfo to Stg2Bc
by Zubin (＠wz1000) 09 Sep '25
by Zubin (＠wz1000) 09 Sep '25
09 Sep '25
Zubin pushed to branch wip/26264 at Glasgow Haskell Compiler / GHC
Commits:
79816cc4 by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
cleanup: Move dehydrateCgBreakInfo to Stg2Bc
This no longer has anything to do with Core.
- - - - -
53da94ff by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
rts/Disassembler: Fix spacing of BRK_FUN
- - - - -
08c0cf85 by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
debugger: Fix bciPtr in Step-out
We need to use `BCO_NEXT` to move bciPtr to ix=1, because ix=0 points to
the instruction itself!
I do not understand how this didn't crash before.
- - - - -
e7e021fa by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
debugger: Allow BRK_FUNs to head case continuation BCOs
When we start executing a BCO, we may want to yield to the scheduler:
this may be triggered by a heap/stack check, context switch, or a
breakpoint. To yield, we need to put the stack in a state such that
when execution is resumed we are back to where we yielded from.
Previously, a BKR_FUN could only head a function BCO because we only
knew how to construct a valid stack for yielding from one -- simply add
`apply_interp_info` + the BCO to resume executing. This is valid because
the stack at the start of run_BCO is headed by that BCO's arguments.
However, in case continuation BCOs (as per Note [Case continuation BCOs]),
we couldn't easily reconstruct a valid stack that could be resumed
because we dropped too soon the stack frames regarding the value
returned (stg_ret) and received (stg_ctoi) by that continuation.
This is especially tricky because of the variable type and size return
frames (e.g. pointer ret_p/ctoi_R1p vs a tuple ret_t/ctoi_t2).
The trick to being able to yield from a BRK_FUN at the start of a case
cont BCO is to stop removing the ret frame headers eagerly and instead
keep them until the BCO starts executing. The new layout at the start of
a case cont. BCO is described by the new Note [Stack layout when entering run_BCO].
Now, we keep the ret_* and ctoi_* frames when entering run_BCO.
A BRK_FUN is then executed if found, and the stack is yielded as-is with
the preserved ret and ctoi frames.
Then, a case cont BCO's instructions always SLIDE off the headers of the
ret and ctoi frames, in StgToByteCode.doCase, turning a stack like
| .... |
+---------------+
| fv2 |
+---------------+
| fv1 |
+---------------+
| BCO |
+---------------+
| stg_ctoi_ret_ |
+---------------+
| retval |
+---------------+
| stg_ret_..... |
+---------------+
into
| .... |
+---------------+
| fv2 |
+---------------+
| fv1 |
+---------------+
| retval |
+---------------+
for the remainder of the BCO.
Moreover, this more uniform approach of keeping the ret and ctoi frames
means we need less ad-hoc logic concerning the variable size of
ret_tuple vs ret_p/np frames in the code generator and interpreter:
Always keep the return to cont. stack intact at the start of run_BCO,
and the statically generated instructions will take care of adjusting
it.
Unlocks BRK_FUNs at the start of case cont. BCOs which will enable a
better user-facing step-out (#26042) which is free of the bugs the
current BRK_ALTS implementation suffers from (namely, using BRK_FUN
rather than BRK_ALTS in a case cont. means we'll never accidentally end
up in a breakpoint "deeper" than the continuation, because we stop at
the case cont itself rather than on the first breakpoint we evaluate
after it).
- - - - -
ade3c1e6 by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
BRK_FUN with InternalBreakLocs for code-generation time breakpoints
At the start of a case continuation BCO, place a BRK_FUN.
This BRK_FUN uses the new "internal breakpoint location" -- allowing us
to come up with a valid source location for this breakpoint that is not associated with a source-level tick.
For case continuation BCOs, we use the last tick seen before it as the
source location. The reasoning is described in Note [Debugger: Stepout internal break locs].
Note how T26042c, which was broken because it displayed the incorrect
behavior of the previous step out when we'd end up at a deeper level
than the one from which we initiated step-out, is now fixed.
As of this commit, BRK_ALTS is now dead code and is thus dropped.
Note [Debugger: Stepout internal break locs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Step-out tells the interpreter to run until the current function
returns to where it was called from, and stop there.
This is achieved by enabling the BRK_FUN found on the first RET_BCO
frame on the stack (See [Note Debugger: Step-out]).
Case continuation BCOs (which select an alternative branch) must
therefore be headed by a BRK_FUN. An example:
f x = case g x of <--- end up here
1 -> ...
2 -> ...
g y = ... <--- step out from here
- `g` will return a value to the case continuation BCO in `f`
- The case continuation BCO will receive the value returned from g
- Match on it and push the alternative continuation for that branch
- And then enter that alternative.
If we step-out of `g`, the first RET_BCO on the stack is the case
continuation of `f` -- execution should stop at its start, before
selecting an alternative. (One might ask, "why not enable the breakpoint
in the alternative instead?", because the alternative continuation is
only pushed to the stack *after* it is selected by the case cont. BCO)
However, the case cont. BCO is not associated with any source-level
tick, it is merely the glue code which selects alternatives which do
have source level ticks. Therefore, we have to come up at code
generation time with a breakpoint location ('InternalBreakLoc') to
display to the user when it is stopped there.
Our solution is to use the last tick seen just before reaching the case
continuation. This is robust because a case continuation will thus
always have a relevant breakpoint location:
- The source location will be the last source-relevant expression
executed before the continuation is pushed
- So the source location will point to the thing you've just stepped
out of
- Doing :step-local from there will put you on the selected
alternative (which at the source level may also be the e.g. next
line in a do-block)
Examples, using angle brackets (<<...>>) to denote the breakpoint span:
f x = case <<g x>> {- step in here -} of
1 -> ...
2 -> ...>
g y = <<...>> <--- step out from here
...
f x = <<case g x of <--- end up here, whole case highlighted
1 -> ...
2 -> ...>>
doing :step-local ...
f x = case g x of
1 -> <<...>> <--- stop in the alternative
2 -> ...
A second example based on T26042d2, where the source is a do-block IO
action, optimised to a chain of `case expressions`.
main = do
putStrLn "hello1"
<<f>> <--- step-in here
putStrLn "hello3"
putStrLn "hello4"
f = do
<<putStrLn "hello2.1">> <--- step-out from here
putStrLn "hello2.2"
...
main = do
putStrLn "hello1"
<<f>> <--- end up here again, the previously executed expression
putStrLn "hello3"
putStrLn "hello4"
doing step/step-local ...
main = do
putStrLn "hello1"
f
<<putStrLn "hello3">> <--- straight to the next line
putStrLn "hello4"
Finishes #26042
- - - - -
c66910c0 by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
debugger: Re-use the last BreakpointId whole in step-out
Previously, to come up with a location to stop at for `:stepout`, we
would store the location of the last BreakpointId surrounding the
continuation, as described by Note [Debugger: Stepout internal break locs].
However, re-using just the location from the last source breakpoint
isn't sufficient to provide the necessary information in the break
location. Specifically, it wouldn't bind any variables at that location.
Really, there is no reason not to re-use the last breakpoint wholesale,
and re-use all the information we had there. Step-out should behave just
as if we had stopped at the call, but s.t. continuing will not
re-execute the call.
This commit updates the CgBreakInfo to always store a BreakpointId, be
it the original one or the one we're emulating (for step-out).
It makes variable bindings on :stepout work
- - - - -
e4abed7b by sheaf at 2025-09-02T12:20:40-04:00
Revert accidental changes to hie.yaml
- - - - -
003b715b by meooow25 at 2025-09-02T23:48:51+02:00
Adjust the strictness of Data.List.iterate'
* Don't force the next element in advance when generating a (:).
* Force the first element to WHNF like every other element.
Now every element in the output list is forced to WHNF when the (:)
containing it is forced.
CLC proposal:
https://github.com/haskell/core-libraries-committee/issues/335
- - - - -
b2f6aad0 by Simon Hengel at 2025-09-03T04:36:10-04:00
Refactoring: More consistently use logOutput, logInfo, fatalErrorMsg
- - - - -
60a16db7 by Rodrigo Mesquita at 2025-09-03T10:55:50+01:00
bytecode: Don't PUSH_L 0; SLIDE 1 1
While looking through bytecode I noticed a quite common unfortunate
pattern:
...
PUSH_L 0
SLIDE 1 1
We do this often by generically constructing a tail call from a function
atom that may be somewhere arbitrary on the stack.
However, for the special case that the function can be found directly on
top of the stack, as part of the arguments, it's plain redundant to push
then slide it.
In this commit we add a small optimisation to the generation of
tailcalls in bytecode. Simply: lookahead for the function in the stack.
If it is the first thing on the stack and it is part of the arguments
which would be dropped as we entered the tail call, then don't push then
slide it.
In a simple example (T26042b), this already produced a drastic
improvement in generated code (left is old, right is with this patch):
```diff
3c3
< 2025-07-29 10:14:02.081277 UTC
---
> 2025-07-29 10:50:36.560949 UTC
160,161c160
< PUSH_L 0
< SLIDE 1 2
---
> SLIDE 1 1
164,165d162
< PUSH_L 0
< SLIDE 1 1
175,176c172
< PUSH_L 0
< SLIDE 1 2
---
> SLIDE 1 1
179,180d174
< PUSH_L 0
< SLIDE 1 1
206,207d199
< PUSH_L 0
< SLIDE 1 1
210,211d201
< PUSH_L 0
< SLIDE 1 1
214,215d203
< PUSH_L 0
< SLIDE 1 1
218,219d205
< PUSH_L 0
< SLIDE 1 1
222,223d207
< PUSH_L 0
< SLIDE 1 1
...
600,601c566
< PUSH_L 0
< SLIDE 1 2
---
> SLIDE 1 1
604,605d568
< PUSH_L 0
< SLIDE 1 1
632,633d594
< PUSH_L 0
< SLIDE 1 1
636,637d596
< PUSH_L 0
< SLIDE 1 1
640,641d598
< PUSH_L 0
< SLIDE 1 1
644,645d600
< PUSH_L 0
< SLIDE 1 1
648,649d602
< PUSH_L 0
< SLIDE 1 1
652,653d604
< PUSH_L 0
< SLIDE 1 1
656,657d606
< PUSH_L 0
< SLIDE 1 1
660,661d608
< PUSH_L 0
< SLIDE 1 1
664,665d610
< PUSH_L 0
< SLIDE 1 1
```
I also compiled lib:Cabal to bytecode and counted the number of bytecode
lines with `find dist-newstyle -name "*.dump-BCOs" -exec wc {} +`:
with unoptimized core:
1190689 lines (before) - 1172891 lines (now)
= 17798 less redundant instructions (-1.5% lines)
with optimized core:
1924818 lines (before) - 1864836 lines (now)
= 59982 less redundant instructions (-3.1% lines)
- - - - -
8b2c72c0 by L0neGamer at 2025-09-04T06:32:03-04:00
Add Control.Monad.thenM and Control.Applicative.thenA
- - - - -
39e1b7cb by Teo Camarasu at 2025-09-04T06:32:46-04:00
ghc-internal: invert dependency of GHC.Internal.TH.Syntax on Data.Data
This means that Data.Data no longer blocks building TH.Syntax, which
allows greater parallelism in our builds.
We move the Data.Data.Data instances to Data.Data. Quasi depends on
Data.Data for one of its methods, so,
we split the Quasi/Q, etc definition out of GHC.Internal.TH.Syntax
into its own module. This has the added benefit of splitting up this
quite large module.
Previously TH.Syntax was a bottleneck when compiling ghc-internal. Now
it is less of a bottle-neck and is also slightly quicker to
compile (since it no longer contains these instances) at the cost of
making Data.Data slightly more expensive to compile.
TH.Lift which depends on TH.Syntax can also compile quicker and no
longer blocks ghc-internal finishing to compile.
Resolves #26217
-------------------------
Metric Decrease:
MultiLayerModulesTH_OneShot
T13253
T21839c
T24471
Metric Increase:
T12227
-------------------------
- - - - -
bdf82fd2 by Teo Camarasu at 2025-09-04T06:32:46-04:00
compiler: delete unused names in Builtins.Names.TH
returnQ and bindQ are no longer used in the compiler.
There was also a very old comment that referred to them that I have modernized
- - - - -
41a448e5 by Ben Gamari at 2025-09-04T19:21:43-04:00
hadrian: Pass lib & include directories to ghc `Setup configure`
- - - - -
46bb9a79 by Ben Gamari at 2025-09-04T19:21:44-04:00
rts/IPE: Fix compilation when zstd is enabled
This was broken by the refactoring undertaken in
c80dd91c0bf6ac034f0c592f16c548b9408a8481.
Closes #26312.
- - - - -
138a6e34 by sheaf at 2025-09-04T19:22:46-04:00
Make mkCast assertion a bit clearer
This commit changes the assertion message that gets printed when one
calls mkCast with a coercion whose kind does not match the type of the
inner expression. I always found the assertion message a bit confusing,
as it didn't clearly state what exactly was the error.
- - - - -
9d626be1 by sheaf at 2025-09-04T19:22:46-04:00
Simplifier/rules: fix mistakes in Notes & comments
- - - - -
94b62aa7 by Simon Peyton Jones at 2025-09-08T03:37:14-04:00
Refactor ForAllCo
This is a pure refactor, addressing #26389.
It arranges that the kind coercion in a ForAllCo is a MCoercion, rather
than a plain Coercion, thus removing redundancy in the common case.
See (FC8) in Note [ForAllCo]
It's a nice cleanup.
- - - - -
624afa4a by sheaf at 2025-09-08T03:38:05-04:00
Use tcMkScaledFunTys in matchExpectedFunTys
We should use tcMkScaledFunTys rather than mkScaledFunTys in
GHC.Tc.Utils.Unify.matchExpectedFunTys, as the latter crashes
when the kind of the result type is a bare metavariable.
We know the result is always Type-like, so we don't need scaledFunTys
to try to rediscover that from the kind.
Fixes #26277
- - - - -
0975d2b6 by sheaf at 2025-09-08T03:38:54-04:00
Revert "Remove hptAllFamInstances usage during upsweep"
This reverts commit 3bf6720eff5e86e673568e756161e6d6150eb440.
- - - - -
0cf34176 by soulomoon at 2025-09-08T03:38:54-04:00
Family consistency checks: add test for #26154
This commit adds the test T26154, to make sure that GHC doesn't crash
when performing type family consistency checks. This test case
was extracted from Agda.
Fixes #26154
- - - - -
0d93ce50 by Zubin Duggal at 2025-09-09T16:55:25+05:30
compiler: Attempt to systematize Unique tags by introducing an ADT for each different tag
Fixes #26264
- - - - -
145 changed files:
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Builtin/Uniques.hs
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/Cmm/Info.hs
- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Cmm/UniqueRenamer.hs
- compiler/GHC/CmmToLlvm/Base.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion.hs-boot
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/Monad.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Opt/Simplify/Monad.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Reduction.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Data/IOEnv.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Rename.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/JS/JStg/Monad.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Platform/Reg.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Stg/EnforceEpt.hs
- compiler/GHC/Stg/Lint.hs
- compiler/GHC/Stg/Pipeline.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/ExtCode.hs
- compiler/GHC/StgToCmm/Monad.hs
- compiler/GHC/StgToJS/CodeGen.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Gen/Splice.hs-boot
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Types/TH.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/Name/Cache.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Types/Unique/DSM.hs
- compiler/GHC/Types/Unique/Supply.hs
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/Home/PackageTable.hs
- ghc/GHCi/UI.hs
- hadrian/src/Settings/Packages.hs
- hie.yaml
- libraries/base/changelog.md
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Control/Monad.hs
- libraries/base/src/Data/Array/Byte.hs
- libraries/base/src/Data/Fixed.hs
- + libraries/ghc-boot-th/GHC/Boot/TH/Monad.hs
- libraries/ghc-boot-th/ghc-boot-th.cabal.in
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- + libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/GHCi/TH.hs
- libraries/template-haskell/Language/Haskell/TH/Quote.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- rts/Disassembler.c
- rts/IPE.c
- rts/Interpreter.c
- rts/Profiling.c
- rts/include/rts/Bytecodes.h
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/deriving/should_compile/T14682.stderr
- testsuite/tests/deriving/should_compile/drv-empty-data.stderr
- testsuite/tests/ghci.debugger/scripts/T26042b.script
- testsuite/tests/ghci.debugger/scripts/T26042b.stdout
- testsuite/tests/ghci.debugger/scripts/T26042c.script
- testsuite/tests/ghci.debugger/scripts/T26042c.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042d2.hs
- + testsuite/tests/ghci.debugger/scripts/T26042d2.script
- + testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
- testsuite/tests/ghci.debugger/scripts/T26042e.stdout
- testsuite/tests/ghci.debugger/scripts/T26042f.script
- testsuite/tests/ghci.debugger/scripts/T26042f1.stdout
- testsuite/tests/ghci.debugger/scripts/T26042f2.stdout
- testsuite/tests/ghci.debugger/scripts/T26042g.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- testsuite/tests/splice-imports/SI29.stderr
- testsuite/tests/th/T11452.stderr
- testsuite/tests/th/T15321.stderr
- testsuite/tests/th/T7276.stderr
- testsuite/tests/th/TH_NestedSplicesFail3.stderr
- testsuite/tests/th/TH_NestedSplicesFail4.stderr
- + testsuite/tests/typecheck/should_compile/T26154.hs
- + testsuite/tests/typecheck/should_compile/T26154_A.hs
- + testsuite/tests/typecheck/should_compile/T26154_B.hs
- + testsuite/tests/typecheck/should_compile/T26154_B.hs-boot
- + testsuite/tests/typecheck/should_compile/T26154_Other.hs
- + testsuite/tests/typecheck/should_compile/T26277.hs
- testsuite/tests/typecheck/should_compile/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ccd2023e2d2a98d406f77b55a855bc…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ccd2023e2d2a98d406f77b55a855bc…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/supersven/fix-foundation-test-shift-amounts] foundation test: Fix shift amount (#26248)
by Sven Tennie (＠supersven) 09 Sep '25
by Sven Tennie (＠supersven) 09 Sep '25
09 Sep '25
Sven Tennie pushed to branch wip/supersven/fix-foundation-test-shift-amounts at Glasgow Haskell Compiler / GHC
Commits:
817899db by Sven Tennie at 2025-09-09T11:41:55+02:00
foundation test: Fix shift amount (#26248)
Shift primops' results are only defined for shift amounts of 0 to word
size - 1. The approach is similar to testing div-like operations (which
have a constraint regarding zero operands.)
This was partly vibe coded (https://github.com/supersven/ghc/pull/1) but
then heavily refactored.
- - - - -
4 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- testsuite/tests/numeric/should_run/foundation.hs
- utils/genprimopcode/Main.hs
- utils/genprimopcode/Syntax.hs
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -148,6 +148,7 @@ defaults
vector = []
deprecated_msg = {} -- A non-empty message indicates deprecation
div_like = False -- Second argument expected to be non zero - used for tests
+ shift_like = False -- Second argument expected to be atmost first argument's word size -1 - used for tests
defined_bits = Nothing -- The number of bits the operation is defined for (if not all bits)
-- Note [When do out-of-line primops go in primops.txt.pp]
@@ -312,8 +313,16 @@ primop Int8QuotRemOp "quotRemInt8#" GenPrimOp Int8# -> Int8# -> (# Int8#, Int8#
div_like = True
primop Int8SllOp "uncheckedShiftLInt8#" GenPrimOp Int8# -> Int# -> Int8#
+ with
+ shift_like = True
+
primop Int8SraOp "uncheckedShiftRAInt8#" GenPrimOp Int8# -> Int# -> Int8#
+ with
+ shift_like = True
+
primop Int8SrlOp "uncheckedShiftRLInt8#" GenPrimOp Int8# -> Int# -> Int8#
+ with
+ shift_like = True
primop Int8ToWord8Op "int8ToWord8#" GenPrimOp Int8# -> Word8#
with code_size = 0
@@ -372,7 +381,12 @@ primop Word8XorOp "xorWord8#" GenPrimOp Word8# -> Word8# -> Word8#
primop Word8NotOp "notWord8#" GenPrimOp Word8# -> Word8#
primop Word8SllOp "uncheckedShiftLWord8#" GenPrimOp Word8# -> Int# -> Word8#
+ with
+ shift_like = True
+
primop Word8SrlOp "uncheckedShiftRLWord8#" GenPrimOp Word8# -> Int# -> Word8#
+ with
+ shift_like = True
primop Word8ToInt8Op "word8ToInt8#" GenPrimOp Word8# -> Int8#
with code_size = 0
@@ -422,8 +436,16 @@ primop Int16QuotRemOp "quotRemInt16#" GenPrimOp Int16# -> Int16# -> (# Int16#, I
div_like = True
primop Int16SllOp "uncheckedShiftLInt16#" GenPrimOp Int16# -> Int# -> Int16#
+ with
+ shift_like = True
+
primop Int16SraOp "uncheckedShiftRAInt16#" GenPrimOp Int16# -> Int# -> Int16#
+ with
+ shift_like = True
+
primop Int16SrlOp "uncheckedShiftRLInt16#" GenPrimOp Int16# -> Int# -> Int16#
+ with
+ shift_like = True
primop Int16ToWord16Op "int16ToWord16#" GenPrimOp Int16# -> Word16#
with code_size = 0
@@ -482,7 +504,12 @@ primop Word16XorOp "xorWord16#" GenPrimOp Word16# -> Word16# -> Word16#
primop Word16NotOp "notWord16#" GenPrimOp Word16# -> Word16#
primop Word16SllOp "uncheckedShiftLWord16#" GenPrimOp Word16# -> Int# -> Word16#
+ with
+ shift_like = True
+
primop Word16SrlOp "uncheckedShiftRLWord16#" GenPrimOp Word16# -> Int# -> Word16#
+ with
+ shift_like = True
primop Word16ToInt16Op "word16ToInt16#" GenPrimOp Word16# -> Int16#
with code_size = 0
@@ -532,8 +559,16 @@ primop Int32QuotRemOp "quotRemInt32#" GenPrimOp Int32# -> Int32# -> (# Int32#, I
div_like = True
primop Int32SllOp "uncheckedShiftLInt32#" GenPrimOp Int32# -> Int# -> Int32#
+ with
+ shift_like = True
+
primop Int32SraOp "uncheckedShiftRAInt32#" GenPrimOp Int32# -> Int# -> Int32#
+ with
+ shift_like = True
+
primop Int32SrlOp "uncheckedShiftRLInt32#" GenPrimOp Int32# -> Int# -> Int32#
+ with
+ shift_like = True
primop Int32ToWord32Op "int32ToWord32#" GenPrimOp Int32# -> Word32#
with code_size = 0
@@ -592,7 +627,12 @@ primop Word32XorOp "xorWord32#" GenPrimOp Word32# -> Word32# -> Word32#
primop Word32NotOp "notWord32#" GenPrimOp Word32# -> Word32#
primop Word32SllOp "uncheckedShiftLWord32#" GenPrimOp Word32# -> Int# -> Word32#
+ with
+ shift_like = True
+
primop Word32SrlOp "uncheckedShiftRLWord32#" GenPrimOp Word32# -> Int# -> Word32#
+ with
+ shift_like = True
primop Word32ToInt32Op "word32ToInt32#" GenPrimOp Word32# -> Int32#
with code_size = 0
@@ -637,8 +677,16 @@ primop Int64RemOp "remInt64#" GenPrimOp Int64# -> Int64# -> Int64#
div_like = True
primop Int64SllOp "uncheckedIShiftL64#" GenPrimOp Int64# -> Int# -> Int64#
+ with
+ shift_like = True
+
primop Int64SraOp "uncheckedIShiftRA64#" GenPrimOp Int64# -> Int# -> Int64#
+ with
+ shift_like = True
+
primop Int64SrlOp "uncheckedIShiftRL64#" GenPrimOp Int64# -> Int# -> Int64#
+ with
+ shift_like = True
primop Int64ToWord64Op "int64ToWord64#" GenPrimOp Int64# -> Word64#
with code_size = 0
@@ -692,7 +740,12 @@ primop Word64XorOp "xor64#" GenPrimOp Word64# -> Word64# -> Word64#
primop Word64NotOp "not64#" GenPrimOp Word64# -> Word64#
primop Word64SllOp "uncheckedShiftL64#" GenPrimOp Word64# -> Int# -> Word64#
+ with
+ shift_like = True
+
primop Word64SrlOp "uncheckedShiftRL64#" GenPrimOp Word64# -> Int# -> Word64#
+ with
+ shift_like = True
primop Word64ToInt64Op "word64ToInt64#" GenPrimOp Word64# -> Int64#
with code_size = 0
@@ -865,12 +918,20 @@ primop WordToDoubleOp "word2Double#" GenPrimOp Word# -> Double#
primop IntSllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int#
{Shift left. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
+ with
+ shift_like = True
+
primop IntSraOp "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int#
{Shift right arithmetic. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
+ with
+ shift_like = True
+
primop IntSrlOp "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int#
{Shift right logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
+ with
+ shift_like = True
------------------------------------------------------------------------
section "Word#"
@@ -946,9 +1007,14 @@ primop WordNotOp "not#" GenPrimOp Word# -> Word#
primop WordSllOp "uncheckedShiftL#" GenPrimOp Word# -> Int# -> Word#
{Shift left logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
+ with
+ shift_like = True
+
primop WordSrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word#
{Shift right logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
+ with
+ shift_like = True
primop WordToIntOp "word2Int#" GenPrimOp Word# -> Int#
with code_size = 0
=====================================
testsuite/tests/numeric/should_run/foundation.hs
=====================================
@@ -13,6 +13,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeAbstractions #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE MagicHash #-}
@@ -24,7 +25,7 @@ module Main
( main
) where
-import Data.Bits (Bits((.&.), bit))
+import Data.Bits (Bits((.&.), bit), FiniteBits, finiteBitSize)
import Data.Word
import Data.Int
import GHC.Natural
@@ -133,6 +134,16 @@ newtype NonZero a = NonZero { getNonZero :: a }
instance (Arbitrary a, Num a, Eq a) => Arbitrary (NonZero a) where
arbitrary = nonZero
+-- | A newtype for shift amounts that are bounded by @wordSize - 1@
+newtype BoundedShiftAmount a = BoundedShiftAmount {getBoundedShiftAmount :: Int}
+ deriving (Eq, Ord, Show)
+
+instance (FiniteBits a) => Arbitrary (BoundedShiftAmount a) where
+ arbitrary = do
+ x <- arbitrary
+ let widthBits = finiteBitSize (undefined :: a)
+ pure $ BoundedShiftAmount (abs x `mod` widthBits)
+
instance Arbitrary Natural where
arbitrary = integralDownsize . (`mod` 10000) . abs <$> arbitraryInt64
@@ -395,6 +406,10 @@ class TestPrimop f where
testPrimopDivLike :: String -> f -> f -> Test
testPrimopDivLike _ _ _ = error "Div testing not supported for this type."
+ -- | Special test method for shift operations that bounds the shift amount
+ testPrimopShift :: String -> f -> f -> Test
+ testPrimopShift _ _ _ = error "Shift testing not supported for this type."
+
{-
instance TestPrimop (Int# -> Int# -> Int#) where
testPrimop s l r = Property s $ \(uInt -> a1) (uInt -> a2) -> (wInt (l a1 a2)) === wInt (r a1 a2)
@@ -460,9 +475,9 @@ testPrimops = Group "primop"
, testPrimopDivLike "quotInt8#" Primop.quotInt8# Wrapper.quotInt8#
, testPrimopDivLike "remInt8#" Primop.remInt8# Wrapper.remInt8#
, testPrimopDivLike "quotRemInt8#" Primop.quotRemInt8# Wrapper.quotRemInt8#
- , testPrimop "uncheckedShiftLInt8#" Primop.uncheckedShiftLInt8# Wrapper.uncheckedShiftLInt8#
- , testPrimop "uncheckedShiftRAInt8#" Primop.uncheckedShiftRAInt8# Wrapper.uncheckedShiftRAInt8#
- , testPrimop "uncheckedShiftRLInt8#" Primop.uncheckedShiftRLInt8# Wrapper.uncheckedShiftRLInt8#
+ , testPrimopShift "uncheckedShiftLInt8#" Primop.uncheckedShiftLInt8# Wrapper.uncheckedShiftLInt8#
+ , testPrimopShift "uncheckedShiftRAInt8#" Primop.uncheckedShiftRAInt8# Wrapper.uncheckedShiftRAInt8#
+ , testPrimopShift "uncheckedShiftRLInt8#" Primop.uncheckedShiftRLInt8# Wrapper.uncheckedShiftRLInt8#
, testPrimop "int8ToWord8#" Primop.int8ToWord8# Wrapper.int8ToWord8#
, testPrimop "eqInt8#" Primop.eqInt8# Wrapper.eqInt8#
, testPrimop "geInt8#" Primop.geInt8# Wrapper.geInt8#
@@ -482,8 +497,8 @@ testPrimops = Group "primop"
, testPrimop "orWord8#" Primop.orWord8# Wrapper.orWord8#
, testPrimop "xorWord8#" Primop.xorWord8# Wrapper.xorWord8#
, testPrimop "notWord8#" Primop.notWord8# Wrapper.notWord8#
- , testPrimop "uncheckedShiftLWord8#" Primop.uncheckedShiftLWord8# Wrapper.uncheckedShiftLWord8#
- , testPrimop "uncheckedShiftRLWord8#" Primop.uncheckedShiftRLWord8# Wrapper.uncheckedShiftRLWord8#
+ , testPrimopShift "uncheckedShiftLWord8#" Primop.uncheckedShiftLWord8# Wrapper.uncheckedShiftLWord8#
+ , testPrimopShift "uncheckedShiftRLWord8#" Primop.uncheckedShiftRLWord8# Wrapper.uncheckedShiftRLWord8#
, testPrimop "word8ToInt8#" Primop.word8ToInt8# Wrapper.word8ToInt8#
, testPrimop "eqWord8#" Primop.eqWord8# Wrapper.eqWord8#
, testPrimop "geWord8#" Primop.geWord8# Wrapper.geWord8#
@@ -500,9 +515,9 @@ testPrimops = Group "primop"
, testPrimopDivLike "quotInt16#" Primop.quotInt16# Wrapper.quotInt16#
, testPrimopDivLike "remInt16#" Primop.remInt16# Wrapper.remInt16#
, testPrimopDivLike "quotRemInt16#" Primop.quotRemInt16# Wrapper.quotRemInt16#
- , testPrimop "uncheckedShiftLInt16#" Primop.uncheckedShiftLInt16# Wrapper.uncheckedShiftLInt16#
- , testPrimop "uncheckedShiftRAInt16#" Primop.uncheckedShiftRAInt16# Wrapper.uncheckedShiftRAInt16#
- , testPrimop "uncheckedShiftRLInt16#" Primop.uncheckedShiftRLInt16# Wrapper.uncheckedShiftRLInt16#
+ , testPrimopShift "uncheckedShiftLInt16#" Primop.uncheckedShiftLInt16# Wrapper.uncheckedShiftLInt16#
+ , testPrimopShift "uncheckedShiftRAInt16#" Primop.uncheckedShiftRAInt16# Wrapper.uncheckedShiftRAInt16#
+ , testPrimopShift "uncheckedShiftRLInt16#" Primop.uncheckedShiftRLInt16# Wrapper.uncheckedShiftRLInt16#
, testPrimop "int16ToWord16#" Primop.int16ToWord16# Wrapper.int16ToWord16#
, testPrimop "eqInt16#" Primop.eqInt16# Wrapper.eqInt16#
, testPrimop "geInt16#" Primop.geInt16# Wrapper.geInt16#
@@ -522,8 +537,8 @@ testPrimops = Group "primop"
, testPrimop "orWord16#" Primop.orWord16# Wrapper.orWord16#
, testPrimop "xorWord16#" Primop.xorWord16# Wrapper.xorWord16#
, testPrimop "notWord16#" Primop.notWord16# Wrapper.notWord16#
- , testPrimop "uncheckedShiftLWord16#" Primop.uncheckedShiftLWord16# Wrapper.uncheckedShiftLWord16#
- , testPrimop "uncheckedShiftRLWord16#" Primop.uncheckedShiftRLWord16# Wrapper.uncheckedShiftRLWord16#
+ , testPrimopShift "uncheckedShiftLWord16#" Primop.uncheckedShiftLWord16# Wrapper.uncheckedShiftLWord16#
+ , testPrimopShift "uncheckedShiftRLWord16#" Primop.uncheckedShiftRLWord16# Wrapper.uncheckedShiftRLWord16#
, testPrimop "word16ToInt16#" Primop.word16ToInt16# Wrapper.word16ToInt16#
, testPrimop "eqWord16#" Primop.eqWord16# Wrapper.eqWord16#
, testPrimop "geWord16#" Primop.geWord16# Wrapper.geWord16#
@@ -540,9 +555,9 @@ testPrimops = Group "primop"
, testPrimopDivLike "quotInt32#" Primop.quotInt32# Wrapper.quotInt32#
, testPrimopDivLike "remInt32#" Primop.remInt32# Wrapper.remInt32#
, testPrimopDivLike "quotRemInt32#" Primop.quotRemInt32# Wrapper.quotRemInt32#
- , testPrimop "uncheckedShiftLInt32#" Primop.uncheckedShiftLInt32# Wrapper.uncheckedShiftLInt32#
- , testPrimop "uncheckedShiftRAInt32#" Primop.uncheckedShiftRAInt32# Wrapper.uncheckedShiftRAInt32#
- , testPrimop "uncheckedShiftRLInt32#" Primop.uncheckedShiftRLInt32# Wrapper.uncheckedShiftRLInt32#
+ , testPrimopShift "uncheckedShiftLInt32#" Primop.uncheckedShiftLInt32# Wrapper.uncheckedShiftLInt32#
+ , testPrimopShift "uncheckedShiftRAInt32#" Primop.uncheckedShiftRAInt32# Wrapper.uncheckedShiftRAInt32#
+ , testPrimopShift "uncheckedShiftRLInt32#" Primop.uncheckedShiftRLInt32# Wrapper.uncheckedShiftRLInt32#
, testPrimop "int32ToWord32#" Primop.int32ToWord32# Wrapper.int32ToWord32#
, testPrimop "eqInt32#" Primop.eqInt32# Wrapper.eqInt32#
, testPrimop "geInt32#" Primop.geInt32# Wrapper.geInt32#
@@ -562,8 +577,8 @@ testPrimops = Group "primop"
, testPrimop "orWord32#" Primop.orWord32# Wrapper.orWord32#
, testPrimop "xorWord32#" Primop.xorWord32# Wrapper.xorWord32#
, testPrimop "notWord32#" Primop.notWord32# Wrapper.notWord32#
- , testPrimop "uncheckedShiftLWord32#" Primop.uncheckedShiftLWord32# Wrapper.uncheckedShiftLWord32#
- , testPrimop "uncheckedShiftRLWord32#" Primop.uncheckedShiftRLWord32# Wrapper.uncheckedShiftRLWord32#
+ , testPrimopShift "uncheckedShiftLWord32#" Primop.uncheckedShiftLWord32# Wrapper.uncheckedShiftLWord32#
+ , testPrimopShift "uncheckedShiftRLWord32#" Primop.uncheckedShiftRLWord32# Wrapper.uncheckedShiftRLWord32#
, testPrimop "word32ToInt32#" Primop.word32ToInt32# Wrapper.word32ToInt32#
, testPrimop "eqWord32#" Primop.eqWord32# Wrapper.eqWord32#
, testPrimop "geWord32#" Primop.geWord32# Wrapper.geWord32#
@@ -579,9 +594,9 @@ testPrimops = Group "primop"
, testPrimop "timesInt64#" Primop.timesInt64# Wrapper.timesInt64#
, testPrimopDivLike "quotInt64#" Primop.quotInt64# Wrapper.quotInt64#
, testPrimopDivLike "remInt64#" Primop.remInt64# Wrapper.remInt64#
- , testPrimop "uncheckedIShiftL64#" Primop.uncheckedIShiftL64# Wrapper.uncheckedIShiftL64#
- , testPrimop "uncheckedIShiftRA64#" Primop.uncheckedIShiftRA64# Wrapper.uncheckedIShiftRA64#
- , testPrimop "uncheckedIShiftRL64#" Primop.uncheckedIShiftRL64# Wrapper.uncheckedIShiftRL64#
+ , testPrimopShift "uncheckedIShiftL64#" Primop.uncheckedIShiftL64# Wrapper.uncheckedIShiftL64#
+ , testPrimopShift "uncheckedIShiftRA64#" Primop.uncheckedIShiftRA64# Wrapper.uncheckedIShiftRA64#
+ , testPrimopShift "uncheckedIShiftRL64#" Primop.uncheckedIShiftRL64# Wrapper.uncheckedIShiftRL64#
, testPrimop "int64ToWord64#" Primop.int64ToWord64# Wrapper.int64ToWord64#
, testPrimop "eqInt64#" Primop.eqInt64# Wrapper.eqInt64#
, testPrimop "geInt64#" Primop.geInt64# Wrapper.geInt64#
@@ -600,8 +615,8 @@ testPrimops = Group "primop"
, testPrimop "or64#" Primop.or64# Wrapper.or64#
, testPrimop "xor64#" Primop.xor64# Wrapper.xor64#
, testPrimop "not64#" Primop.not64# Wrapper.not64#
- , testPrimop "uncheckedShiftL64#" Primop.uncheckedShiftL64# Wrapper.uncheckedShiftL64#
- , testPrimop "uncheckedShiftRL64#" Primop.uncheckedShiftRL64# Wrapper.uncheckedShiftRL64#
+ , testPrimopShift "uncheckedShiftL64#" Primop.uncheckedShiftL64# Wrapper.uncheckedShiftL64#
+ , testPrimopShift "uncheckedShiftRL64#" Primop.uncheckedShiftRL64# Wrapper.uncheckedShiftRL64#
, testPrimop "word64ToInt64#" Primop.word64ToInt64# Wrapper.word64ToInt64#
, testPrimop "eqWord64#" Primop.eqWord64# Wrapper.eqWord64#
, testPrimop "geWord64#" Primop.geWord64# Wrapper.geWord64#
@@ -632,9 +647,9 @@ testPrimops = Group "primop"
, testPrimop "<=#" (Primop.<=#) (Wrapper.<=#)
, testPrimop "chr#" Primop.chr# Wrapper.chr#
, testPrimop "int2Word#" Primop.int2Word# Wrapper.int2Word#
- , testPrimop "uncheckedIShiftL#" Primop.uncheckedIShiftL# Wrapper.uncheckedIShiftL#
- , testPrimop "uncheckedIShiftRA#" Primop.uncheckedIShiftRA# Wrapper.uncheckedIShiftRA#
- , testPrimop "uncheckedIShiftRL#" Primop.uncheckedIShiftRL# Wrapper.uncheckedIShiftRL#
+ , testPrimopShift "uncheckedIShiftL#" Primop.uncheckedIShiftL# Wrapper.uncheckedIShiftL#
+ , testPrimopShift "uncheckedIShiftRA#" Primop.uncheckedIShiftRA# Wrapper.uncheckedIShiftRA#
+ , testPrimopShift "uncheckedIShiftRL#" Primop.uncheckedIShiftRL# Wrapper.uncheckedIShiftRL#
, testPrimop "plusWord#" Primop.plusWord# Wrapper.plusWord#
, testPrimop "addWordC#" Primop.addWordC# Wrapper.addWordC#
, testPrimop "subWordC#" Primop.subWordC# Wrapper.subWordC#
@@ -649,8 +664,8 @@ testPrimops = Group "primop"
, testPrimop "or#" Primop.or# Wrapper.or#
, testPrimop "xor#" Primop.xor# Wrapper.xor#
, testPrimop "not#" Primop.not# Wrapper.not#
- , testPrimop "uncheckedShiftL#" Primop.uncheckedShiftL# Wrapper.uncheckedShiftL#
- , testPrimop "uncheckedShiftRL#" Primop.uncheckedShiftRL# Wrapper.uncheckedShiftRL#
+ , testPrimopShift "uncheckedShiftL#" Primop.uncheckedShiftL# Wrapper.uncheckedShiftL#
+ , testPrimopShift "uncheckedShiftRL#" Primop.uncheckedShiftRL# Wrapper.uncheckedShiftRL#
, testPrimop "word2Int#" Primop.word2Int# Wrapper.word2Int#
, testPrimop "gtWord#" Primop.gtWord# Wrapper.gtWord#
, testPrimop "geWord#" Primop.geWord# Wrapper.geWord#
@@ -709,6 +724,7 @@ instance TestPrimop (Char# -> Int#) where
instance TestPrimop (Int# -> Int# -> Int#) where
testPrimop s l r = Property s $ \ (uInt#-> x0) (uInt#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt#-> x0) (uInt#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
+ testPrimopShift s l r = Property s $ \ (uInt#-> x0) (BoundedShiftAmount @Int shift) -> wInt# (l x0 (uInt# shift)) === wInt# (r x0 (uInt# shift))
instance TestPrimop (Int# -> Int# -> (# Int#,Int# #)) where
testPrimop s l r = Property s $ \ (uInt#-> x0) (uInt#-> x1) -> WTUP2(wInt#,wInt#, (l x0 x1)) === WTUP2(wInt#,wInt#, (r x0 x1))
@@ -741,6 +757,7 @@ instance TestPrimop (Int# -> Word#) where
instance TestPrimop (Int16# -> Int# -> Int16#) where
testPrimop s l r = Property s $ \ (uInt16#-> x0) (uInt#-> x1) -> wInt16# (l x0 x1) === wInt16# (r x0 x1)
+ testPrimopShift s l r = Property s $ \ (uInt16#-> x0) (BoundedShiftAmount @Int16 shift) -> wInt16# (l x0 (uInt# shift)) === wInt16# (r x0 (uInt# shift))
instance TestPrimop (Int16# -> Int16# -> Int#) where
testPrimop s l r = Property s $ \ (uInt16#-> x0) (uInt16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
@@ -765,6 +782,7 @@ instance TestPrimop (Int16# -> Word16#) where
instance TestPrimop (Int32# -> Int# -> Int32#) where
testPrimop s l r = Property s $ \ (uInt32#-> x0) (uInt#-> x1) -> wInt32# (l x0 x1) === wInt32# (r x0 x1)
+ testPrimopShift s l r = Property s $ \ (uInt32#-> x0) (BoundedShiftAmount @Int32 shift) -> wInt32# (l x0 (uInt# shift)) === wInt32# (r x0 (uInt# shift))
instance TestPrimop (Int32# -> Int32# -> Int#) where
testPrimop s l r = Property s $ \ (uInt32#-> x0) (uInt32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
@@ -789,6 +807,7 @@ instance TestPrimop (Int32# -> Word32#) where
instance TestPrimop (Int64# -> Int# -> Int64#) where
testPrimop s l r = Property s $ \ (uInt64#-> x0) (uInt#-> x1) -> wInt64# (l x0 x1) === wInt64# (r x0 x1)
+ testPrimopShift s l r = Property s $ \ (uInt64#-> x0) (BoundedShiftAmount @Int64 shift) -> wInt64# (l x0 (uInt# shift)) === wInt64# (r x0 (uInt# shift))
instance TestPrimop (Int64# -> Int64# -> Int#) where
testPrimop s l r = Property s $ \ (uInt64#-> x0) (uInt64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
@@ -809,6 +828,7 @@ instance TestPrimop (Int64# -> Word64#) where
instance TestPrimop (Int8# -> Int# -> Int8#) where
testPrimop s l r = Property s $ \ (uInt8#-> x0) (uInt#-> x1) -> wInt8# (l x0 x1) === wInt8# (r x0 x1)
+ testPrimopShift s l r = Property s $ \ (uInt8#-> x0) (BoundedShiftAmount @Int8 shift) -> wInt8# (l x0 (uInt# shift)) === wInt8# (r x0 (uInt# shift))
instance TestPrimop (Int8# -> Int8# -> Int#) where
testPrimop s l r = Property s $ \ (uInt8#-> x0) (uInt8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
@@ -833,6 +853,7 @@ instance TestPrimop (Int8# -> Word8#) where
instance TestPrimop (Word# -> Int# -> Word#) where
testPrimop s l r = Property s $ \ (uWord#-> x0) (uInt#-> x1) -> wWord# (l x0 x1) === wWord# (r x0 x1)
+ testPrimopShift s l r = Property s $ \ (uWord#-> x0) (BoundedShiftAmount @Word shift) -> wWord# (l x0 (uInt# shift)) === wWord# (r x0 (uInt# shift))
instance TestPrimop (Word# -> Word# -> Int#) where
testPrimop s l r = Property s $ \ (uWord#-> x0) (uWord#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
@@ -870,6 +891,7 @@ instance TestPrimop (Word# -> Word8#) where
instance TestPrimop (Word16# -> Int# -> Word16#) where
testPrimop s l r = Property s $ \ (uWord16#-> x0) (uInt#-> x1) -> wWord16# (l x0 x1) === wWord16# (r x0 x1)
+ testPrimopShift s l r = Property s $ \ (uWord16#-> x0) (BoundedShiftAmount @Word16 shift) -> wWord16# (l x0 (uInt# shift)) === wWord16# (r x0 (uInt# shift))
instance TestPrimop (Word16# -> Word16# -> Int#) where
testPrimop s l r = Property s $ \ (uWord16#-> x0) (uWord16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
@@ -894,6 +916,7 @@ instance TestPrimop (Word16# -> Word16#) where
instance TestPrimop (Word32# -> Int# -> Word32#) where
testPrimop s l r = Property s $ \ (uWord32#-> x0) (uInt#-> x1) -> wWord32# (l x0 x1) === wWord32# (r x0 x1)
+ testPrimopShift s l r = Property s $ \ (uWord32#-> x0) (BoundedShiftAmount @Word32 shift) -> wWord32# (l x0 (uInt# shift)) === wWord32# (r x0 (uInt# shift))
instance TestPrimop (Word32# -> Word32# -> Int#) where
testPrimop s l r = Property s $ \ (uWord32#-> x0) (uWord32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
@@ -918,6 +941,7 @@ instance TestPrimop (Word32# -> Word32#) where
instance TestPrimop (Word64# -> Int# -> Word64#) where
testPrimop s l r = Property s $ \ (uWord64#-> x0) (uInt#-> x1) -> wWord64# (l x0 x1) === wWord64# (r x0 x1)
+ testPrimopShift s l r = Property s $ \ (uWord64#-> x0) (BoundedShiftAmount @Word64 shift) -> wWord64# (l x0 (uInt# shift)) === wWord64# (r x0 (uInt# shift))
instance TestPrimop (Word64# -> Word64# -> Int#) where
testPrimop s l r = Property s $ \ (uWord64#-> x0) (uWord64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
@@ -938,6 +962,7 @@ instance TestPrimop (Word64# -> Word64#) where
instance TestPrimop (Word8# -> Int# -> Word8#) where
testPrimop s l r = Property s $ \ (uWord8#-> x0) (uInt#-> x1) -> wWord8# (l x0 x1) === wWord8# (r x0 x1)
+ testPrimopShift s l r = Property s $ \ (uWord8#-> x0) (BoundedShiftAmount @Word8 shift) -> wWord8# (l x0 (uInt# shift)) === wWord8# (r x0 (uInt# shift))
instance TestPrimop (Word8# -> Word8# -> Int#) where
testPrimop s l r = Property s $ \ (uWord8#-> x0) (uWord8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
=====================================
utils/genprimopcode/Main.hs
=====================================
@@ -705,12 +705,16 @@ gen_foundation_tests (Info _ entries)
mkInstances inst_ty =
let test_lambda = "\\ " ++ intercalate " " (zipWith mkArg [0::Int ..] (arg_tys)) ++ " -> " ++ mk_body "l" ++ " === " ++ mk_body "r"
+ shift_lambda = "\\ " ++ mkArg (0::Int) (head arg_tys) ++ " (BoundedShiftAmount @" ++ dropMagicHash (head arg_tys) ++ " shift) -> " ++ mk_shift_body "l" ++ " === " ++ mk_shift_body "r"
in unlines $
[ "instance TestPrimop (" ++ pprTy inst_ty ++ ") where"
, " testPrimop s l r = Property s $ " ++ test_lambda ]
++ (if mb_divable_tys
then [" testPrimopDivLike s l r = Property s $ twoNonZero $ " ++ test_lambda]
else [])
+ ++ (if mb_shiftable_tys
+ then [" testPrimopShift s l r = Property s $ " ++ shift_lambda]
+ else [])
where
arg_tys = args inst_ty
-- eg Int -> Int -> a
@@ -718,7 +722,14 @@ gen_foundation_tests (Info _ entries)
[ty1,ty2] -> ty1 == ty2 && ty1 `elem` divableTyCons
_ -> False
+ -- eg SomeType# -> Int# -> SomeType#
+ mb_shiftable_tys = case arg_tys of
+ [ty1,"Int#"] -> let res_type = getResultType inst_ty
+ in ty1 == res_type && ty1 `elem` shiftableTyCons
+ _ -> False
+
mk_body s = res_ty inst_ty (" (" ++ s ++ " " ++ intercalate " " vs ++ ")")
+ mk_shift_body s = res_ty inst_ty (" (" ++ s ++ " x0 (uInt# shift))")
vs = zipWith (\n _ -> "x" ++ show n) [0::Int ..] (arg_tys)
@@ -761,6 +772,8 @@ gen_foundation_tests (Info _ entries)
, (testable (ty po))
= let testPrimOpHow = if is_divLikeOp po
then "testPrimopDivLike"
+ else if is_shiftLikeOp po
+ then "testPrimopShift"
else "testPrimop"
qualOp qualification =
let qName = wrap qualification poName
@@ -784,6 +797,17 @@ gen_foundation_tests (Info _ entries)
testableTyCon _ = False
divableTyCons = ["Int#", "Word#", "Word8#", "Word16#", "Word32#", "Word64#"
,"Int8#", "Int16#", "Int32#", "Int64#"]
+ shiftableTyCons = ["Int#", "Word#", "Word8#", "Word16#", "Word32#", "Word64#"
+ ,"Int8#", "Int16#", "Int32#", "Int64#"]
+
+ dropMagicHash :: String -> String
+ dropMagicHash = takeWhile (not . (== '#'))
+
+ getResultType :: Ty -> String
+ getResultType (TyF _ t2) = getResultType t2
+ getResultType (TyApp (TyCon c) []) = c
+ getResultType (TyUTup _) = "" -- Unboxed tuples can't be shift operations
+ getResultType t = error $ "getResultType: unexpected type " ++ pprTy t
mb_defined_bits :: Entry -> Maybe Word
mb_defined_bits op@(PrimOpSpec{}) =
=====================================
utils/genprimopcode/Syntax.hs
=====================================
@@ -54,17 +54,23 @@ is_primtype (PrimTypeSpec {}) = True
is_primtype _ = False
is_divLikeOp :: Entry -> Bool
-is_divLikeOp entry = case entry of
- PrimOpSpec{} -> has_div_like
- PseudoOpSpec{} -> has_div_like
- PrimVecOpSpec{} -> has_div_like
- PrimTypeSpec{} -> False
- PrimVecTypeSpec{} -> False
- Section{} -> False
- where
- has_div_like = case lookup_attrib "div_like" (opts entry) of
- Just (OptionTrue{}) -> True
- _ -> False
+is_divLikeOp = is_likeOp "div_like"
+
+is_shiftLikeOp :: Entry -> Bool
+is_shiftLikeOp = is_likeOp "shift_like"
+
+is_likeOp :: String -> Entry -> Bool
+is_likeOp attrName entry = case entry of
+ PrimOpSpec {} -> has_attr
+ PseudoOpSpec {} -> has_attr
+ PrimVecOpSpec {} -> has_attr
+ PrimTypeSpec {} -> False
+ PrimVecTypeSpec {} -> False
+ Section {} -> False
+ where
+ has_attr = case lookup_attrib attrName (opts entry) of
+ Just (OptionTrue {}) -> True
+ _ -> False
-- a binding of property to value
data Option
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/817899db55a16710506380ebd1dbd10…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/817899db55a16710506380ebd1dbd10…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Fix a scoping error in Specialise
by Marge Bot (＠marge-bot) 09 Sep '25
by Marge Bot (＠marge-bot) 09 Sep '25
09 Sep '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
d4871438 by Simon Peyton Jones at 2025-09-09T00:14:59-04:00
Fix a scoping error in Specialise
This small patch fixes #26329, which triggered a scoping error.
Test is in T21391, with -fpolymorphic-specialisation enabled
- - - - -
80d3436c by Andreas Klebinger at 2025-09-09T00:15:01-04:00
Add regression test for #26056
- - - - -
5e052e33 by sheaf at 2025-09-09T00:15:17-04:00
Deep subsumption: unify mults without tcEqMult
As seen in #26332, we may well end up with a non-reflexive multiplicity
coercion when doing deep subsumption. We should do the same thing that
we do without deep subsumption: unify the multiplicities normally,
without requiring that the coercion is reflexive (which is what
'tcEqMult' was doing).
Fixes #26332
- - - - -
90d94d17 by Moritz Angermann at 2025-09-09T00:15:17-04:00
testsuite: Fix broken exec_signals_child.c
There is no signal 0. The signal mask is 1-32.
- - - - -
7 changed files:
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Tc/Utils/Unify.hs
- + testsuite/tests/linear/should_compile/T26332.hs
- testsuite/tests/linear/should_compile/all.T
- + testsuite/tests/profiling/should_compile/T26056.hs
- testsuite/tests/profiling/should_compile/all.T
- testsuite/tests/rts/exec_signals_child.c
Changes:
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -1205,14 +1205,21 @@ specExpr env (Tick tickish body)
---------------- Applications might generate a call instance --------------------
specExpr env expr@(App {})
= do { let (fun_in, args_in) = collectArgs expr
+ ; (fun_out, uds_fun) <- specExpr env fun_in
; (args_out, uds_args) <- mapAndCombineSM (specExpr env) args_in
- ; let env_args = env `bringFloatedDictsIntoScope` ud_binds uds_args
- -- Some dicts may have floated out of args_in;
- -- they should be in scope for fireRewriteRules (#21689)
- (fun_in', args_out') = fireRewriteRules env_args fun_in args_out
- ; (fun_out', uds_fun) <- specExpr env fun_in'
+ ; let uds_app = uds_fun `thenUDs` uds_args
+ env_args = zapSubst env `bringFloatedDictsIntoScope` ud_binds uds_app
+ -- zapSubst: we have now fully applied the substitution
+ -- bringFloatedDictsIntoScope: some dicts may have floated out of
+ -- args_in; they should be in scope for fireRewriteRules (#21689)
+
+ -- Try firing rewrite rules
+ -- See Note [Fire rules in the specialiser]
+ ; let (fun_out', args_out') = fireRewriteRules env_args fun_out args_out
+
+ -- Make a call record, and return
; let uds_call = mkCallUDs env fun_out' args_out'
- ; return (fun_out' `mkApps` args_out', uds_fun `thenUDs` uds_call `thenUDs` uds_args) }
+ ; return (fun_out' `mkApps` args_out', uds_app `thenUDs` uds_call) }
---------------- Lambda/case require dumping of usage details --------------------
specExpr env e@(Lam {})
@@ -1246,17 +1253,18 @@ specExpr env (Let bind body)
-- See Note [Specialisation modulo dictionary selectors]
-- Note [ClassOp/DFun selection]
-- Note [Fire rules in the specialiser]
-fireRewriteRules :: SpecEnv -> InExpr -> [OutExpr] -> (InExpr, [OutExpr])
+fireRewriteRules :: SpecEnv -- Substitution is already zapped
+ -> OutExpr -> [OutExpr] -> (OutExpr, [OutExpr])
fireRewriteRules env (Var f) args
| let rules = getRules (se_rules env) f
, Just (rule, expr) <- specLookupRule env f args activeInInitialPhase rules
, let rest_args = drop (ruleArity rule) args -- See Note [Extra args in the target]
- zapped_subst = Core.zapSubst (se_subst env)
- expr' = simpleOptExprWith defaultSimpleOpts zapped_subst expr
+ zapped_subst = se_subst env -- Just needed for the InScopeSet
+ expr' = simpleOptExprWith defaultSimpleOpts zapped_subst (mkApps expr rest_args)
-- simplOptExpr needed because lookupRule returns
-- (\x y. rhs) arg1 arg2
, (fun', args') <- collectArgs expr'
- = fireRewriteRules env fun' (args'++rest_args)
+ = fireRewriteRules env fun' args'
fireRewriteRules _ fun args = (fun, args)
--------------
@@ -1669,10 +1677,19 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
; let all_rule_bndrs = poly_qvars ++ rule_bndrs
env' = env { se_subst = subst'' }
-{-
- ; pprTrace "spec_call" (vcat
+ -- Check for (a) usefulness and (b) not already covered
+ -- See (SC1) in Note [Specialisations already covered]
+ ; let all_rules = rules_acc ++ existing_rules
+ -- all_rules: we look both in the rules_acc (generated by this invocation
+ -- of specCalls), and in existing_rules (passed in to specCalls)
+ already_covered = alreadyCovered env' all_rule_bndrs fn
+ rule_lhs_args is_active all_rules
+
+{- ; pprTrace "spec_call" (vcat
[ text "fun: " <+> ppr fn
, text "call info: " <+> ppr _ci
+ , text "useful: " <+> ppr useful
+ , text "already_covered:" <+> ppr already_covered
, text "poly_qvars: " <+> ppr poly_qvars
, text "useful: " <+> ppr useful
, text "all_rule_bndrs:" <+> ppr all_rule_bndrs
@@ -1681,17 +1698,13 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
, text "dx_binds:" <+> ppr dx_binds
, text "spec_args: " <+> ppr spec_args
, text "rhs_bndrs" <+> ppr rhs_bndrs
- , text "rhs_body" <+> ppr rhs_body ]) $
+ , text "rhs_body" <+> ppr rhs_body
+ , text "subst''" <+> ppr subst'' ]) $
return ()
-}
- -- Check for (a) usefulness and (b) not already covered
- -- See (SC1) in Note [Specialisations already covered]
- ; let all_rules = rules_acc ++ existing_rules
- -- all_rules: we look both in the rules_acc (generated by this invocation
- -- of specCalls), and in existing_rules (passed in to specCalls)
- ; if not useful -- No useful specialisation
- || alreadyCovered env' all_rule_bndrs fn rule_lhs_args is_active all_rules
+ ; if not useful -- No useful specialisation
+ || already_covered -- Useful, but done already
then return spec_acc
else
@@ -1702,6 +1715,12 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
-- Run the specialiser on the specialised RHS
; (rhs_body', rhs_uds) <- specExpr env'' rhs_body
+{- ; pprTrace "spec_call2" (vcat
+ [ text "fun:" <+> ppr fn
+ , text "rhs_body':" <+> ppr rhs_body' ]) $
+ return ()
+-}
+
-- Make the RHS of the specialised function
; let spec_rhs_bndrs = spec_bndrs ++ inner_rhs_bndrs'
(rhs_uds1, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs rhs_uds
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -1853,8 +1853,8 @@ where we eta-expanded that (:). But now foldr expects an argument
with ->{Many} and gets an argument with ->{m1} or ->{m2}, and Lint
complains.
-The easiest solution was to use tcEqMult in tc_sub_type_deep, and
-insist on equality. This is only in the DeepSubsumption code anyway.
+The easiest solution was to unify the multiplicities in tc_sub_type_deep,
+insisting on equality. This is only in the DeepSubsumption code anyway.
Note [FunTy vs non-FunTy case in tc_sub_type_deep]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2047,10 +2047,7 @@ tc_sub_type_deep pos unify inst_orig ctxt ty_actual ty_expected
-- GenSigCtxt: See Note [Setting the argument context]
; res_wrap <- tc_sub_type_deep (Result pos) unify inst_orig ctxt act_res exp_res
- -- See Note [Multiplicity in deep subsumption]
- ; tcEqMult inst_orig act_mult exp_mult
-
- ; mkWpFun_FRR pos
+ ; mkWpFun_FRR unify pos
act_af act_mult act_arg act_res
exp_af exp_mult exp_arg exp_res
arg_wrap res_wrap
@@ -2058,20 +2055,32 @@ tc_sub_type_deep pos unify inst_orig ctxt ty_actual ty_expected
where
given_orig = GivenOrigin (SigSkol GenSigCtxt exp_arg [])
--- | Like 'mkWpFun', except that it performs representation-polymorphism
--- checks on the argument type.
+-- | Like 'mkWpFun', except that it performs the necessary
+-- representation-polymorphism checks on the argument type in the case that
+-- we introduce a lambda abstraction.
mkWpFun_FRR
- :: Position p
+ :: (TcType -> TcType -> TcM TcCoercionN) -- ^ how to unify
+ -> Position p
-> FunTyFlag -> Type -> TcType -> Type -- actual FunTy
-> FunTyFlag -> Type -> TcType -> Type -- expected FunTy
-> HsWrapper -- ^ exp_arg ~> act_arg
-> HsWrapper -- ^ act_res ~> exp_res
-> TcM HsWrapper -- ^ act_funTy ~> exp_funTy
-mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res arg_wrap res_wrap
- | needs_eta
- -- See Wrinkle [Representation-polymorphism checking during subtyping]
- = do { (exp_arg_co, exp_arg_frr) <- hasFixedRuntimeRep (FRRDeepSubsumption True pos) exp_arg
- ; (act_arg_co, _act_arg_frr) <- hasFixedRuntimeRep (FRRDeepSubsumption False pos) act_arg
+mkWpFun_FRR unify pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res arg_wrap res_wrap
+ = do { ((exp_arg_co, exp_arg_frr), (act_arg_co, _act_arg_frr)) <-
+ if needs_frr_checks
+ -- See Wrinkle [Representation-polymorphism checking during subtyping]
+ then do { exp_frr_wrap <- hasFixedRuntimeRep (frr_ctxt True ) exp_arg
+ ; act_frr_wrap <- hasFixedRuntimeRep (frr_ctxt False) act_arg
+ ; return (exp_frr_wrap, act_frr_wrap) }
+ else return ((mkNomReflCo exp_arg, exp_arg), (mkNomReflCo act_arg, act_arg))
+
+ -- Enforce equality of multiplicities (not the more natural sub-multiplicity).
+ -- See Note [Multiplicity in deep subsumption]
+ ; act_arg_mult_co <- unify act_mult exp_mult
+ -- NB: don't use tcEqMult: that would require the evidence for
+ -- equality to be Refl, but it might well not be (#26332).
+
; let
exp_arg_fun_co =
mkFunCo Nominal exp_af
@@ -2080,7 +2089,7 @@ mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res
(mkReflCo Nominal exp_res)
act_arg_fun_co =
mkFunCo Nominal act_af
- (mkReflCo Nominal act_mult)
+ act_arg_mult_co
act_arg_co
(mkReflCo Nominal act_res)
arg_wrap_frr =
@@ -2090,24 +2099,16 @@ mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res
-- arg_wrap :: exp_arg ~> act_arg
-- arg_wrap_frr :: exp_arg_frr ~> act_arg_frr
- -- NB: because of the needs_eta guard, we know that mkWpFun will
- -- return (WpFun ...); so we might as well just use the WpFun constructor.
; return $
mkWpCastN exp_arg_fun_co
<.>
- WpFun arg_wrap_frr res_wrap (Scaled exp_mult exp_arg_frr)
+ mkWpFun arg_wrap_frr res_wrap (Scaled exp_mult exp_arg_frr) exp_res
<.>
- mkWpCastN act_arg_fun_co }
- | otherwise
- = return $
- mkWpFun arg_wrap res_wrap (Scaled exp_mult exp_arg) exp_res
- -- NB: because of 'needs_eta', this will never actually be a WpFun.
- -- mkWpFun will turn it into a WpHole or WpCast, which is why
- -- we can skip the hasFixedRuntimeRep checks in this case.
- -- See Wrinkle [Representation-polymorphism checking during subtyping]
+ mkWpCastN act_arg_fun_co
+ }
where
- needs_eta :: Bool
- needs_eta =
+ needs_frr_checks :: Bool
+ needs_frr_checks =
not (hole_or_cast arg_wrap)
||
not (hole_or_cast res_wrap)
@@ -2115,6 +2116,12 @@ mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res
hole_or_cast WpHole = True
hole_or_cast (WpCast {}) = True
hole_or_cast _ = False
+ frr_ctxt :: Bool -> FixedRuntimeRepContext
+ frr_ctxt is_exp_ty =
+ FRRDeepSubsumption
+ { frrDSExpected = is_exp_ty
+ , frrDSPosition = pos
+ }
-----------------------
deeplySkolemise :: SkolemInfo -> TcSigmaType
=====================================
testsuite/tests/linear/should_compile/T26332.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE DeepSubsumption #-}
+{-# LANGUAGE LinearTypes #-}
+
+module T26332 where
+
+import Unsafe.Coerce
+
+toLinear
+ :: forall a b p q.
+ (a %p-> b) %1-> (a %q-> b)
+toLinear f = case unsafeEqualityProof @p @q of
+ UnsafeRefl -> f
=====================================
testsuite/tests/linear/should_compile/all.T
=====================================
@@ -41,6 +41,7 @@ test('T19400', unless(compiler_debugged(), skip), compile, [''])
test('T20023', normal, compile, [''])
test('T22546', normal, compile, [''])
test('T23025', normal, compile, ['-dlinear-core-lint'])
+test('T26332', normal, compile, ['-O -dlinear-core-lint'])
test('LinearRecUpd', normal, compile, [''])
test('T23814', normal, compile, [''])
test('LinearLet', normal, compile, [''])
=====================================
testsuite/tests/profiling/should_compile/T26056.hs
=====================================
@@ -0,0 +1,21 @@
+module M where
+
+import GHC.Exts ( Any )
+import Unsafe.Coerce ( unsafeCoerce )
+
+data Sigma = MkT Any
+
+testSubList :: Maybe Bool -> Sigma -> Sigma
+testSubList (Just x) final = {-# SCC "y" #-} (
+ let x' = seq x ()
+ in case testSubList Nothing final of
+ MkT w -> {-# SCC "x" #-}
+ (unsafeCoerce MkT (konst x' myHead (unsafeCoerce w))))
+testSubList Nothing final = final
+
+myHead :: [a] -> a
+myHead (x:_) = x
+
+konst :: () -> ([a] -> a) -> [a] -> a
+konst _ x = x
+{-# OPAQUE konst #-}
=====================================
testsuite/tests/profiling/should_compile/all.T
=====================================
@@ -20,3 +20,4 @@ test('T14931', [test_opts, unless(have_dynamic(), skip)],
test('T15108', [test_opts], compile, ['-O -prof -fprof-auto'])
test('T19894', [test_opts, extra_files(['T19894'])], multimod_compile, ['Main', '-v0 -O2 -prof -fprof-auto -iT19894'])
test('T20938', [test_opts], compile, ['-O -prof'])
+test('T26056', [test_opts], compile, ['-O -prof'])
=====================================
testsuite/tests/rts/exec_signals_child.c
=====================================
@@ -2,8 +2,11 @@
#include <stdio.h>
#include <errno.h>
-// Prints the state of the signal handlers to stdout
-int main()
+// Prints the state of the signal handlers to stdout.
+// NOTE: We intentionally start at signal 1 (not 0). Signal number 0 is not a
+// real signal; passing 0 to sigismember/sigaction is undefined behaviour and
+// on Darwin was observed to yield memory corruption / junk bytes in output.
+int main(void)
{
int open = 0, i;
sigset_t blockedsigs;
@@ -11,7 +14,7 @@ int main()
printf("ChildInfo { masked = [");
sigprocmask(SIG_BLOCK, NULL, &blockedsigs);
- for(i = 0; i < NSIG; ++i)
+ for(i = 1; i < NSIG; ++i)
{
int ret = sigismember(&blockedsigs, i);
if(ret >= 0)
@@ -26,7 +29,7 @@ int main()
printf("], handlers = [");
open = 0;
- for(i = 0; i < NSIG; ++i)
+ for(i = 1; i < NSIG; ++i)
{
struct sigaction old;
if(sigaction(i, NULL, &old) >= 0)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ddfe1af3ca965eea83eb737227477…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ddfe1af3ca965eea83eb737227477…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/angerman/test-mk-leading-underscore] test.mk expect GhcLeadingUnderscore, not LeadingUnderscore (in line with the...
by Moritz Angermann (＠angerman) 09 Sep '25
by Moritz Angermann (＠angerman) 09 Sep '25
09 Sep '25
Moritz Angermann pushed to branch wip/angerman/test-mk-leading-underscore at Glasgow Haskell Compiler / GHC
Commits:
6864165e by Moritz Angermann at 2025-09-09T11:39:04+09:00
test.mk expect GhcLeadingUnderscore, not LeadingUnderscore (in line with the other Ghc prefixed variables.
- - - - -
2 changed files:
- hadrian/src/Oracles/TestSettings.hs
- testsuite/ghc-config/ghc-config.hs
Changes:
=====================================
hadrian/src/Oracles/TestSettings.hs
=====================================
@@ -73,7 +73,7 @@ testSetting key = do
TestLLC -> "LLC"
TestTEST_CC -> "TEST_CC"
TestTEST_CC_OPTS -> "TEST_CC_OPTS"
- TestLeadingUnderscore -> "LeadingUnderscore"
+ TestLeadingUnderscore -> "GhcLeadingUnderscore"
TestGhcPackageDb -> "GhcGlobalPackageDb"
TestGhcLibDir -> "GhcLibdir"
=====================================
testsuite/ghc-config/ghc-config.hs
=====================================
@@ -43,7 +43,7 @@ main = do
getGhcFieldOrDefault fields "TargetRTSLinkerOnlySupportsSharedLibs" "target RTS linker only supports shared libraries" "NO"
getGhcFieldOrDefault fields "GhcDynamic" "GHC Dynamic" "NO"
getGhcFieldOrDefault fields "GhcProfiled" "GHC Profiled" "NO"
- getGhcFieldOrDefault fields "LeadingUnderscore" "Leading underscore" "NO"
+ getGhcFieldOrDefault fields "GhcLeadingUnderscore" "Leading underscore" "NO"
getGhcFieldOrDefault fields "GhcTablesNextToCode" "Tables next to code" "NO"
getGhcFieldProgWithDefault fields "AR" "ar command" "ar"
getGhcFieldProgWithDefault fields "LLC" "LLVM llc command" "llc"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6864165ece81f27091f059e45d4efda…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6864165ece81f27091f059e45d4efda…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/warning-for-last-and-init] 5 commits: Refactor ForAllCo
by Bodigrim (＠Bodigrim) 08 Sep '25
by Bodigrim (＠Bodigrim) 08 Sep '25
08 Sep '25
Bodigrim pushed to branch wip/warning-for-last-and-init at Glasgow Haskell Compiler / GHC
Commits:
94b62aa7 by Simon Peyton Jones at 2025-09-08T03:37:14-04:00
Refactor ForAllCo
This is a pure refactor, addressing #26389.
It arranges that the kind coercion in a ForAllCo is a MCoercion, rather
than a plain Coercion, thus removing redundancy in the common case.
See (FC8) in Note [ForAllCo]
It's a nice cleanup.
- - - - -
624afa4a by sheaf at 2025-09-08T03:38:05-04:00
Use tcMkScaledFunTys in matchExpectedFunTys
We should use tcMkScaledFunTys rather than mkScaledFunTys in
GHC.Tc.Utils.Unify.matchExpectedFunTys, as the latter crashes
when the kind of the result type is a bare metavariable.
We know the result is always Type-like, so we don't need scaledFunTys
to try to rediscover that from the kind.
Fixes #26277
- - - - -
0975d2b6 by sheaf at 2025-09-08T03:38:54-04:00
Revert "Remove hptAllFamInstances usage during upsweep"
This reverts commit 3bf6720eff5e86e673568e756161e6d6150eb440.
- - - - -
0cf34176 by soulomoon at 2025-09-08T03:38:54-04:00
Family consistency checks: add test for #26154
This commit adds the test T26154, to make sure that GHC doesn't crash
when performing type family consistency checks. This test case
was extracted from Agda.
Fixes #26154
- - - - -
846d48a2 by Mike Pilgrem at 2025-09-08T22:55:43+01:00
Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial
Also corrects the warning for `tail` to refer to `Data.List.uncons` (like the existing warning for `head`).
In module `Settings.Warnings`, applies `-Wno-x-partial` to the `filepath`, and `parsec` packages (outside GHC's repository).
Also bumps submodules.
- - - - -
60 changed files:
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion.hs-boot
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Reduction.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Session/Units.hs
- compiler/GHC/Iface/Rename.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Prelude/Basic.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/Home/PackageTable.hs
- ghc/GHCi/UI.hs
- ghc/Main.hs
- hadrian/src/Settings/Warnings.hs
- libraries/base/changelog.md
- libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs
- libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs
- testsuite/tests/driver/j-space/jspace.hs
- testsuite/tests/rts/KeepCafsBase.hs
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- + testsuite/tests/typecheck/should_compile/T26154.hs
- + testsuite/tests/typecheck/should_compile/T26154_A.hs
- + testsuite/tests/typecheck/should_compile/T26154_B.hs
- + testsuite/tests/typecheck/should_compile/T26154_B.hs-boot
- + testsuite/tests/typecheck/should_compile/T26154_Other.hs
- + testsuite/tests/typecheck/should_compile/T26277.hs
- testsuite/tests/typecheck/should_compile/all.T
- utils/check-exact/Main.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/ghc-pkg/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/CheckArm.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs
- utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
- utils/hpc
- utils/hsc2hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f3e2ac35e68f007cc3f3c7bce3df7…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f3e2ac35e68f007cc3f3c7bce3df7…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/obtaining-os-handles] 3 commits: Abandon handle type checks and improve documentation
by Wolfgang Jeltsch (＠jeltsch) 08 Sep '25
by Wolfgang Jeltsch (＠jeltsch) 08 Sep '25
08 Sep '25
Wolfgang Jeltsch pushed to branch wip/jeltsch/obtaining-os-handles at Glasgow Haskell Compiler / GHC
Commits:
ed1671b0 by Wolfgang Jeltsch at 2025-09-08T22:40:33+03:00
Abandon handle type checks and improve documentation
The checks done by `wantReadableHandle_` and `wantWritableHandle` are
problematic in situations where the user wants to obtain
operating-system handles independently of readability or writability.
- - - - -
552cbb2e by Wolfgang Jeltsch at 2025-09-08T23:44:33+03:00
Add missing obtaining of the device from the handle state
- - - - -
b866a4a9 by Wolfgang Jeltsch at 2025-09-09T00:14:59+03:00
Fix the texts regarding handle type errors
Note, in particular, that the operations for obtaining operating-system
handles also fail with socket-based handles; so failure is not just
about the I/O manager in use.
- - - - -
1 changed file:
- libraries/base/src/GHC/IO/Handle.hs
Changes:
=====================================
libraries/base/src/GHC/IO/Handle.hs
=====================================
@@ -76,10 +76,10 @@ module GHC.IO.Handle
hPutBufNonBlocking,
-- * Obtaining file descriptors and Windows handles
- withReadingFileDescriptor,
- withWritingFileDescriptor,
- withReadingWindowsHandle,
- withWritingWindowsHandle
+ withFileDescriptorReadingBiased,
+ withFileDescriptorWritingBiased,
+ withWindowsHandleReadingBiased,
+ withWindowsHandleWritingBiased
-- ** Caveats
-- $with-ref-caveats
@@ -88,6 +88,7 @@ module GHC.IO.Handle
import GHC.Internal.IO.Handle
import GHC.Internal.Control.Monad (return)
+import GHC.Internal.Control.Concurrent.MVar (MVar)
import GHC.Internal.Control.Exception (mask)
import GHC.Internal.Data.Function ((.), ($))
import GHC.Internal.Data.Functor (fmap)
@@ -112,13 +113,12 @@ import GHC.Internal.IO.Windows.Handle
toHANDLE
)
#endif
-import GHC.Internal.IO.Handle.Types (Handle__)
-import GHC.Internal.IO.Handle.Internals
+import GHC.Internal.IO.Handle.Types
(
- wantReadableHandle_,
- wantWritableHandle,
- flushBuffer
+ Handle (FileHandle, DuplexHandle),
+ Handle__ (Handle__, haDevice)
)
+import GHC.Internal.IO.Handle.Internals (withHandle_', flushBuffer)
import GHC.Internal.IO.Exception
(
IOErrorType (IllegalOperation),
@@ -128,82 +128,116 @@ import GHC.Internal.IO.Exception
import GHC.Internal.Foreign.Ptr (Ptr)
import GHC.Internal.Foreign.C.Types (CInt)
--- * Obtaining file descriptors and Windows handles
+-- * Obtaining POSIX file descriptors and Windows handles
{-|
- Obtains from a handle an underlying operating-system reference for reading
- or writing and executes a user-provided action on it. The Haskell-side
- buffers of the handle are flushed before this action is run. While this
- action is executed, further operations on the handle are blocked to a degree
- that interference with this action is prevented.
+ Obtains an operating-system handle that underlies a Haskell handle and
+ executes a user-provided action on it. The Haskell-managed buffers related
+ to the operating-system handle are flushed before the user-provided action
+ is run. While this action is executed, further operations on the Haskell
+ handle are blocked to a degree that interference with this action is
+ prevented.
See [below](#with-ref-caveats) for caveats regarding this operation.
-}
-withRef :: (Handle -> (Handle__ -> IO a) -> IO a)
- -- ^ Obtaining of an appropriately prepared handle side from a handle
- -> (forall d. Typeable d => d -> IO r)
- -- ^ Conversion of a device into an operating-system reference
- -> Handle
- -- ^ The handle to use
- -> (r -> IO a)
- -- ^ The action to execute on the operating-system reference
- -> IO a
-withRef withHandleSide getRef handle act
+withOSHandle :: String
+ -- ^ The name of the overall operation
+ -> (Handle -> MVar Handle__)
+ {-^
+ Obtaining of the handle state variable that holds the
+ operating-system handle
+ -}
+ -> (forall d. Typeable d => d -> IO a)
+ -- ^ Conversion of a device into an operating-system handle
+ -> Handle
+ -- ^ The Haskell handle to use
+ -> (a -> IO r)
+ -- ^ The action to execute on the operating-system handle
+ -> IO r
+withOSHandle opName handleStateVar getOSHandle handle act
= mask $ \ withOriginalMaskingState ->
- withHandleSide handle $ \ handleSide -> do
- ref <- getRef handleSide
- flushBuffer handleSide
- withOriginalMaskingState $ act ref
+ withHandleState $ \ handleState@Handle__ {haDevice = dev} -> do
+ osHandle <- getOSHandle dev
+ flushBuffer handleState
+ withOriginalMaskingState $ act osHandle
+ where
+
+ withHandleState = withHandle_' opName handle (handleStateVar handle)
{-
- The public operations that use 'withRef' provide 'withHandleSide' arguments
- that perform masking. Still, we have to use 'mask' here, in order do obtain
- the operation that restores the original masking state. The user-provided
- action should be executed with this original masking state, as there is no
- inherent reason to generally perform it with masking in place. The masking
- that the 'withHandleSide' arguments perform is only for safely accessing
- internal handle data and thus constitutes an implementation detail; it has
- nothing to do with the user-provided action.
+ The 'withHandle_'' operation, which we use here, already performs masking.
+ Still, we have to employ 'mask', in order do obtain the operation that
+ restores the original masking state. The user-provided action should be
+ executed with this original masking state, as there is no inherent reason to
+ generally perform it with masking in place. The masking that 'withHandle_''
+ performs is only for safely accessing handle state and thus constitutes an
+ implementation detail; it has nothing to do with the user-provided action.
-}
{-
- The order of actions in 'withRef' is such that any exception from 'getRef'
- is thrown before the flushing of the Haskell-side buffers.
+ The order of actions in 'withOSHandle' is such that any exception from
+ 'getOSHandle' is thrown before the flushing of the Haskell-managed buffers.
+-}
+
+{-|
+ Obtains the handle state variable that underlies a handle or specifically
+ the handle state variable for reading if the handle uses different state
+ variables for reading and writing.
+-}
+handleStateVarReadingBiased :: Handle -> MVar Handle__
+handleStateVarReadingBiased (FileHandle _ var) = var
+handleStateVarReadingBiased (DuplexHandle _ readingVar _) = readingVar
+
+{-|
+ Obtains the handle state variable that underlies a handle or specifically
+ the handle state variable for writing if the handle uses different state
+ variables for reading and writing.
-}
+handleStateVarWritingBiased :: Handle -> MVar Handle__
+handleStateVarWritingBiased (FileHandle _ var) = var
+handleStateVarWritingBiased (DuplexHandle _ _ writingVar) = writingVar
{-|
Yields the result of another operation if that operation succeeded, and
otherwise throws an exception that signals that the other operation failed
- because a certain I/O subsystem is not in use.
+ because the operating-system handle that underlies some Haskell handle is
+ not of a required type.
-}
-requiringSubsystem :: String
- -- ^ The name of the required subsystem
- -> Maybe a
- -- ^ The result of the other operation if it succeeded
- -> IO a
-requiringSubsystem subsystemName
- = maybe (ioException subsystemRequired) return
+requiringOSHandleType :: String
+ {-^
+ The name of the required operating-system handle
+ type
+ -}
+ -> Maybe a
+ -- ^ The result of the other operation if it succeeded
+ -> IO a
+requiringOSHandleType osHandleTypeName
+ = maybe (ioException osHandleTypeRequired) return
where
- subsystemRequired :: IOException
- subsystemRequired = IOError Nothing
- IllegalOperation
- ""
- (subsystemName ++ " I/O subsystem required")
- Nothing
- Nothing
+ osHandleTypeRequired :: IOException
+ osHandleTypeRequired
+ = IOError Nothing
+ IllegalOperation
+ ""
+ ("handle does not use " ++ osHandleTypeName ++ "s")
+ Nothing
+ Nothing
{-|
- Obtains the POSIX file descriptor of a device if the POSIX I/O subsystem is
- in use, and throws an exception otherwise.
+ Obtains the POSIX file descriptor of a device if the device contains one,
+ and throws an exception otherwise.
-}
getFileDescriptor :: Typeable d => d -> IO CInt
-getFileDescriptor = requiringSubsystem "POSIX" . fmap fdFD . cast
+getFileDescriptor = requiringOSHandleType "POSIX file descriptor" .
+ fmap fdFD . cast
{-|
- Obtains the Windows handle of a device if the Windows I/O subsystem is in
- use, and throws an exception otherwise.
+ Obtains the Windows handle of a device if the device contains one, and
+ throws an exception otherwise.
-}
getWindowsHandle :: Typeable d => d -> IO (Ptr ())
-getWindowsHandle = requiringSubsystem "native" . toMaybeWindowsHandle where
+getWindowsHandle = requiringOSHandleType "Windows handle" .
+ toMaybeWindowsHandle
+ where
toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ())
#if defined(mingw32_HOST_OS)
@@ -223,68 +257,76 @@ getWindowsHandle = requiringSubsystem "native" . toMaybeWindowsHandle where
#endif
{-|
- Obtains from a handle a POSIX file descriptor for reading and executes a
- user-provided action on it. The Haskell-side buffers of the handle are
- flushed before this action is run. While this action is executed, further
- operations on the handle are blocked to a degree that interference with this
- action is prevented.
+ Obtains the POSIX file descriptor that underlies a handle or specifically
+ the POSIX file descriptor for reading if the handle uses different file
+ descriptors for reading and writing and executes a user-provided action on
+ it. The Haskell-managed buffers related to the file descriptor are flushed
+ before the user-provided action is run. While this action is executed,
+ further operations on the handle are blocked to a degree that interference
+ with this action is prevented.
- If the I/O subsystem in use is not the POSIX one, an exception is thrown.
+ If the handle does not use POSIX file descriptors, an exception is thrown.
See [below](#with-ref-caveats) for caveats regarding this operation.
-}
-withReadingFileDescriptor :: Handle -> (CInt -> IO a) -> IO a
-withReadingFileDescriptor
- = withRef (wantReadableHandle_ "withReadingFileDescriptor")
- getFileDescriptor
+withFileDescriptorReadingBiased :: Handle -> (CInt -> IO r) -> IO r
+withFileDescriptorReadingBiased = withOSHandle "withFileDescriptorReadingBiased"
+ handleStateVarReadingBiased
+ getFileDescriptor
{-|
- Obtains from a handle a POSIX file descriptor for writing and executes a
- user-provided action on it. The Haskell-side buffers of the handle are
- flushed before this action is run. While this action is executed, further
- operations on the handle are blocked to a degree that interference with this
- action is prevented.
+ Obtains the POSIX file descriptor that underlies a handle or specifically
+ the POSIX file descriptor for writing if the handle uses different file
+ descriptors for reading and writing and executes a user-provided action on
+ it. The Haskell-managed buffers related to the file descriptor are flushed
+ before the user-provided action is run. While this action is executed,
+ further operations on the handle are blocked to a degree that interference
+ with this action is prevented.
- If the I/O subsystem in use is not the POSIX one, an exception is thrown.
+ If the handle does not use POSIX file descriptors, an exception is thrown.
See [below](#with-ref-caveats) for caveats regarding this operation.
-}
-withWritingFileDescriptor :: Handle -> (CInt -> IO a) -> IO a
-withWritingFileDescriptor
- = withRef (wantWritableHandle "withWritingFileDescriptor")
- getFileDescriptor
+withFileDescriptorWritingBiased :: Handle -> (CInt -> IO r) -> IO r
+withFileDescriptorWritingBiased = withOSHandle "withFileDescriptorWritingBiased"
+ handleStateVarWritingBiased
+ getFileDescriptor
{-|
- Obtains from a Haskell handle a Windows handle for reading and executes a
- user-provided action on it. The Haskell-side buffers of the Haskell handle
- are flushed before this action is run. While this action is executed,
- further operations on the handle are blocked to a degree that interference
+ Obtains the Windows handle that underlies a Haskell handle or specifically
+ the Windows handle for reading if the Haskell handle uses different Windows
+ handles for reading and writing and executes a user-provided action on it.
+ The Haskell-managed buffers related to the Windows handle are flushed before
+ the user-provided action is run. While this action is executed, further
+ operations on the Haskell handle are blocked to a degree that interference
with this action is prevented.
- If the I/O subsystem in use is not the Windows one, an exception is thrown.
+ If the Haskell handle does not use Windows handles, an exception is thrown.
See [below](#with-ref-caveats) for caveats regarding this operation.
-}
-withReadingWindowsHandle :: Handle -> (Ptr () -> IO a) -> IO a
-withReadingWindowsHandle
- = withRef (wantReadableHandle_ "withReadingWindowsHandle")
- getWindowsHandle
+withWindowsHandleReadingBiased :: Handle -> (Ptr () -> IO r) -> IO r
+withWindowsHandleReadingBiased = withOSHandle "withWindowsHandleReadingBiased"
+ handleStateVarReadingBiased
+ getWindowsHandle
{-|
- Obtains from a Haskell handle a Windows handle for writing and executes a
- user-provided action on it. The Haskell-side buffers of the Haskell handle
- are flushed before this action is run. While this action is executed,
- further operations on the handle are blocked to a degree that interference
+ Obtains the Windows handle that underlies a Haskell handle or specifically
+ the Windows handle for writing if the Haskell handle uses different Windows
+ handles for reading and writing and executes a user-provided action on it.
+ The Haskell-managed buffers related to the Windows handle are flushed before
+ the user-provided action is run. While this action is executed, further
+ operations on the Haskell handle are blocked to a degree that interference
with this action is prevented.
- If the I/O subsystem in use is not the Windows one, an exception is thrown.
+ If the Haskell handle does not use Windows handles, an exception is thrown.
See [below](#with-ref-caveats) for caveats regarding this operation.
-}
-withWritingWindowsHandle :: Handle -> (Ptr () -> IO a) -> IO a
-withWritingWindowsHandle
- = withRef (wantWritableHandle "withWritingWindowsHandle")
- getWindowsHandle
+withWindowsHandleWritingBiased :: Handle -> (Ptr () -> IO r) -> IO r
+withWindowsHandleWritingBiased = withOSHandle "withWindowsHandleWritingBiased"
+ handleStateVarWritingBiased
+ getWindowsHandle
-- ** Caveats
@@ -305,8 +347,8 @@ withWritingWindowsHandle
- When the computation is later resumed due to another evaluation
attempt, the blocking of handle operations is reinstantiated, the
- Haskell-side buffers are flushed again, and the user-provided action
- is run from the beginning.
+ Haskell-managed buffers are flushed again, and the user-provided
+ action is run from the beginning.
Repeating the previously executed part of the user-provided action
cannot be avoided apparently. See the @[async]@ note in the source code
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ab6e00a7b33fe5066f53543d8148c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ab6e00a7b33fe5066f53543d8148c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/alpine-3_22] 27 commits: Driver: substitute virtual Prim module in --make mode too
by Cheng Shao (＠TerrorJack) 08 Sep '25
by Cheng Shao (＠TerrorJack) 08 Sep '25
08 Sep '25
Cheng Shao pushed to branch wip/alpine-3_22 at Glasgow Haskell Compiler / GHC
Commits:
6c78de2d by Sylvain Henry at 2025-09-01T08:46:19-04:00
Driver: substitute virtual Prim module in --make mode too
When we build ghc-internal with --make (e.g. with cabal-install), we
need to be careful to substitute the virtual interface file for
GHC.Internal.Prim:
- after code generation (we generate code for an empty module, so we get
an empty interface)
- when we try to reload its .hi file
- - - - -
26e0db16 by fendor at 2025-09-01T08:47:01-04:00
Expose Stack Annotation frames in IPE backtraces by default
When decoding the Haskell-native call stack and displaying the IPE information
for the stack frames, we print the `StackAnnotation` of the `AnnFrame` by default.
This means, when an exception is thrown, any intermediate stack annotations will
be displayed in the `IPE Backtrace`.
Example backtrace:
```
Exception: ghc-internal:GHC.Internal.Exception.ErrorCall:
Oh no!
IPE backtrace:
annotateCallStackIO, called at app/Main.hs:48:10 in backtrace-0.1.0.0-inplace-server:Main
annotateCallStackIO, called at app/Main.hs:46:13 in backtrace-0.1.0.0-inplace-server:Main
Main.handler (app/Main.hs:(46,1)-(49,30))
Main.liftIO (src/Servant/Server/Internal/Handler.hs:30:36-42)
Servant.Server.Internal.Delayed.runHandler' (src/Servant/Server/Internal/Handler.hs:27:31-41)
Control.Monad.Trans.Resource.runResourceT (./Control/Monad/Trans/Resource.hs:(192,14)-(197,18))
Network.Wai.Handler.Warp.HTTP1.processRequest (./Network/Wai/Handler/Warp/HTTP1.hs:195:20-22)
Network.Wai.Handler.Warp.HTTP1.processRequest (./Network/Wai/Handler/Warp/HTTP1.hs:(195,5)-(203,31))
Network.Wai.Handler.Warp.HTTP1.http1server.loop (./Network/Wai/Handler/Warp/HTTP1.hs:(141,9)-(157,42))
HasCallStack backtrace:
error, called at app/Main.hs:48:32 in backtrace-0.1.0.0-inplace-server:Main
```
The first two entries have been added by `annotateCallStackIO`, defined in `annotateCallStackIO`.
- - - - -
a1567efd by Sylvain Henry at 2025-09-01T23:01:35-04:00
RTS: rely less on Hadrian for flag setting (#25843)
Hadrian used to pass -Dfoo command-line flags directly to build the rts.
We can replace most of these flags with CPP based on cabal flags.
It makes building boot libraries with cabal-install simpler (cf #25843).
- - - - -
ca5b0283 by Sergey Vinokurov at 2025-09-01T23:02:23-04:00
Remove unnecessary irrefutable patterns from Bifunctor instances for tuples
Implementation of https://github.com/haskell/core-libraries-committee/issues/339
Metric Decrease:
mhu-perf
- - - - -
2da84b7a by sheaf at 2025-09-01T23:03:23-04:00
Only use active rules when simplifying rule RHSs
When we are simplifying the RHS of a rule, we make sure to only apply
rewrites from rules that are active throughout the original rule's
range of active phases.
For example, if a rule is always active, we only fire rules that are
themselves always active when simplifying the RHS. Ditto for inline
activations.
This is achieved by setting the simplifier phase to a range of phases,
using the new SimplPhaseRange constructor. Then:
1. When simplifying the RHS of a rule, or of a stable unfolding,
we set the simplifier phase to a range of phases, computed from
the activation of the RULE/unfolding activation, using the
function 'phaseFromActivation'.
The details are explained in Note [What is active in the RHS of a RULE?]
in GHC.Core.Opt.Simplify.Utils.
2. The activation check for other rules and inlinings is then:
does the activation of the other rule/inlining cover the whole
phase range set in sm_phase? This continues to use the 'isActive'
function, which now accounts for phase ranges.
On the way, this commit also moves the exact-print SourceText annotation
from the Activation datatype to the ActivationAnn type. This keeps the
main Activation datatype free of any extra cruft.
Fixes #26323
- - - - -
79816cc4 by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
cleanup: Move dehydrateCgBreakInfo to Stg2Bc
This no longer has anything to do with Core.
- - - - -
53da94ff by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
rts/Disassembler: Fix spacing of BRK_FUN
- - - - -
08c0cf85 by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
debugger: Fix bciPtr in Step-out
We need to use `BCO_NEXT` to move bciPtr to ix=1, because ix=0 points to
the instruction itself!
I do not understand how this didn't crash before.
- - - - -
e7e021fa by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
debugger: Allow BRK_FUNs to head case continuation BCOs
When we start executing a BCO, we may want to yield to the scheduler:
this may be triggered by a heap/stack check, context switch, or a
breakpoint. To yield, we need to put the stack in a state such that
when execution is resumed we are back to where we yielded from.
Previously, a BKR_FUN could only head a function BCO because we only
knew how to construct a valid stack for yielding from one -- simply add
`apply_interp_info` + the BCO to resume executing. This is valid because
the stack at the start of run_BCO is headed by that BCO's arguments.
However, in case continuation BCOs (as per Note [Case continuation BCOs]),
we couldn't easily reconstruct a valid stack that could be resumed
because we dropped too soon the stack frames regarding the value
returned (stg_ret) and received (stg_ctoi) by that continuation.
This is especially tricky because of the variable type and size return
frames (e.g. pointer ret_p/ctoi_R1p vs a tuple ret_t/ctoi_t2).
The trick to being able to yield from a BRK_FUN at the start of a case
cont BCO is to stop removing the ret frame headers eagerly and instead
keep them until the BCO starts executing. The new layout at the start of
a case cont. BCO is described by the new Note [Stack layout when entering run_BCO].
Now, we keep the ret_* and ctoi_* frames when entering run_BCO.
A BRK_FUN is then executed if found, and the stack is yielded as-is with
the preserved ret and ctoi frames.
Then, a case cont BCO's instructions always SLIDE off the headers of the
ret and ctoi frames, in StgToByteCode.doCase, turning a stack like
| .... |
+---------------+
| fv2 |
+---------------+
| fv1 |
+---------------+
| BCO |
+---------------+
| stg_ctoi_ret_ |
+---------------+
| retval |
+---------------+
| stg_ret_..... |
+---------------+
into
| .... |
+---------------+
| fv2 |
+---------------+
| fv1 |
+---------------+
| retval |
+---------------+
for the remainder of the BCO.
Moreover, this more uniform approach of keeping the ret and ctoi frames
means we need less ad-hoc logic concerning the variable size of
ret_tuple vs ret_p/np frames in the code generator and interpreter:
Always keep the return to cont. stack intact at the start of run_BCO,
and the statically generated instructions will take care of adjusting
it.
Unlocks BRK_FUNs at the start of case cont. BCOs which will enable a
better user-facing step-out (#26042) which is free of the bugs the
current BRK_ALTS implementation suffers from (namely, using BRK_FUN
rather than BRK_ALTS in a case cont. means we'll never accidentally end
up in a breakpoint "deeper" than the continuation, because we stop at
the case cont itself rather than on the first breakpoint we evaluate
after it).
- - - - -
ade3c1e6 by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
BRK_FUN with InternalBreakLocs for code-generation time breakpoints
At the start of a case continuation BCO, place a BRK_FUN.
This BRK_FUN uses the new "internal breakpoint location" -- allowing us
to come up with a valid source location for this breakpoint that is not associated with a source-level tick.
For case continuation BCOs, we use the last tick seen before it as the
source location. The reasoning is described in Note [Debugger: Stepout internal break locs].
Note how T26042c, which was broken because it displayed the incorrect
behavior of the previous step out when we'd end up at a deeper level
than the one from which we initiated step-out, is now fixed.
As of this commit, BRK_ALTS is now dead code and is thus dropped.
Note [Debugger: Stepout internal break locs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Step-out tells the interpreter to run until the current function
returns to where it was called from, and stop there.
This is achieved by enabling the BRK_FUN found on the first RET_BCO
frame on the stack (See [Note Debugger: Step-out]).
Case continuation BCOs (which select an alternative branch) must
therefore be headed by a BRK_FUN. An example:
f x = case g x of <--- end up here
1 -> ...
2 -> ...
g y = ... <--- step out from here
- `g` will return a value to the case continuation BCO in `f`
- The case continuation BCO will receive the value returned from g
- Match on it and push the alternative continuation for that branch
- And then enter that alternative.
If we step-out of `g`, the first RET_BCO on the stack is the case
continuation of `f` -- execution should stop at its start, before
selecting an alternative. (One might ask, "why not enable the breakpoint
in the alternative instead?", because the alternative continuation is
only pushed to the stack *after* it is selected by the case cont. BCO)
However, the case cont. BCO is not associated with any source-level
tick, it is merely the glue code which selects alternatives which do
have source level ticks. Therefore, we have to come up at code
generation time with a breakpoint location ('InternalBreakLoc') to
display to the user when it is stopped there.
Our solution is to use the last tick seen just before reaching the case
continuation. This is robust because a case continuation will thus
always have a relevant breakpoint location:
- The source location will be the last source-relevant expression
executed before the continuation is pushed
- So the source location will point to the thing you've just stepped
out of
- Doing :step-local from there will put you on the selected
alternative (which at the source level may also be the e.g. next
line in a do-block)
Examples, using angle brackets (<<...>>) to denote the breakpoint span:
f x = case <<g x>> {- step in here -} of
1 -> ...
2 -> ...>
g y = <<...>> <--- step out from here
...
f x = <<case g x of <--- end up here, whole case highlighted
1 -> ...
2 -> ...>>
doing :step-local ...
f x = case g x of
1 -> <<...>> <--- stop in the alternative
2 -> ...
A second example based on T26042d2, where the source is a do-block IO
action, optimised to a chain of `case expressions`.
main = do
putStrLn "hello1"
<<f>> <--- step-in here
putStrLn "hello3"
putStrLn "hello4"
f = do
<<putStrLn "hello2.1">> <--- step-out from here
putStrLn "hello2.2"
...
main = do
putStrLn "hello1"
<<f>> <--- end up here again, the previously executed expression
putStrLn "hello3"
putStrLn "hello4"
doing step/step-local ...
main = do
putStrLn "hello1"
f
<<putStrLn "hello3">> <--- straight to the next line
putStrLn "hello4"
Finishes #26042
- - - - -
c66910c0 by Rodrigo Mesquita at 2025-09-02T12:19:59-04:00
debugger: Re-use the last BreakpointId whole in step-out
Previously, to come up with a location to stop at for `:stepout`, we
would store the location of the last BreakpointId surrounding the
continuation, as described by Note [Debugger: Stepout internal break locs].
However, re-using just the location from the last source breakpoint
isn't sufficient to provide the necessary information in the break
location. Specifically, it wouldn't bind any variables at that location.
Really, there is no reason not to re-use the last breakpoint wholesale,
and re-use all the information we had there. Step-out should behave just
as if we had stopped at the call, but s.t. continuing will not
re-execute the call.
This commit updates the CgBreakInfo to always store a BreakpointId, be
it the original one or the one we're emulating (for step-out).
It makes variable bindings on :stepout work
- - - - -
e4abed7b by sheaf at 2025-09-02T12:20:40-04:00
Revert accidental changes to hie.yaml
- - - - -
003b715b by meooow25 at 2025-09-02T23:48:51+02:00
Adjust the strictness of Data.List.iterate'
* Don't force the next element in advance when generating a (:).
* Force the first element to WHNF like every other element.
Now every element in the output list is forced to WHNF when the (:)
containing it is forced.
CLC proposal:
https://github.com/haskell/core-libraries-committee/issues/335
- - - - -
b2f6aad0 by Simon Hengel at 2025-09-03T04:36:10-04:00
Refactoring: More consistently use logOutput, logInfo, fatalErrorMsg
- - - - -
60a16db7 by Rodrigo Mesquita at 2025-09-03T10:55:50+01:00
bytecode: Don't PUSH_L 0; SLIDE 1 1
While looking through bytecode I noticed a quite common unfortunate
pattern:
...
PUSH_L 0
SLIDE 1 1
We do this often by generically constructing a tail call from a function
atom that may be somewhere arbitrary on the stack.
However, for the special case that the function can be found directly on
top of the stack, as part of the arguments, it's plain redundant to push
then slide it.
In this commit we add a small optimisation to the generation of
tailcalls in bytecode. Simply: lookahead for the function in the stack.
If it is the first thing on the stack and it is part of the arguments
which would be dropped as we entered the tail call, then don't push then
slide it.
In a simple example (T26042b), this already produced a drastic
improvement in generated code (left is old, right is with this patch):
```diff
3c3
< 2025-07-29 10:14:02.081277 UTC
---
> 2025-07-29 10:50:36.560949 UTC
160,161c160
< PUSH_L 0
< SLIDE 1 2
---
> SLIDE 1 1
164,165d162
< PUSH_L 0
< SLIDE 1 1
175,176c172
< PUSH_L 0
< SLIDE 1 2
---
> SLIDE 1 1
179,180d174
< PUSH_L 0
< SLIDE 1 1
206,207d199
< PUSH_L 0
< SLIDE 1 1
210,211d201
< PUSH_L 0
< SLIDE 1 1
214,215d203
< PUSH_L 0
< SLIDE 1 1
218,219d205
< PUSH_L 0
< SLIDE 1 1
222,223d207
< PUSH_L 0
< SLIDE 1 1
...
600,601c566
< PUSH_L 0
< SLIDE 1 2
---
> SLIDE 1 1
604,605d568
< PUSH_L 0
< SLIDE 1 1
632,633d594
< PUSH_L 0
< SLIDE 1 1
636,637d596
< PUSH_L 0
< SLIDE 1 1
640,641d598
< PUSH_L 0
< SLIDE 1 1
644,645d600
< PUSH_L 0
< SLIDE 1 1
648,649d602
< PUSH_L 0
< SLIDE 1 1
652,653d604
< PUSH_L 0
< SLIDE 1 1
656,657d606
< PUSH_L 0
< SLIDE 1 1
660,661d608
< PUSH_L 0
< SLIDE 1 1
664,665d610
< PUSH_L 0
< SLIDE 1 1
```
I also compiled lib:Cabal to bytecode and counted the number of bytecode
lines with `find dist-newstyle -name "*.dump-BCOs" -exec wc {} +`:
with unoptimized core:
1190689 lines (before) - 1172891 lines (now)
= 17798 less redundant instructions (-1.5% lines)
with optimized core:
1924818 lines (before) - 1864836 lines (now)
= 59982 less redundant instructions (-3.1% lines)
- - - - -
8b2c72c0 by L0neGamer at 2025-09-04T06:32:03-04:00
Add Control.Monad.thenM and Control.Applicative.thenA
- - - - -
39e1b7cb by Teo Camarasu at 2025-09-04T06:32:46-04:00
ghc-internal: invert dependency of GHC.Internal.TH.Syntax on Data.Data
This means that Data.Data no longer blocks building TH.Syntax, which
allows greater parallelism in our builds.
We move the Data.Data.Data instances to Data.Data. Quasi depends on
Data.Data for one of its methods, so,
we split the Quasi/Q, etc definition out of GHC.Internal.TH.Syntax
into its own module. This has the added benefit of splitting up this
quite large module.
Previously TH.Syntax was a bottleneck when compiling ghc-internal. Now
it is less of a bottle-neck and is also slightly quicker to
compile (since it no longer contains these instances) at the cost of
making Data.Data slightly more expensive to compile.
TH.Lift which depends on TH.Syntax can also compile quicker and no
longer blocks ghc-internal finishing to compile.
Resolves #26217
-------------------------
Metric Decrease:
MultiLayerModulesTH_OneShot
T13253
T21839c
T24471
Metric Increase:
T12227
-------------------------
- - - - -
bdf82fd2 by Teo Camarasu at 2025-09-04T06:32:46-04:00
compiler: delete unused names in Builtins.Names.TH
returnQ and bindQ are no longer used in the compiler.
There was also a very old comment that referred to them that I have modernized
- - - - -
41a448e5 by Ben Gamari at 2025-09-04T19:21:43-04:00
hadrian: Pass lib & include directories to ghc `Setup configure`
- - - - -
46bb9a79 by Ben Gamari at 2025-09-04T19:21:44-04:00
rts/IPE: Fix compilation when zstd is enabled
This was broken by the refactoring undertaken in
c80dd91c0bf6ac034f0c592f16c548b9408a8481.
Closes #26312.
- - - - -
138a6e34 by sheaf at 2025-09-04T19:22:46-04:00
Make mkCast assertion a bit clearer
This commit changes the assertion message that gets printed when one
calls mkCast with a coercion whose kind does not match the type of the
inner expression. I always found the assertion message a bit confusing,
as it didn't clearly state what exactly was the error.
- - - - -
9d626be1 by sheaf at 2025-09-04T19:22:46-04:00
Simplifier/rules: fix mistakes in Notes & comments
- - - - -
94b62aa7 by Simon Peyton Jones at 2025-09-08T03:37:14-04:00
Refactor ForAllCo
This is a pure refactor, addressing #26389.
It arranges that the kind coercion in a ForAllCo is a MCoercion, rather
than a plain Coercion, thus removing redundancy in the common case.
See (FC8) in Note [ForAllCo]
It's a nice cleanup.
- - - - -
624afa4a by sheaf at 2025-09-08T03:38:05-04:00
Use tcMkScaledFunTys in matchExpectedFunTys
We should use tcMkScaledFunTys rather than mkScaledFunTys in
GHC.Tc.Utils.Unify.matchExpectedFunTys, as the latter crashes
when the kind of the result type is a bare metavariable.
We know the result is always Type-like, so we don't need scaledFunTys
to try to rediscover that from the kind.
Fixes #26277
- - - - -
0975d2b6 by sheaf at 2025-09-08T03:38:54-04:00
Revert "Remove hptAllFamInstances usage during upsweep"
This reverts commit 3bf6720eff5e86e673568e756161e6d6150eb440.
- - - - -
0cf34176 by soulomoon at 2025-09-08T03:38:54-04:00
Family consistency checks: add test for #26154
This commit adds the test T26154, to make sure that GHC doesn't crash
when performing type family consistency checks. This test case
was extracted from Agda.
Fixes #26154
- - - - -
340e78cd by Cheng Shao at 2025-09-08T19:05:25+02:00
rel-eng: update alpine images to 3.22
This patch is a part of #25876 and updates alpine images to 3.22,
while still retaining 3.12 for x86_64 fully_static bindists.
- - - - -
169 changed files:
- .gitlab-ci.yml
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion.hs-boot
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/Pipeline/Types.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Inline.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap.hs
- compiler/GHC/Core/Reduction.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Data/IOEnv.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Rename.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Stg/Lint.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Tc/Deriv/Generics.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Gen/Splice.hs-boot
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types/TH.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/Home/PackageTable.hs
- compiler/GHC/Utils/Binary.hs
- ghc/GHCi/UI.hs
- hadrian/src/Settings/Packages.hs
- libraries/base/changelog.md
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Control/Monad.hs
- libraries/base/src/Data/Array/Byte.hs
- libraries/base/src/Data/Bifunctor.hs
- libraries/base/src/Data/Fixed.hs
- + libraries/ghc-boot-th/GHC/Boot/TH/Monad.hs
- libraries/ghc-boot-th/ghc-boot-th.cabal.in
- libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- + libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- + libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/GHCi/TH.hs
- libraries/template-haskell/Language/Haskell/TH/Quote.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- rts/Disassembler.c
- rts/IPE.c
- rts/Interpreter.c
- rts/Profiling.c
- rts/RtsMessages.c
- rts/RtsUtils.c
- rts/Trace.c
- rts/include/rts/Bytecodes.h
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/deriving/should_compile/T14682.stderr
- testsuite/tests/deriving/should_compile/drv-empty-data.stderr
- + testsuite/tests/driver/make-prim/GHC/Internal/Prim.hs
- + testsuite/tests/driver/make-prim/Makefile
- + testsuite/tests/driver/make-prim/Test.hs
- + testsuite/tests/driver/make-prim/Test2.hs
- + testsuite/tests/driver/make-prim/all.T
- testsuite/tests/ghci.debugger/scripts/T26042b.script
- testsuite/tests/ghci.debugger/scripts/T26042b.stdout
- testsuite/tests/ghci.debugger/scripts/T26042c.script
- testsuite/tests/ghci.debugger/scripts/T26042c.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042d2.hs
- + testsuite/tests/ghci.debugger/scripts/T26042d2.script
- + testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
- testsuite/tests/ghci.debugger/scripts/T26042e.stdout
- testsuite/tests/ghci.debugger/scripts/T26042f.script
- testsuite/tests/ghci.debugger/scripts/T26042f1.stdout
- testsuite/tests/ghci.debugger/scripts/T26042f2.stdout
- testsuite/tests/ghci.debugger/scripts/T26042g.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- testsuite/tests/perf/compiler/T4007.stdout
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- testsuite/tests/simplCore/should_compile/T15056.stderr
- testsuite/tests/simplCore/should_compile/T15445.stderr
- + testsuite/tests/simplCore/should_compile/T26323b.hs
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/simplCore/should_run/T26323.hs
- + testsuite/tests/simplCore/should_run/T26323.stdout
- testsuite/tests/simplCore/should_run/all.T
- testsuite/tests/splice-imports/SI29.stderr
- testsuite/tests/th/T11452.stderr
- testsuite/tests/th/T15321.stderr
- testsuite/tests/th/T7276.stderr
- testsuite/tests/th/TH_NestedSplicesFail3.stderr
- testsuite/tests/th/TH_NestedSplicesFail4.stderr
- + testsuite/tests/typecheck/should_compile/T26154.hs
- + testsuite/tests/typecheck/should_compile/T26154_A.hs
- + testsuite/tests/typecheck/should_compile/T26154_B.hs
- + testsuite/tests/typecheck/should_compile/T26154_B.hs-boot
- + testsuite/tests/typecheck/should_compile/T26154_Other.hs
- + testsuite/tests/typecheck/should_compile/T26277.hs
- testsuite/tests/typecheck/should_compile/all.T
- utils/check-exact/ExactPrint.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae94e62bc02366544bf7fcd3acbf9e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae94e62bc02366544bf7fcd3acbf9e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/supersven/fix-foundation-test-shift-amounts] Add shift_like attribute
by Sven Tennie (＠supersven) 08 Sep '25
by Sven Tennie (＠supersven) 08 Sep '25
08 Sep '25
Sven Tennie pushed to branch wip/supersven/fix-foundation-test-shift-amounts at Glasgow Haskell Compiler / GHC
Commits:
7e0c54cd by Sven Tennie at 2025-09-01T13:28:35+02:00
Add shift_like attribute
Align with div_like.
- - - - -
2 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- utils/genprimopcode/Syntax.hs
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -148,6 +148,7 @@ defaults
vector = []
deprecated_msg = {} -- A non-empty message indicates deprecation
div_like = False -- Second argument expected to be non zero - used for tests
+ shift_like = False -- Second argument expected to be atmost first argument's word size -1 - used for tests
defined_bits = Nothing -- The number of bits the operation is defined for (if not all bits)
-- Note [When do out-of-line primops go in primops.txt.pp]
@@ -312,8 +313,16 @@ primop Int8QuotRemOp "quotRemInt8#" GenPrimOp Int8# -> Int8# -> (# Int8#, Int8#
div_like = True
primop Int8SllOp "uncheckedShiftLInt8#" GenPrimOp Int8# -> Int# -> Int8#
+ with
+ shift_like = True
+
primop Int8SraOp "uncheckedShiftRAInt8#" GenPrimOp Int8# -> Int# -> Int8#
+ with
+ shift_like = True
+
primop Int8SrlOp "uncheckedShiftRLInt8#" GenPrimOp Int8# -> Int# -> Int8#
+ with
+ shift_like = True
primop Int8ToWord8Op "int8ToWord8#" GenPrimOp Int8# -> Word8#
with code_size = 0
@@ -372,7 +381,12 @@ primop Word8XorOp "xorWord8#" GenPrimOp Word8# -> Word8# -> Word8#
primop Word8NotOp "notWord8#" GenPrimOp Word8# -> Word8#
primop Word8SllOp "uncheckedShiftLWord8#" GenPrimOp Word8# -> Int# -> Word8#
+ with
+ shift_like = True
+
primop Word8SrlOp "uncheckedShiftRLWord8#" GenPrimOp Word8# -> Int# -> Word8#
+ with
+ shift_like = True
primop Word8ToInt8Op "word8ToInt8#" GenPrimOp Word8# -> Int8#
with code_size = 0
@@ -422,8 +436,16 @@ primop Int16QuotRemOp "quotRemInt16#" GenPrimOp Int16# -> Int16# -> (# Int16#, I
div_like = True
primop Int16SllOp "uncheckedShiftLInt16#" GenPrimOp Int16# -> Int# -> Int16#
+ with
+ shift_like = True
+
primop Int16SraOp "uncheckedShiftRAInt16#" GenPrimOp Int16# -> Int# -> Int16#
+ with
+ shift_like = True
+
primop Int16SrlOp "uncheckedShiftRLInt16#" GenPrimOp Int16# -> Int# -> Int16#
+ with
+ shift_like = True
primop Int16ToWord16Op "int16ToWord16#" GenPrimOp Int16# -> Word16#
with code_size = 0
@@ -482,7 +504,12 @@ primop Word16XorOp "xorWord16#" GenPrimOp Word16# -> Word16# -> Word16#
primop Word16NotOp "notWord16#" GenPrimOp Word16# -> Word16#
primop Word16SllOp "uncheckedShiftLWord16#" GenPrimOp Word16# -> Int# -> Word16#
+ with
+ shift_like = True
+
primop Word16SrlOp "uncheckedShiftRLWord16#" GenPrimOp Word16# -> Int# -> Word16#
+ with
+ shift_like = True
primop Word16ToInt16Op "word16ToInt16#" GenPrimOp Word16# -> Int16#
with code_size = 0
@@ -532,8 +559,16 @@ primop Int32QuotRemOp "quotRemInt32#" GenPrimOp Int32# -> Int32# -> (# Int32#, I
div_like = True
primop Int32SllOp "uncheckedShiftLInt32#" GenPrimOp Int32# -> Int# -> Int32#
+ with
+ shift_like = True
+
primop Int32SraOp "uncheckedShiftRAInt32#" GenPrimOp Int32# -> Int# -> Int32#
+ with
+ shift_like = True
+
primop Int32SrlOp "uncheckedShiftRLInt32#" GenPrimOp Int32# -> Int# -> Int32#
+ with
+ shift_like = True
primop Int32ToWord32Op "int32ToWord32#" GenPrimOp Int32# -> Word32#
with code_size = 0
@@ -592,7 +627,12 @@ primop Word32XorOp "xorWord32#" GenPrimOp Word32# -> Word32# -> Word32#
primop Word32NotOp "notWord32#" GenPrimOp Word32# -> Word32#
primop Word32SllOp "uncheckedShiftLWord32#" GenPrimOp Word32# -> Int# -> Word32#
+ with
+ shift_like = True
+
primop Word32SrlOp "uncheckedShiftRLWord32#" GenPrimOp Word32# -> Int# -> Word32#
+ with
+ shift_like = True
primop Word32ToInt32Op "word32ToInt32#" GenPrimOp Word32# -> Int32#
with code_size = 0
@@ -637,8 +677,16 @@ primop Int64RemOp "remInt64#" GenPrimOp Int64# -> Int64# -> Int64#
div_like = True
primop Int64SllOp "uncheckedIShiftL64#" GenPrimOp Int64# -> Int# -> Int64#
+ with
+ shift_like = True
+
primop Int64SraOp "uncheckedIShiftRA64#" GenPrimOp Int64# -> Int# -> Int64#
+ with
+ shift_like = True
+
primop Int64SrlOp "uncheckedIShiftRL64#" GenPrimOp Int64# -> Int# -> Int64#
+ with
+ shift_like = True
primop Int64ToWord64Op "int64ToWord64#" GenPrimOp Int64# -> Word64#
with code_size = 0
@@ -692,7 +740,12 @@ primop Word64XorOp "xor64#" GenPrimOp Word64# -> Word64# -> Word64#
primop Word64NotOp "not64#" GenPrimOp Word64# -> Word64#
primop Word64SllOp "uncheckedShiftL64#" GenPrimOp Word64# -> Int# -> Word64#
+ with
+ shift_like = True
+
primop Word64SrlOp "uncheckedShiftRL64#" GenPrimOp Word64# -> Int# -> Word64#
+ with
+ shift_like = True
primop Word64ToInt64Op "word64ToInt64#" GenPrimOp Word64# -> Int64#
with code_size = 0
@@ -865,12 +918,20 @@ primop WordToDoubleOp "word2Double#" GenPrimOp Word# -> Double#
primop IntSllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int#
{Shift left. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
+ with
+ shift_like = True
+
primop IntSraOp "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int#
{Shift right arithmetic. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
+ with
+ shift_like = True
+
primop IntSrlOp "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int#
{Shift right logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
+ with
+ shift_like = True
------------------------------------------------------------------------
section "Word#"
@@ -946,9 +1007,14 @@ primop WordNotOp "not#" GenPrimOp Word# -> Word#
primop WordSllOp "uncheckedShiftL#" GenPrimOp Word# -> Int# -> Word#
{Shift left logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
+ with
+ shift_like = True
+
primop WordSrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word#
{Shift right logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
+ with
+ shift_like = True
primop WordToIntOp "word2Int#" GenPrimOp Word# -> Int#
with code_size = 0
=====================================
utils/genprimopcode/Syntax.hs
=====================================
@@ -54,23 +54,23 @@ is_primtype (PrimTypeSpec {}) = True
is_primtype _ = False
is_divLikeOp :: Entry -> Bool
-is_divLikeOp entry = case entry of
- PrimOpSpec{} -> has_div_like
- PseudoOpSpec{} -> has_div_like
- PrimVecOpSpec{} -> has_div_like
- PrimTypeSpec{} -> False
- PrimVecTypeSpec{} -> False
- Section{} -> False
- where
- has_div_like = case lookup_attrib "div_like" (opts entry) of
- Just (OptionTrue{}) -> True
- _ -> False
+is_divLikeOp = is_likeOp "div_like"
is_shiftLikeOp :: Entry -> Bool
-is_shiftLikeOp (PrimOpSpec {name = n}) = "Shift" `Data.List.isInfixOf` n
-is_shiftLikeOp (PseudoOpSpec {name = n}) = "Shift" `Data.List.isInfixOf` n
-is_shiftLikeOp (PrimVecOpSpec {name = n}) = "Shift" `Data.List.isInfixOf` n
-is_shiftLikeOp _ = False
+is_shiftLikeOp = is_likeOp "shift_like"
+
+is_likeOp :: String -> Entry -> Bool
+is_likeOp attrName entry = case entry of
+ PrimOpSpec {} -> has_attr
+ PseudoOpSpec {} -> has_attr
+ PrimVecOpSpec {} -> has_attr
+ PrimTypeSpec {} -> False
+ PrimVecTypeSpec {} -> False
+ Section {} -> False
+ where
+ has_attr = case lookup_attrib attrName (opts entry) of
+ Just (OptionTrue {}) -> True
+ _ -> False
-- a binding of property to value
data Option
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e0c54cd439149ac5a4471dc5ad4c5a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e0c54cd439149ac5a4471dc5ad4c5a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0