[Git][ghc/ghc][master] 3 commits: SimpleOpt: refactor & push coercions into lambdas
by Marge Bot (＠marge-bot) 16 Nov '25
by Marge Bot (＠marge-bot) 16 Nov '25
16 Nov '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
15b311be by sheaf at 2025-11-15T20:32:02-05:00
SimpleOpt: refactor & push coercions into lambdas
This commit improves the simple optimiser (in GHC.Core.SimpleOpt)
in a couple of ways:
- The logic to push coercion lambdas is shored up.
The function 'pushCoercionIntoLambda' used to be called in 'finish_app',
but this meant we could not continue to optimise the program after
performing this transformation.
Now, we call 'pushCoercionIntoLambda' as part of 'simple_app'.
Doing so can be important when dealing with unlifted newtypes,
as explained in Note [Desugaring unlifted newtypes].
- The code is re-structured to avoid duplication and out-of-sync
code paths.
Now, 'simple_opt_expr' defers to 'simple_app' for the 'App', 'Var',
'Cast' and 'Lam' cases. This means all the logic for those is
centralised in a single place (e.g. the 'go_lam' helper function).
To do this, the general structure is brought a bit closer to the
full-blown simplifier, with a notion of 'continuation'
(see 'SimpleContItem').
This commit also modifies GHC.Core.Opt.Arity.pushCoercionIntoLambda to
apply a substitution (a slight generalisation of its existing implementation).
- - - - -
b33284c7 by sheaf at 2025-11-15T20:32:02-05:00
Improve typechecking of data constructors
This commit changes the way in which we perform typecheck data
constructors, in particular how we make multiplicities line up.
Now, impedance matching occurs as part of the existing subsumption
machinery. See the revamped Note [Typechecking data constructors] in
GHC.Tc.Gen.App, as well as Note [Polymorphisation of linear fields]
in GHC.Core.Multiplicity.
This allows us to get rid of a fair amount of hacky code that was
added with the introduction of LinearTypes; in particular the logic of
GHC.Tc.Gen.Head.tcInferDataCon.
-------------------------
Metric Decrease:
T10421
T14766
T15164
T15703
T19695
T5642
T9630
WWRec
-------------------------
- - - - -
b6faf5d0 by sheaf at 2025-11-15T20:32:02-05:00
Handle unsaturated rep-poly newtypes
This commit allows GHC to handle unsaturated occurrences of unlifted
newtype constructors. The plan is detailed in
Note [Eta-expanding rep-poly unlifted newtypes]
in GHC.Tc.Utils.Concrete: for unsaturated unlifted newtypes, we perform
the appropriate representation-polymorphism check in tcInstFun.
- - - - -
65 changed files:
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Multiplicity.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Utils.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs-boot
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Concrete.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Types/Id/Make.hs
- testsuite/tests/diagnostic-codes/codes.stdout
- testsuite/tests/ghci/scripts/T8959b.stderr
- testsuite/tests/ghci/scripts/ghci051.stderr
- testsuite/tests/indexed-types/should_compile/T12538.stderr
- + testsuite/tests/linear/should_compile/LinearEtaExpansions.hs
- testsuite/tests/linear/should_compile/all.T
- testsuite/tests/linear/should_fail/TypeClass.hs
- testsuite/tests/linear/should_fail/TypeClass.stderr
- testsuite/tests/linear/should_run/LinearGhci.stdout
- testsuite/tests/numeric/should_compile/T16402.stderr-ws-64
- testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/rep-poly/RepPolyCase1.stderr
- − testsuite/tests/rep-poly/RepPolyCase2.stderr
- testsuite/tests/rep-poly/RepPolyRule3.stderr
- testsuite/tests/rep-poly/RepPolyTuple4.stderr
- testsuite/tests/rep-poly/T13233.stderr
- − testsuite/tests/rep-poly/T17021.stderr
- testsuite/tests/rep-poly/T20363b.stderr
- − testsuite/tests/rep-poly/T21650_a.stderr
- − testsuite/tests/rep-poly/T21650_b.stderr
- + testsuite/tests/rep-poly/T26072.hs
- testsuite/tests/rep-poly/UnliftedNewtypesLevityBinder.stderr
- testsuite/tests/rep-poly/all.T
- testsuite/tests/typecheck/should_fail/T15883e.stderr
- testsuite/tests/typecheck/should_fail/T2414.stderr
- testsuite/tests/typecheck/should_fail/T2534.stderr
- testsuite/tests/typecheck/should_fail/T7264.stderr
- utils/haddock/hypsrc-test/ref/src/Classes.html
- utils/haddock/hypsrc-test/ref/src/Quasiquoter.html
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a64a78bc91a57868195d596d98ebb…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a64a78bc91a57868195d596d98ebb…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] AArch64: Simplify CmmAssign and CmmStore
by Marge Bot (＠marge-bot) 16 Nov '25
by Marge Bot (＠marge-bot) 16 Nov '25
16 Nov '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
0a64a78b by Sven Tennie at 2025-11-15T20:31:10-05:00
AArch64: Simplify CmmAssign and CmmStore
The special handling for floats was fake: The general case is always
used. So, the additional code path isn't needed (and only adds
complexity for the reader.)
- - - - -
1 changed file:
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -317,15 +317,9 @@ stmtToInstrs stmt = do
CmmComment s -> return (unitOL (COMMENT (ftext s)))
CmmTick {} -> return nilOL
- CmmAssign reg src
- | isFloatType ty -> assignReg_FltCode format reg src
- | otherwise -> assignReg_IntCode format reg src
- where ty = cmmRegType reg
- format = cmmTypeFormat ty
+ CmmAssign reg src -> assignReg reg src
- CmmStore addr src _alignment
- | isFloatType ty -> assignMem_FltCode format addr src
- | otherwise -> assignMem_IntCode format addr src
+ CmmStore addr src _alignment -> assignMem format addr src
where ty = cmmExprType platform src
format = cmmTypeFormat ty
@@ -1480,13 +1474,8 @@ getAmode _platform _ expr
-- fails when the right hand side is forced into a fixed register
-- (e.g. the result of a call).
-assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
-assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock
-
-assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
-assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock
-
-assignMem_IntCode rep addrE srcE
+assignMem :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
+assignMem rep addrE srcE
= do
(src_reg, _format, code) <- getSomeReg srcE
platform <- getPlatform
@@ -1497,19 +1486,17 @@ assignMem_IntCode rep addrE srcE
`appOL` addr_code
`snocOL` STR rep (OpReg w src_reg) (OpAddr addr))
-assignReg_IntCode _ reg src
+assignReg :: CmmReg -> CmmExpr -> NatM InstrBlock
+assignReg reg src
= do
platform <- getPlatform
let dst = getRegisterReg platform reg
r <- getRegister src
return $ case r of
- Any _ code -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) `consOL` code dst
- Fixed format freg fcode -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) `consOL` (fcode `snocOL` MOV (OpReg (formatToWidth format) dst) (OpReg (formatToWidth format) freg))
-
--- Let's treat Floating point stuff
--- as integer code for now. Opaque.
-assignMem_FltCode = assignMem_IntCode
-assignReg_FltCode = assignReg_IntCode
+ Any _ code -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src)))
+ `consOL` code dst
+ Fixed format freg fcode -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src)))
+ `consOL` (fcode `snocOL` MOV (OpReg (formatToWidth format) dst) (OpReg (formatToWidth format) freg))
-- -----------------------------------------------------------------------------
-- Jumps
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a64a78bc91a57868195d596d98ebbd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a64a78bc91a57868195d596d98ebbd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed to branch wip/T23162-part2 at Glasgow Haskell Compiler / GHC
Commits:
b8821d43 by Simon Peyton Jones at 2025-11-15T23:18:00+00:00
Better
Fix Yikes 3
Ensure we do F a ~ F b for families with no eqns
- - - - -
2 changed files:
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Tc/Solver/FunDeps.hs
Changes:
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -2448,8 +2448,9 @@ isOpenTypeFamilyTyCon (TyCon { tyConDetails = details })
| FamilyTyCon {famTcFlav = OpenSynFamilyTyCon } <- details = True
| otherwise = False
--- | Is this a non-empty closed type family? Returns 'Nothing' for
--- abstract or empty closed families.
+-- | Is this a /non-empty/ closed type family?
+-- Returns 'Nothing' for closed type family with no equations, as well
+-- as for open families, data famlilies, abstract families
isClosedFamilyTyCon_maybe :: TyCon -> Maybe (CoAxiom Branched)
isClosedFamilyTyCon_maybe (TyCon { tyConDetails = details })
| FamilyTyCon {famTcFlav = ClosedSynFamilyTyCon mb} <- details = mb
=====================================
compiler/GHC/Tc/Solver/FunDeps.hs
=====================================
@@ -25,6 +25,7 @@ import GHC.Core.FamInstEnv
import GHC.Core.Coercion
import GHC.Core.Predicate( EqRel(..) )
import GHC.Core.TyCon
+import GHC.Core.Type( tyConAppTyCon_maybe )
import GHC.Core.Unify( tcUnifyTysForInjectivity, typeListsAreApart )
import GHC.Core.Coercion.Axiom
import GHC.Core.TyCo.Subst( elemSubst )
@@ -467,7 +468,8 @@ tryEqFunDeps work_item@(EqCt { eq_lhs = work_lhs
, eq_eq_rel = eq_rel })
| NomEq <- eq_rel
, TyFamLHS fam_tc work_args <- work_lhs -- We have F args ~N# rhs
- = do { eqs_for_me <- simpleStage$ getInertFamEqsFor fam_tc work_args work_rhs
+ = do { simpleStage $ traceTcS "tryEqFunDeps" (ppr work_item)
+ ; eqs_for_me <- simpleStage $ getInertFamEqsFor fam_tc work_args work_rhs
; tryFamEqFunDeps eqs_for_me fam_tc work_args work_item }
| otherwise
= nopStage ()
@@ -482,7 +484,7 @@ tryFamEqFunDeps eqs_for_me fam_tc work_args
else do { -- Note [Do local fundeps before top-level instances]
tryFDEqns fam_tc work_args work_item $
mkLocalBuiltinFamEqFDs eqs_for_me fam_tc ops work_args work_rhs
- ; if null eqs_for_me
+ ; if all (isWanted . eqCtEvidence) eqs_for_me
then tryFDEqns fam_tc work_args work_item $
mkTopBuiltinFamEqFDs fam_tc ops work_args work_rhs
else nopStage () }
@@ -492,38 +494,37 @@ tryFamEqFunDeps eqs_for_me fam_tc work_args
-- Only Wanted constraints below here
- | isOpenTypeFamilyTyCon fam_tc
- , Injective inj_flags <- tyConInjectivityInfo fam_tc
- = -- Open, injective type families
- do { -- Note [Do local fundeps before top-level instances]
- tryFDEqns fam_tc work_args work_item $
- mkLocalFamEqFDs eqs_for_me fam_tc inj_flags work_args work_rhs
-
- ; if null eqs_for_me
- then tryFDEqns fam_tc work_args work_item $
- mkTopOpenFamEqFDs fam_tc inj_flags work_args work_rhs
- else nopStage () }
-
- | Just ax <- isClosedFamilyTyCon_maybe fam_tc
- = -- Closed type families
- do { -- Note [Do local fundeps before top-level instances]
- simpleStage $ traceTcS "fundep closed" (ppr fam_tc)
-
- ; case tyConInjectivityInfo fam_tc of
+ | otherwise -- Wanted, user-defined type families
+ = do { -- Note [Do local fundeps before top-level instances]
+ case tyConInjectivityInfo fam_tc of
NotInjective -> nopStage()
Injective inj -> tryFDEqns fam_tc work_args work_item $
mkLocalFamEqFDs eqs_for_me fam_tc inj work_args work_rhs
- -- Now look at the top-level axioms; we effectively infer injectivity,
- -- so we don't need tyConInjectivtyInfo. This works fine for closed
- -- type families without injectivity info
- ; if null eqs_for_me
+ ; if all (isWanted . eqCtEvidence) eqs_for_me
then tryFDEqns fam_tc work_args work_item $
- mkTopClosedFamEqFDs ax work_args work_rhs
+ mkTopFamEqFDs fam_tc work_args work_rhs
else nopStage () }
- | otherwise -- Data families, abstract families
- = nopStage ()
+mkTopFamEqFDs :: TyCon -> [TcType] -> Xi -> TcS [FunDepEqns]
+mkTopFamEqFDs fam_tc work_args work_rhs
+ | isOpenTypeFamilyTyCon fam_tc
+ , Injective inj_flags <- tyConInjectivityInfo fam_tc
+ = -- Open, injective type families
+ mkTopOpenFamEqFDs fam_tc inj_flags work_args work_rhs
+
+ | Just ax <- isClosedFamilyTyCon_maybe fam_tc
+ = -- Closed type families
+ -- Look at the top-level axioms; we effectively infer injectivity,
+ -- so we don't need tyConInjectivtyInfo. This works fine for closed
+ -- type families without injectivity info
+ mkTopClosedFamEqFDs ax work_args work_rhs
+
+ | otherwise
+ = -- Data families, abstract families,
+ -- open families that are not injective,
+ -- closed type families with no equations (isClosedFamilyTyCon_maybe returns Nothing)
+ return []
tryFDEqns :: TyCon -> [TcType] -> EqCt -> TcS [FunDepEqns] -> SolverStage ()
tryFDEqns fam_tc work_args work_item@(EqCt { eq_ev = ev, eq_rhs= rhs }) mk_fd_eqns
@@ -542,6 +543,8 @@ tryFDEqns fam_tc work_args work_item@(EqCt { eq_ev = ev, eq_rhs= rhs }) mk_fd_eq
-----------------------------------------
mkTopClosedFamEqFDs :: CoAxiom Branched -> [TcType] -> Xi -> TcS [FunDepEqns]
mkTopClosedFamEqFDs ax work_args work_rhs
+ | Just tc <- tyConAppTyCon_maybe work_rhs -- Does RHS have anything useful to say?
+ , isGenerativeTyCon tc Nominal
= do { let branches = fromBranches (coAxiomBranches ax)
; traceTcS "mkTopClosed" (ppr branches $$ ppr work_args $$ ppr work_rhs)
; case getRelevantBranches ax work_args work_rhs of
@@ -549,6 +552,8 @@ mkTopClosedFamEqFDs ax work_args work_rhs
-> return [FDEqns { fd_qtvs = qtvs
, fd_eqs = zipWith Pair (rhs_ty:lhs_tys) (work_rhs:work_args) }]
_ -> return [] }
+ | otherwise
+ = return []
getRelevantBranches :: CoAxiom Branched -> [TcType] -> Xi -> [CoAxBranch]
@@ -727,12 +732,14 @@ mkInjectivityFDEqn inj_args qtvs lhs_args rhs_args
| (True, lhs_arg, rhs_arg) <- zip3 inj_args lhs_args rhs_args ]
getInertFamEqsFor :: TyCon -> [TcType] -> Xi -> TcS [EqCt]
--- Returns a mixture of Given and Wanted
-- Look in the InertSet, and return all inert equalities
-- F tys ~N# rhs
-- where F is the specified TyCon
--- But filter out ones that can't possibly help, is apart from the Wanted
--- Representational equalities don't interact with type family dependencies
+-- But filter out ones that can't possibly help;
+-- that is, ones that are "apart" from the Wanted
+-- Returns a mixture of Given and Wanted
+-- Nominal only, becaues Representational equalities don't interact
+-- with type family dependencies
getInertFamEqsFor fam_tc work_args work_rhs
= do { IC {inert_funeqs = funeqs } <- getInertCans
; return [ funeq_ct | equal_ct_list <- findFunEqsByTyCon funeqs fam_tc
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8821d43e28488206daff9db6fb13e1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8821d43e28488206daff9db6fb13e1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/io-manager-deadlock-detection] 25 commits: Make the IOManager API use CapIOManager rather than Capability
by Duncan Coutts (＠dcoutts) 15 Nov '25
by Duncan Coutts (＠dcoutts) 15 Nov '25
15 Nov '25
Duncan Coutts pushed to branch wip/io-manager-deadlock-detection at Glasgow Haskell Compiler / GHC
Commits:
6755737b by Duncan Coutts at 2025-11-15T21:18:33+00:00
Make the IOManager API use CapIOManager rather than Capability
This makes the API somewhat more self-contained and more consistent.
Now the IOManager API and each of the backends takes just the I/O
manager structure. Previously we had a bit of a mixture, depending on
whether the function needed access to the Capability or just the
CapIOManager.
We still need access to the cap, so we introduce a back reference to
reach the capability, via iomgr->cap.
Convert all uses in select and poll backends, but not win32 ones.
Convert callers in the scheduler and elsewhere.
Also convert the three CMM primops that call IOManager APIs. They just
need to use Capability_iomgr(MyCapability()).
- - - - -
c62f7d73 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Split posix/MIO.c out of posix/Signals.c
The MIO I/O manager was secretly living inside the Signals file.
Now it gets its own file, like any other self-respecting I/O manager.
- - - - -
6a7e3be8 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Rationalise some scheduler run queue utilities
Move them all to the same place in the file.
Make some static that were used only internally.
Also remove a redundant assignment after calling truncateRunQueue that
is already done within truncateRunQueue.
- - - - -
3bb8999e by Duncan Coutts at 2025-11-15T21:18:34+00:00
Rename initIOManager{AfterFork} to {re}startIOManager
These are more accurate names, since these actions happen after
initialisation and are really about starting (or restarting) background
threads.
- - - - -
64397059 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Add a TODO to the MIO I/O manager
The direction of travel is to make I/O managers per-capability and have
all their state live in the struct CapIOManager. The MIO I/O manager
however still has a number of global variables.
It's not obvious how handle these globals however.
- - - - -
bc8a0ddc by Duncan Coutts at 2025-11-15T21:18:34+00:00
Free per-cap I/O managers during shutdown and forkProcess
Historically this was not strictly necessary. The select and win32
legacy I/O managers did not maintain any dynamically allocated
resources. The new poll one does (an auxillary table), and so this
should be freed.
After forkProcess, all threads get deleted. This includes threads
waiting on I/O or timers. So as of this patch, resetting the I/O
manager is just about tidying things up. For example, for the poll
I/O manager this will reset the size of the AIOP table (which
otherwise grows but never shrinks).
In future however the re-initialising will become neeecessary for
functionality, since some I/O managers will need to re-initialise
wakeup fds that are set CLOEXEC.
- - - - -
f23f321f by Duncan Coutts at 2025-11-15T21:18:34+00:00
Add an FdWakup module for posix I/O managers
This will be used to implement wakeupIOManager for in-RTS I/O managers.
It provides a notification/wakeup mechanism using FDs, suitable for
situations when I/O managers are blocked on a set of fds anyway.
- - - - -
35a9653d by Duncan Coutts at 2025-11-15T21:18:34+00:00
Add wakeupIOManager support for select I/O manager
Uses the FdWakup mechanism.
- - - - -
adf29463 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Add wakeupIOManager support for poll I/O manager
Uses the FdWakup mechanism.
A quirk we have to cope with is that we now need to poll one more fd --
the wakeup_fd_r -- but this fd has no corresponding entry in the
aiop_table. This is awkward since we have set up our aiop_poll_table to
be an auxilliary table with matching indicies.
The solution this patch uses (and described in the comments) is to have
two tables: struct pollfd *aiop_poll_table, *full_poll_table;
and to have the aiop_poll_table alias the tail of the full_poll_table.
The head entry in the full_poll_table is the extra fd. So we poll the
full_poll_table, while the aiop_poll_table still has matching indicies
with the aiop_table.
Hurrah for C aliasing rules.
- - - - -
30b7fe6b by Duncan Coutts at 2025-11-15T21:18:34+00:00
Add wakeupIOManager support for win32 legacy I/O manager
- - - - -
14f56d0e by Duncan Coutts at 2025-11-15T21:18:34+00:00
wakeupIOManager is now required for all I/O managers
We are going to rely on it. Previously it could be a no-op. Update the
docs in the header file.
Also, temporarily disable awaitCompletedTimeoutsOrIO post-condition
assertion. It will become more complicated due to wakeupIOManager, and
it's not yet clear how to express it.
We will re-introduce a post condition after a few more changes.
- - - - -
2b8c1604 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Make signal handling be a respondibility of the I/O manager(s)
Previously it was scattered between I/O managers and the scheduler, and
especially the scheduler's deadlock detection.
Previously the scheduler would poll for pending signals each iteration
of the scheduler loop. The scheduler also had some hairy signal
functionality in the deadlock detection: in the non-threaded RTS (only)
if there were still no threads running after deadlock detection then it
would block waiting for signals.
But signals can and (in my opinion) should be thought of as just a funny
kind of I/O, and thus should be a responsibility of the I/O manager.
So now we have the I/O managers poll for signals when they are polling
for I/O completion (and removing the separate poll in the scheduler).
And when I/O managers block waiting for I/O then they now also start
signal handlers if they get interrupted by a signal. Crucially, if there
is no pending I/O or timers, the awaitCompletedTimeoutsOrIO will still
block waiting for signals.
This patch puts us into an intermediate state: it temporarily breaks
deadlock detection in the non-threaded RTS. The waiting on I/O currently
happens before deadlock detection. This means we'll now wait forever on
signals before doing deadlock detection. We need to move waiting after
deadlock detection. We'll do that in a later patch.
- - - - -
c8f52a52 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Clean up signal handling internal API
Now that the I/O manager is responsible for signals, we can simplify the
API we present for signal handling.
We now just need startPendingSignalHandlers, which is called from the
I/O managers. We can get rid of awaitUserSignals. We also don't need
RtsSignals.h to re-export the platform-specific posix/Signals.h or
win32/ConsoleHandler.h
We can also hide more of the implementation of signals. Less has to be
exposed in posix/Signals.h or win32/ConsoleHandler.h. Partly this is
because we don't need inline functions (or macros) in the interface.
Also remove signal_handlers from RTS ABI exported symbols list. It does
not appear to have any users in the core libs, and its really an
internal implementation detail. It should not be exposed unless its
really necessary.
- - - - -
626d112c by Duncan Coutts at 2025-11-15T21:18:34+00:00
In the scheduler, move I/O blocking after deadlock detection
To make deadlock detection effective in the non-threaded RTS when there
are deadlocked threads and other unrelated threads waiting on I/O, we
need to arrange to do deadlock detection before we block in scheduler
to wait on I/O.
The solution is to:
1. adjust scheduleFindWork, which runs before deadlock detection, to
only poll for I/O and not block; and
2. add a step after deadlock detection to wait on I/O if there are
still no threads to run (and there's any I/O or timeouts outstanding)
The scheduleCheckBlockedThreads is now so simple that it made more sense
to inline it into scheduleFindWork.
- - - - -
ea1b84b2 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Remove bogus anyPendingTimeoutsOrIO guard from scheduleDetectDeadlock
The deadlock detection was only invoked if both of these conditions
hold:
1. the run queue is empty
2. there is no pending I/O or timeouts
The second condition is unnecessary. The deadlock detection mechanism
can find deadlocks even if there are other threads waiting on I/O or
timers. Having this extra condition means that we fail to detect
blocked threads if there are any threads waiting on I/O or timers.
Part of fixing issue #26408
- - - - -
eefcdfea by Duncan Coutts at 2025-11-15T21:18:34+00:00
Don't consider pending I/O for early context switch optimisation
Context switches are normally initiated by the timer signal. If however
the user specifies "context switch as often as possible", with +RTS -C0
then the scheduler arranges for an early context switch (when it's just
about to run a Haskell thread).
Context switching very often is expensive, so as an optimisation there
cases where we do not arrange an early context switch:
1. if there's no other threads to run
2. if there is no pending I/O or timers
This patch eliminates case 2, leaving only case 1.
The rationale is as follows. The use of this was inconsistent across
platforms and threaded/non-threaded RTS ways. It only worked on the
non-threaded RTS and on Windows only worked for the win32-legacy I/O
manager. On all other combinations anyPendingTimeoutsOrIO would always
return false. The fact that nobody noticed and complained about this
inconsistency suggests that the feature is not relied upon.
If however it turns out that applications do rely on this, then the
proper thing to do is not to restore this check, but to add a new I/O
manager hint function that returns if there is any pending events that
are likely to happen *soon*: for example timeouts expiring within one
timeslice, or I/O waits on things likely to complete soon like disk I/O,
but not for example socket/pipe I/O.
The motivation to avoid this use of anyPendingTimeoutsOrIO is to
allow us to eliminate anyPendingTimeoutsOrIO entirely. All other uses
of this are just guards on {await,poll}CompletedTimeoutsOrIO and
the guards can safely be folded into those functions. This will better
cope with some I/O managers having no proper implementation of
anyPendingTimeoutsOrIO.
Ultimately this will let us simplify the scheduler which currently has
to have special #ifdef mingw32_HOST_OS cases to cope with the lack of a
working anyPendingTimeoutsOrIO for some Windows I/O managers
- - - - -
2fee1ad9 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Remove anyPendingTimeoutsOrIO guarding {poll,await}CompletedTimeoutsOrIO
Previously the API of the I/O manager used a two step process: check
anyPendingTimeoutsOrIO and then call {poll,await}CompletedTimeoutsOrIO.
This was primarily there as a performance thing, to cheaply check if we
need to do anything.
And then because anyPendingTimeoutsOrIO existed, it was used for other
things too. We have now eliminated the other uses, and are just left
with the performance pattern.
But this was problematic because not all I/O managers correctly
implement anyPendingTimeoutsOrIO (specifically the win32 ones), and now
that we also make I/O managers responsible for signals then we need to
poll/await even if there is no pending I/O or timeouts. If there is no
pending I/O or timeouts then poll/await needs to degenerate to just
waiting forever for any signals.
- - - - -
306c7616 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Remove anyPendingTimeoutsOrIO, it is no longer used
And this avoids the problems arising from the win32 I/O managers having
had a bogus implementation.
- - - - -
edd9dbf9 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Remove second scheduler call to awaitCompletedTimeoutsOrIO
Previously awaitCompletedTimeoutsOrIO was called both before and after
deadlock detection in the scheduler. The reason for that was that the
win32 I/O managers had a bogus implementation of anyPendingTimeoutsOrIO
and this was used to guard the call of awaitCompletedTimeoutsOrIO prior
to deadlock detection. This meant the first call site was never actually
called when using the win32 I/O managers. This was the reason for the
second call: the first one was never used. What a mess.
So now we have a simple design in the scheduler:
1. poll for completed I/O, timers or signals
2. if no runnable threads: do deadlock detection
3. if still no runnable threads: block waiting for I/O, timers or
signals.
- - - - -
27470f83 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Lift emptyRunQueue guard out of scheduleDetectDeadlock
this improved the clarity of the logic when reading the scheduler code.
- - - - -
b927bf9c by Duncan Coutts at 2025-11-15T21:18:34+00:00
Make non-threaded deadlock detection also rely on idle GC
Only do deadlock detection GC when idle GC kicks in. This also relies on
using wakeUpRts, so now do this unconditionally. Previously wakeUpRts
was for the threaded rts only.
- - - - -
6f9d9d20 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Enable idle GC by default on non-threaded RTS.
The behaviour is now uniform between threaded and non-threaded. The
deadlock detection now relies on idle GC for both threaded and
non-threaded ways. Previously deadlock detection did not rely on idle
GC for the non-threaded way.
- - - - -
3d4bc7d3 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Add a long Note [Deadlock detection]
It describes the historical and modern designs and their trade-offs.
The point is we've now unified the code for deadlock detection between
the threaded and non-threaded ways, by changing the non-threaded to
follow the same design as the threaded.
- - - - -
4bc527ef by Duncan Coutts at 2025-11-15T21:18:34+00:00
Add a test for deadlock detection, issue #26408
- - - - -
eb13b6d4 by Duncan Coutts at 2025-11-15T21:18:34+00:00
Update the user guide with the revised idle GC behaviour
i.e. it's now not just for the threaded RTS, but general.
Also document the fact that disabling idle GC also disables deadlock
detection.
- - - - -
33 changed files:
- docs/users_guide/runtime_control.rst
- rts/Capability.c
- rts/IOManager.c
- rts/IOManager.h
- rts/IOManagerInternals.h
- rts/PrimOps.cmm
- rts/RaiseAsync.c
- rts/RtsFlags.c
- rts/RtsSignals.h
- rts/RtsStartup.c
- rts/RtsSymbols.c
- rts/Schedule.c
- rts/Schedule.h
- rts/Timer.c
- + rts/posix/FdWakeup.c
- + rts/posix/FdWakeup.h
- + rts/posix/MIO.c
- + rts/posix/MIO.h
- rts/posix/Poll.c
- rts/posix/Poll.h
- rts/posix/Select.c
- rts/posix/Select.h
- rts/posix/Signals.c
- rts/posix/Signals.h
- rts/posix/Timeout.c
- rts/posix/Timeout.h
- rts/rts.cabal
- rts/win32/AwaitEvent.c
- rts/win32/ConsoleHandler.c
- rts/win32/ConsoleHandler.h
- + testsuite/tests/rts/T26408.hs
- + testsuite/tests/rts/T26408.stderr
- testsuite/tests/rts/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7d601300898f314a7b9fe7164872ce…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7d601300898f314a7b9fe7164872ce…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Report all missing modules with -M
by Marge Bot (＠marge-bot) 15 Nov '25
by Marge Bot (＠marge-bot) 15 Nov '25
15 Nov '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
c0a1e574 by Georgios Karachalias at 2025-11-15T05:14:31-05:00
Report all missing modules with -M
We now report all missing modules at once in GHC.Driver.Makefile.processDeps,
as opposed to only reporting a single missing module. Fixes #26551.
- - - - -
c9fa3449 by Sylvain Henry at 2025-11-15T05:15:26-05:00
JS: fix array index for registers
We used to store R32 in h$regs[-1]. While it's correct in JavaScript,
fix this to store R32 in h$regs[0] instead.
- - - - -
9e469909 by Sylvain Henry at 2025-11-15T05:15:26-05:00
JS: support more than 128 registers (#26558)
The JS backend only supported 128 registers (JS variables/array slots
used to pass function arguments). It failed in T26537 when 129
registers were required.
This commit adds support for more than 128 registers: it is now limited to
maxBound :: Int (compiler's Int). If we ever go above this threshold the
compiler now panics with a more descriptive message.
A few built-in JS functions were assuming 128 registers and have been
rewritten to use loops. Note that loops are only used for "high"
registers that are stored in an array: the 31 "low" registers are still
handled with JS global variables and with explicit switch-cases to
maintain good performance in the most common cases (i.e. few registers
used). Adjusting the number of low registers is now easy: just one
constant to adjust (GHC.StgToJS.Regs.lowRegsCount).
No new test added: T26537 is used as a regression test instead.
- - - - -
38d82f38 by Sven Tennie at 2025-11-15T14:00:36-05:00
AArch64: Simplify CmmAssign and CmmStore
The special handling for floats was fake: The general case is always
used. So, the additional code path isn't needed (and only adds
complexity for the reader.)
- - - - -
e77ca589 by sheaf at 2025-11-15T14:00:42-05:00
SimpleOpt: refactor & push coercions into lambdas
This commit improves the simple optimiser (in GHC.Core.SimpleOpt)
in a couple of ways:
- The logic to push coercion lambdas is shored up.
The function 'pushCoercionIntoLambda' used to be called in 'finish_app',
but this meant we could not continue to optimise the program after
performing this transformation.
Now, we call 'pushCoercionIntoLambda' as part of 'simple_app'.
Doing so can be important when dealing with unlifted newtypes,
as explained in Note [Desugaring unlifted newtypes].
- The code is re-structured to avoid duplication and out-of-sync
code paths.
Now, 'simple_opt_expr' defers to 'simple_app' for the 'App', 'Var',
'Cast' and 'Lam' cases. This means all the logic for those is
centralised in a single place (e.g. the 'go_lam' helper function).
To do this, the general structure is brought a bit closer to the
full-blown simplifier, with a notion of 'continuation'
(see 'SimpleContItem').
This commit also modifies GHC.Core.Opt.Arity.pushCoercionIntoLambda to
apply a substitution (a slight generalisation of its existing implementation).
- - - - -
3a455f28 by sheaf at 2025-11-15T14:00:42-05:00
Improve typechecking of data constructors
This commit changes the way in which we perform typecheck data
constructors, in particular how we make multiplicities line up.
Now, impedance matching occurs as part of the existing subsumption
machinery. See the revamped Note [Typechecking data constructors] in
GHC.Tc.Gen.App, as well as Note [Polymorphisation of linear fields]
in GHC.Core.Multiplicity.
This allows us to get rid of a fair amount of hacky code that was
added with the introduction of LinearTypes; in particular the logic of
GHC.Tc.Gen.Head.tcInferDataCon.
-------------------------
Metric Decrease:
T10421
T14766
T15164
T15703
T19695
T5642
T9630
WWRec
-------------------------
- - - - -
7a962679 by sheaf at 2025-11-15T14:00:42-05:00
Handle unsaturated rep-poly newtypes
This commit allows GHC to handle unsaturated occurrences of unlifted
newtype constructors. The plan is detailed in
Note [Eta-expanding rep-poly unlifted newtypes]
in GHC.Tc.Utils.Concrete: for unsaturated unlifted newtypes, we perform
the appropriate representation-polymorphism check in tcInstFun.
- - - - -
77 changed files:
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Multiplicity.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Utils.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/Expr.hs
- compiler/GHC/StgToJS/Regs.hs
- compiler/GHC/StgToJS/Rts/Rts.hs
- compiler/GHC/StgToJS/Rts/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs-boot
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Concrete.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Types/Id/Make.hs
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/diagnostic-codes/codes.stdout
- testsuite/tests/driver/Makefile
- + testsuite/tests/driver/T26551.hs
- + testsuite/tests/driver/T26551.stderr
- testsuite/tests/driver/all.T
- testsuite/tests/ghci/scripts/T8959b.stderr
- testsuite/tests/ghci/scripts/ghci051.stderr
- testsuite/tests/indexed-types/should_compile/T12538.stderr
- + testsuite/tests/linear/should_compile/LinearEtaExpansions.hs
- testsuite/tests/linear/should_compile/all.T
- testsuite/tests/linear/should_fail/TypeClass.hs
- testsuite/tests/linear/should_fail/TypeClass.stderr
- testsuite/tests/linear/should_run/LinearGhci.stdout
- testsuite/tests/numeric/should_compile/T16402.stderr-ws-64
- testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/rep-poly/RepPolyCase1.stderr
- − testsuite/tests/rep-poly/RepPolyCase2.stderr
- testsuite/tests/rep-poly/RepPolyRule3.stderr
- testsuite/tests/rep-poly/RepPolyTuple4.stderr
- testsuite/tests/rep-poly/T13233.stderr
- − testsuite/tests/rep-poly/T17021.stderr
- testsuite/tests/rep-poly/T20363b.stderr
- − testsuite/tests/rep-poly/T21650_a.stderr
- − testsuite/tests/rep-poly/T21650_b.stderr
- + testsuite/tests/rep-poly/T26072.hs
- testsuite/tests/rep-poly/UnliftedNewtypesLevityBinder.stderr
- testsuite/tests/rep-poly/all.T
- testsuite/tests/typecheck/should_fail/T15883e.stderr
- testsuite/tests/typecheck/should_fail/T2414.stderr
- testsuite/tests/typecheck/should_fail/T2534.stderr
- testsuite/tests/typecheck/should_fail/T7264.stderr
- utils/haddock/hypsrc-test/ref/src/Classes.html
- utils/haddock/hypsrc-test/ref/src/Quasiquoter.html
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d43cc50de15e4111caa68d4da72baa…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d43cc50de15e4111caa68d4da72baa…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/io-manager-deadlock-detection] 2 commits: FIXUP: Make the IOManager API use CapIOManager rather than Capability
by Duncan Coutts (＠dcoutts) 15 Nov '25
by Duncan Coutts (＠dcoutts) 15 Nov '25
15 Nov '25
Duncan Coutts pushed to branch wip/io-manager-deadlock-detection at Glasgow Haskell Compiler / GHC
Commits:
f9da9451 by Duncan Coutts at 2025-11-15T12:30:48+00:00
FIXUP: Make the IOManager API use CapIOManager rather than Capability
whitespace
- - - - -
7d601300 by Duncan Coutts at 2025-11-15T12:31:17+00:00
FIXUP: Add a long Note [Deadlock detection]
note definition syntax now needs a ~~~~ line
- - - - -
2 changed files:
- rts/IOManager.c
- rts/Schedule.c
Changes:
=====================================
rts/IOManager.c
=====================================
@@ -322,7 +322,7 @@ char * showIOManager(void)
CapIOManager *allocCapabilityIOManager(Capability *cap)
{
CapIOManager *iomgr = stgMallocBytes(sizeof(CapIOManager),
- "allocCapabilityIOManager");
+ "allocCapabilityIOManager");
iomgr->cap = cap; /* link back */
return iomgr;
}
=====================================
rts/Schedule.c
=====================================
@@ -851,6 +851,7 @@ schedulePushWork(Capability *cap USED_IF_THREADS,
* ------------------------------------------------------------------------- */
/* Note [Deadlock detection]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For the purpose of this explanation we define:
* a /partial deadlock/ to be a set of threads that are deadlocked; and
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a85a430addce3ad87a6d9906409a5e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a85a430addce3ad87a6d9906409a5e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] 2 commits: JS: fix array index for registers
by Marge Bot (＠marge-bot) 15 Nov '25
by Marge Bot (＠marge-bot) 15 Nov '25
15 Nov '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
c9fa3449 by Sylvain Henry at 2025-11-15T05:15:26-05:00
JS: fix array index for registers
We used to store R32 in h$regs[-1]. While it's correct in JavaScript,
fix this to store R32 in h$regs[0] instead.
- - - - -
9e469909 by Sylvain Henry at 2025-11-15T05:15:26-05:00
JS: support more than 128 registers (#26558)
The JS backend only supported 128 registers (JS variables/array slots
used to pass function arguments). It failed in T26537 when 129
registers were required.
This commit adds support for more than 128 registers: it is now limited to
maxBound :: Int (compiler's Int). If we ever go above this threshold the
compiler now panics with a more descriptive message.
A few built-in JS functions were assuming 128 registers and have been
rewritten to use loops. Note that loops are only used for "high"
registers that are stored in an array: the 31 "low" registers are still
handled with JS global variables and with explicit switch-cases to
maintain good performance in the most common cases (i.e. few registers
used). Adjusting the number of low registers is now easy: just one
constant to adjust (GHC.StgToJS.Regs.lowRegsCount).
No new test added: T26537 is used as a regression test instead.
- - - - -
6 changed files:
- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/Expr.hs
- compiler/GHC/StgToJS/Regs.hs
- compiler/GHC/StgToJS/Rts/Rts.hs
- compiler/GHC/StgToJS/Rts/Types.hs
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
compiler/GHC/StgToJS/Apply.hs
=====================================
@@ -185,7 +185,7 @@ genApp ctx i args
as' <- concatMapM genArg args
ei <- varForEntryId i
let ra = mconcat . reverse $
- zipWith (\r a -> toJExpr r |= a) [R1 ..] as'
+ zipWith (\r a -> toJExpr r |= a) regsFromR1 as'
p <- pushLneFrame n ctx
a <- adjSp 1 -- for the header (which will only be written when the thread is suspended)
return (ra <> p <> a <> returnS ei, ExprCont)
@@ -464,42 +464,31 @@ specTag spec = Bits.shiftL (specVars spec) 8 Bits..|. specArgs spec
specTagExpr :: ApplySpec -> JStgExpr
specTagExpr = toJExpr . specTag
--- | Build arrays to quickly lookup apply functions
+-- | Build functions to quickly lookup apply functions
--
--- h$apply[r << 8 | n] = function application for r regs, n args
--- h$paps[r] = partial application for r registers (number of args is in the object)
+-- h$apply(r << 8 | n) = function application for r regs, n args
+-- h$paps(r) = partial application for r registers (number of args is in the object)
mkApplyArr :: JSM JStgStat
mkApplyArr =
- do mk_ap_gens <- jFor (|= zero_) (.<. Int 65536) preIncrS
- \j -> hdApply .! j |= hdApGen
- mk_pap_gens <- jFor (|= zero_) (.<. Int 128) preIncrS
- \j -> hdPaps .! j |= hdPapGen
+ do paps_fun <- jFunction (name hdPapsStr) \(MkSolo i) -> pure $ SwitchStat i (map case_pap specPap) (returnS hdPapGen)
+ apply_fun <- jFunction (name hdApplyStr) \(MkSolo i) -> pure $ SwitchStat i (mapMaybe' case_apply applySpec) (returnS hdApGen)
return $ mconcat
- [ name hdApplyStr ||= toJExpr (JList [])
- , name hdPapsStr ||= toJExpr (JList [])
- , ApplStat (hdInitStatic .^ "push")
- [ jLam' $
- mconcat
- [ mk_ap_gens
- , mk_pap_gens
- , mconcat (map assignSpec applySpec)
- , mconcat (map assignPap specPap)
- ]
- ]
+ [ paps_fun
+ , apply_fun
]
where
- assignSpec :: ApplySpec -> JStgStat
- assignSpec spec = case specConv spec of
+ case_apply :: ApplySpec -> Maybe (JStgExpr,JStgStat)
+ case_apply spec = case specConv spec of
-- both fast/slow (regs/stack) specialized apply functions have the same
-- tags. We store the stack ones in the array because they are used as
-- continuation stack frames.
- StackConv -> hdApply .! specTagExpr spec |= specApplyExpr spec
- RegsConv -> mempty
+ StackConv -> Just (specTagExpr spec, returnS (specApplyExpr spec))
+ RegsConv -> Nothing
hdPap_ = unpackFS hdPapStr_
- assignPap :: Int -> JStgStat
- assignPap p = hdPaps .! toJExpr p |= global (mkFastString (hdPap_ ++ show p))
+ case_pap :: Int -> (JStgExpr, JStgStat)
+ case_pap p = (toJExpr p, returnS $ global (mkFastString (hdPap_ ++ show p)))
-- | Push a continuation on the stack
--
@@ -619,7 +608,7 @@ genericStackApply cfg = closure info body
-- compute new tag with consumed register values and args removed
, newTag |= ((given_regs-needed_regs).<<.8) .|. (given_args - needed_args)
-- find application function for the remaining regs/args
- , newAp |= hdApply .! newTag
+ , newAp |= ApplExpr hdApply [newTag]
, traceRts cfg (jString "h$ap_gen: next: " + (newAp .^ "n"))
-- Drop used registers from the stack.
@@ -643,7 +632,7 @@ genericStackApply cfg = closure info body
-----------------------------
[ traceRts cfg (jString "h$ap_gen: undersat")
-- find PAP entry function corresponding to given_regs count
- , p |= hdPaps .! given_regs
+ , p |= ApplExpr hdPaps [given_regs]
-- build PAP payload: R1 + tag + given register values
, newTag |= ((needed_regs-given_regs) .<<. 8) .|. (needed_args-given_args)
@@ -716,7 +705,7 @@ genericFastApply s =
do push_all_regs <- pushAllRegs tag
return $ mconcat $
[ push_all_regs
- , ap |= hdApply .! tag
+ , ap |= ApplExpr hdApply [tag]
, ifS (ap .===. hdApGen)
((sp |= sp + 2) <> (stack .! (sp-1) |= tag))
(sp |= sp + 1)
@@ -750,7 +739,7 @@ genericFastApply s =
, traceRts s (jString "h$ap_gen_fast: oversat " + sp)
, push_args
, newTag |= ((myRegs-( arity.>>.8)).<<.8).|.myAr-ar
- , newAp |= hdApply .! newTag
+ , newAp |= ApplExpr hdApply [newTag]
, ifS (newAp .===. hdApGen)
((sp |= sp + 2) <> (stack .! (sp - 1) |= newTag))
(sp |= sp + 1)
@@ -761,7 +750,7 @@ genericFastApply s =
-- else
[traceRts s (jString "h$ap_gen_fast: undersat: " + myRegs + jString " " + tag)
, jwhenS (tag .!=. 0) $ mconcat
- [ p |= hdPaps .! myRegs
+ [ p |= ApplExpr hdPaps [myRegs]
, dat |= toJExpr [r1, ((arity .>>. 8)-myRegs)*256+ar-myAr]
, get_regs
, r1 |= initClosure s p dat jCurrentCCS
@@ -773,14 +762,24 @@ genericFastApply s =
pushAllRegs :: JStgExpr -> JSM JStgStat
pushAllRegs tag =
jVar \regs ->
- return $ mconcat $
- [ regs |= tag .>>. 8
- , sp |= sp + regs
- , SwitchStat regs (map pushReg [65,64..2]) mempty
- ]
- where
- pushReg :: Int -> (JStgExpr, JStgStat)
- pushReg r = (toJExpr (r-1), stack .! (sp - toJExpr (r - 2)) |= jsReg r)
+ let max_low_reg = regNumber maxLowReg
+ low_regs = [max_low_reg, max_low_reg-1..2] -- R1 isn't used for arguments
+ pushReg :: Int -> (JStgExpr, JStgStat)
+ pushReg r = (toJExpr r, stack .! (sp - toJExpr (r - 2)) |= jsReg r)
+ in return $ mconcat $
+ [ regs |= tag .>>. 8
+ , sp |= sp + regs
+ -- increment the number of regs by 1, so that it matches register
+ -- numbers (R1 is not used for args)
+ , postIncrS regs
+ -- copy high registers with a loop
+ , WhileStat False (regs .>. toJExpr max_low_reg) $ mconcat
+ -- rN stored in stack[sp - N - 2] so that r2 is stored in stack[sp], etc.
+ [ stack .! (sp - regs - 2) |= highReg_expr regs
+ , postDecrS regs
+ ]
+ , SwitchStat regs (map pushReg low_regs) mempty
+ ]
pushArgs :: JStgExpr -> JStgExpr -> JSM JStgStat
pushArgs start end =
@@ -906,7 +905,7 @@ stackApply s fun_name nargs nvars =
[ rs |= (arity .>>. 8)
, loadRegs rs
, sp |= sp - rs
- , newAp |= (hdApply .! ((toJExpr nargs-arity0).|.((toJExpr nvars-rs).<<.8)))
+ , newAp |= ApplExpr hdApply [(toJExpr nargs-arity0).|.((toJExpr nvars-rs).<<.8)]
, stack .! sp |= newAp
, profStat s pushRestoreCCS
, traceRts s (toJExpr (fun_name <> ": new stack frame: ") + (newAp .^ "n"))
@@ -989,7 +988,7 @@ fastApply s fun_name nargs nvars = if nargs == 0 && nvars == 0
+ rsRemain)
, saveRegs rs
, sp |= sp + rsRemain + 1
- , stack .! sp |= hdApply .! ((rsRemain.<<.8).|. (toJExpr nargs - mask8 arity))
+ , stack .! sp |= ApplExpr hdApply [(rsRemain.<<.8).|. (toJExpr nargs - mask8 arity)]
, profStat s pushRestoreCCS
, returnS c
]
@@ -1238,14 +1237,30 @@ pap s r = closure (ClosureInfo
, profStat s (enterCostCentreFun currentCCS)
, extra |= (funOrPapArity c (Just f) .>>. 8) - toJExpr r
, traceRts s (toJExpr (funcName <> ": pap extra args moving: ") + extra)
- , moveBy extra
+ , case r of
+ 0 -> mempty -- in pap_0 we don't shift any register
+ _ -> moveBy extra
, loadOwnArgs d
, r1 |= c
, returnS f
]
- moveBy extra = SwitchStat extra
- (reverse $ map moveCase [1..maxReg-r-1]) mempty
- moveCase m = (toJExpr m, jsReg (m+r+1) |= jsReg (m+1))
+ moveBy extra =
+ let max_low_reg = regNumber maxLowReg
+ low_regs = [max_low_reg, max_low_reg-1..2] -- R1 isn't used for arguments
+ move_case m = (toJExpr m, jsReg (m+r) |= jsReg m)
+ in mconcat
+ [ -- increment the number of args by 1, so that it matches register
+ -- numbers (R1 is not used for args)
+ postIncrS extra
+ -- copy high registers with a loop
+ , WhileStat False (extra .>. toJExpr max_low_reg) $ mconcat
+ [ highReg_expr (extra + toJExpr r) |= highReg_expr extra
+ , postDecrS extra
+ ]
+ -- then copy low registers with a case
+ , SwitchStat extra (map move_case low_regs) mempty
+ ]
+
loadOwnArgs d = mconcat $ map (\r ->
jsReg (r+1) |= dField d (r+2)) [1..r]
dField d n = SelExpr d (name . mkFastString $ ('d':show (n-1)))
@@ -1274,7 +1289,9 @@ papGen cfg =
(jString "h$pap_gen: expected function or pap")
, profStat cfg (enterCostCentreFun currentCCS)
, traceRts cfg (jString "h$pap_gen: generic pap extra args moving: " + or)
+ -- shift newly applied arguments into appropriate registers
, appS hdMoveRegs2 [or, r]
+ -- load stored arguments into lowest argument registers (i.e. starting from R2)
, loadOwnArgs d r
, r1 |= c
, returnS f
@@ -1285,9 +1302,22 @@ papGen cfg =
funcIdent = name funcName
funcName = hdPapGenStr
loadOwnArgs d r =
- let prop n = d .^ ("d" <> mkFastString (show $ n+1))
- loadOwnArg n = (toJExpr n, jsReg (n+1) |= prop n)
- in SwitchStat r (map loadOwnArg [127,126..1]) mempty
+ let prop n = d .^ (mkFastString ("d" ++ show n))
+ loadOwnArg n = (toJExpr n, jsReg n |= prop n)
+ max_low_reg = regNumber maxLowReg
+ low_regs = [max_low_reg, max_low_reg-1..2] -- R1 isn't used for arguments
+ in mconcat
+ [ -- increment the number of args by 1, so that it matches register
+ -- numbers (R1 is not used for args) and PAP fields (starting from d2)
+ postIncrS r
+ -- copy high registers with a loop
+ , WhileStat False (r .>. toJExpr max_low_reg) $ mconcat
+ [ highReg_expr r |= (d .! (jString (fsLit "d") + r))
+ , postDecrS r
+ ]
+ -- then copy low registers with a case.
+ , SwitchStat r (map loadOwnArg low_regs) mempty
+ ]
-- general utilities
-- move the first n registers, starting at R2, m places up (do not use with negative m)
@@ -1301,7 +1331,7 @@ moveRegs2 = jFunction (name hdMoveRegs2) moveSwitch
switchCase n m = (toJExpr $
(n `Bits.shiftL` 8) Bits..|. m
, mconcat (map (`moveRegFast` m) [n+1,n..2])
- <> BreakStat Nothing {-[j| break; |]-})
+ <> BreakStat Nothing)
moveRegFast n m = jsReg (n+m) |= jsReg n
-- fallback
defaultCase n m =
=====================================
compiler/GHC/StgToJS/Expr.hs
=====================================
@@ -312,7 +312,7 @@ genBody ctx startReg args e typ = do
-- load arguments into local variables
la <- do
args' <- concatMapM genIdArgI args
- return (declAssignAll args' (fmap toJExpr [startReg..]))
+ return (declAssignAll args' (jsRegsFrom startReg))
-- assert that arguments have valid runtime reps
lav <- verifyRuntimeReps args
@@ -665,7 +665,7 @@ genCase ctx bnd e at alts l
| otherwise = do
rj <- genRet ctx bnd at alts l
let ctx' = ctxSetTop bnd
- $ ctxSetTarget (assocIdExprs bnd (map toJExpr [R1 ..]))
+ $ ctxSetTarget (assocIdExprs bnd jsRegsFromR1)
$ ctx
(ej, _r) <- genExpr ctx' e
return (rj <> ej, ExprCont)
@@ -730,7 +730,7 @@ genRet ctx e at as l = freshIdent >>= f
fun free = resetSlots $ do
decs <- declVarsForId e
- load <- flip assignAll (map toJExpr [R1 ..]) . map toJExpr <$> identsForId e
+ load <- flip assignAll jsRegsFromR1 . map toJExpr <$> identsForId e
loadv <- verifyRuntimeReps [e]
ras <- loadRetArgs free
rasv <- verifyRuntimeReps (map (\(x,_,_)->x) free)
=====================================
compiler/GHC/StgToJS/Regs.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
module GHC.StgToJS.Regs
( StgReg (..)
@@ -6,17 +7,25 @@ module GHC.StgToJS.Regs
, sp
, stack
, r1, r2, r3, r4
+ , pattern R1, pattern R2, pattern R3, pattern R4
, regsFromR1
, regsFromR2
+ , regsFromTo
+ , jsRegsFrom
, jsRegsFromR1
, jsRegsFromR2
, StgRet (..)
- , jsRegToInt
- , intToJSReg
+ , regNumber
, jsReg
+ , highReg
+ , highReg_expr
, maxReg
+ , maxLowReg
, minReg
+ , minHighReg
, lowRegs
+ , lowRegsCount
+ , lowRegsIdents
, retRegs
, register
, foreignRegister
@@ -32,6 +41,7 @@ import GHC.JS.Make
import GHC.StgToJS.Symbols
import GHC.Data.FastString
+import GHC.Utils.Panic.Plain
import Data.Array
import qualified Data.ByteString.Char8 as BSC
@@ -39,26 +49,15 @@ import Data.Char
import Data.Semigroup ((<>))
-- | General purpose "registers"
---
--- The JS backend arbitrarily supports 128 registers
-data StgReg
- = R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8
- | R9 | R10 | R11 | R12 | R13 | R14 | R15 | R16
- | R17 | R18 | R19 | R20 | R21 | R22 | R23 | R24
- | R25 | R26 | R27 | R28 | R29 | R30 | R31 | R32
- | R33 | R34 | R35 | R36 | R37 | R38 | R39 | R40
- | R41 | R42 | R43 | R44 | R45 | R46 | R47 | R48
- | R49 | R50 | R51 | R52 | R53 | R54 | R55 | R56
- | R57 | R58 | R59 | R60 | R61 | R62 | R63 | R64
- | R65 | R66 | R67 | R68 | R69 | R70 | R71 | R72
- | R73 | R74 | R75 | R76 | R77 | R78 | R79 | R80
- | R81 | R82 | R83 | R84 | R85 | R86 | R87 | R88
- | R89 | R90 | R91 | R92 | R93 | R94 | R95 | R96
- | R97 | R98 | R99 | R100 | R101 | R102 | R103 | R104
- | R105 | R106 | R107 | R108 | R109 | R110 | R111 | R112
- | R113 | R114 | R115 | R116 | R117 | R118 | R119 | R120
- | R121 | R122 | R123 | R124 | R125 | R126 | R127 | R128
- deriving (Eq, Ord, Show, Enum, Bounded, Ix)
+newtype StgReg
+ = StgReg Int
+ deriving (Eq,Ord,Ix)
+
+pattern R1, R2, R3, R4 :: StgReg
+pattern R1 = StgReg 0
+pattern R2 = StgReg 1
+pattern R3 = StgReg 2
+pattern R4 = StgReg 3
-- | Stack registers
data Special
@@ -78,7 +77,7 @@ instance ToJExpr Special where
toJExpr Sp = hdStackPtr
instance ToJExpr StgReg where
- toJExpr r = registers ! r
+ toJExpr r = register r
instance ToJExpr StgRet where
toJExpr r = rets ! r
@@ -99,25 +98,42 @@ r2 = toJExpr R2
r3 = toJExpr R3
r4 = toJExpr R4
+-- | 1-indexed register number (R1 has index 1)
+regNumber :: StgReg -> Int
+regNumber (StgReg r) = r+1
-jsRegToInt :: StgReg -> Int
-jsRegToInt = (+1) . fromEnum
+-- | StgReg from 1-indexed number
+regFromNumber :: Int -> StgReg
+regFromNumber r = assert (r >= 1) $ StgReg (r-1)
-intToJSReg :: Int -> StgReg
-intToJSReg r = toEnum (r - 1)
+regsFromTo :: StgReg -> StgReg -> [StgReg]
+regsFromTo (StgReg x) (StgReg y) = map StgReg [x .. y]
+-- | Register expression from its 1-indexed index
jsReg :: Int -> JStgExpr
-jsReg r = toJExpr (intToJSReg r)
+jsReg r = toJExpr (regFromNumber r)
+
+minReg :: StgReg
+minReg = R1
-maxReg :: Int
-maxReg = jsRegToInt maxBound
+maxReg :: StgReg
+maxReg = regFromNumber maxBound
-minReg :: Int
-minReg = jsRegToInt minBound
+lowRegsCount :: Int
+lowRegsCount = 31
+
+maxLowReg :: StgReg
+maxLowReg = regFromNumber lowRegsCount
+
+-- | First register stored in h$regs array instead of having its own top-level
+-- variable
+minHighReg :: StgReg
+minHighReg = case maxLowReg of
+ StgReg r -> StgReg (r+1)
-- | List of registers, starting from R1
regsFromR1 :: [StgReg]
-regsFromR1 = enumFrom R1
+regsFromR1 = regsFromTo R1 maxReg ++ repeat (panic "StgToJS: code requires too many registers")
-- | List of registers, starting from R2
regsFromR2 :: [StgReg]
@@ -131,35 +147,59 @@ jsRegsFromR1 = fmap toJExpr regsFromR1
jsRegsFromR2 :: [JStgExpr]
jsRegsFromR2 = tail jsRegsFromR1
+-- | List of registers, starting from given reg as JExpr
+jsRegsFrom :: StgReg -> [JStgExpr]
+jsRegsFrom (StgReg n) = drop n jsRegsFromR1
+
+-- | High register
+highReg :: Int -> JStgExpr
+highReg r = assert (r >= regNumber minHighReg) $ IdxExpr hdRegs (toJExpr (r - regNumber minHighReg))
+
+-- | High register indexing with a JS expression
+highReg_expr :: JStgExpr -> JStgExpr
+highReg_expr r = IdxExpr hdRegs (r - toJExpr (regNumber minHighReg))
+
+
---------------------------------------------------
-- caches
---------------------------------------------------
-lowRegs :: [Ident]
-lowRegs = map reg_to_ident [R1 .. R31]
- where reg_to_ident = name . mkFastString . (unpackFS hdStr ++) . map toLower . show
+lowRegs :: [StgReg]
+lowRegs = regsFromTo minReg maxLowReg
+
+lowRegsIdents :: [Ident]
+lowRegsIdents = map reg_to_ident lowRegs
+ where
+ -- low regs are named h$r1, h$r2, etc.
+ reg_to_ident r = name (mkFastString (unpackFS hdStr ++ "r" ++ show (regNumber r)))
retRegs :: [Ident]
retRegs = [name . mkFastStringByteString
$ hdB <> BSC.pack (map toLower $ show n) | n <- enumFrom Ret1]
--- cache JExpr representing StgReg
-registers :: Array StgReg JStgExpr
-registers = listArray (minBound, maxBound) (map (global . identFS) lowRegs ++ map regN [R32 .. R128])
- where
- regN :: StgReg -> JStgExpr
- regN r = IdxExpr hdRegs (toJExpr (fromEnum r - 32))
-
-- cache JExpr representing StgRet
rets :: Array StgRet JStgExpr
rets = listArray (minBound, maxBound) (map retN (enumFrom Ret1))
where
retN = global . mkFastString . (unpackFS hdStr ++) . map toLower . show
--- | Given a register, return the JS syntax object representing that register
-register :: StgReg -> JStgExpr
-register i = registers ! i
-
-- | Given a register, return the JS syntax object representing that register
foreignRegister :: StgRet -> JStgExpr
foreignRegister i = rets ! i
+
+-- | Given a register, return the JS syntax object representing that register
+register :: StgReg -> JStgExpr
+register i
+ | i <= maxCachedReg = register_cache ! i -- Expressions of common registers are cached.
+ | otherwise = make_high_reg i -- Expression of higher registers are made on the fly
+
+maxCachedReg :: StgReg
+maxCachedReg = regFromNumber 128
+
+-- cache JExpr representing StgReg
+register_cache :: Array StgReg JStgExpr
+register_cache = listArray (minReg, maxCachedReg) (map (global . identFS) lowRegsIdents ++ map make_high_reg (regsFromTo minHighReg maxCachedReg))
+
+-- | Make h$regs[XXX] expression for the register
+make_high_reg :: StgReg -> JStgExpr
+make_high_reg r = highReg (regNumber r)
=====================================
compiler/GHC/StgToJS/Rts/Rts.hs
=====================================
@@ -54,7 +54,12 @@ import qualified Data.Bits as Bits
-- | The garbageCollector resets registers and result variables.
garbageCollector :: JSM JStgStat
garbageCollector = jBlock
- [ jFunction' hdResetRegisters (return $ mconcat $ map resetRegister [minBound..maxBound])
+ [ jFunction' hdResetRegisters $ return $ mconcat
+ [ -- reset low registers explicitly
+ mconcat (map resetRegister lowRegs)
+ -- reset the whole h$regs array with h$regs.fill(null)
+ , toStat $ ApplExpr (hdRegs .^ "fill") [null_]
+ ]
, jFunction' hdResetResultVars (return $ mconcat $ map resetResultVar [minBound..maxBound])
]
@@ -249,7 +254,7 @@ declRegs = do
loaders <- loadRegs
return $
mconcat [ hdRegsStr ||= toJExpr (JList [])
- , mconcat (map declReg lowRegs)
+ , mconcat (map declReg lowRegsIdents)
, getters_setters
, loaders
]
@@ -259,15 +264,15 @@ declRegs = do
-- | JS payload to define getters and setters on the registers.
regGettersSetters :: JSM JStgStat
regGettersSetters =
- do setters <- jFunction (name hdGetRegStr) (\(MkSolo n) -> return $ SwitchStat n getRegCases mempty)
- getters <- jFunction (name hdSetRegStr) (\(n,v) -> return $ SwitchStat n (setRegCases v) mempty)
+ do getters <- jFunction (name hdGetRegStr) (\(MkSolo n) -> return $ SwitchStat n getRegCases (defaultGetRegCase n))
+ setters <- jFunction (name hdSetRegStr) (\(n,v) -> return $ SwitchStat n (setRegCases v) (defaultSetRegCase n v))
return $ setters <> getters
where
- getRegCases =
- map (\r -> (toJExpr (jsRegToInt r) , returnS (toJExpr r))) regsFromR1
- setRegCases :: JStgExpr -> [(JStgExpr,JStgStat)]
- setRegCases v =
- map (\r -> (toJExpr (jsRegToInt r), (toJExpr r |= toJExpr v) <> returnS undefined_)) regsFromR1
+ getRegCases = map (\r -> (toJExpr (regNumber r) , returnS (toJExpr r))) lowRegs
+ defaultGetRegCase n = returnS (highReg_expr n)
+
+ setRegCases v = map (\r -> (toJExpr (regNumber r), (toJExpr r |= v) <> BreakStat Nothing)) lowRegs
+ defaultSetRegCase n v = highReg_expr n |= v
-- | JS payload that defines the functions to load each register
loadRegs :: JSM JStgStat
=====================================
compiler/GHC/StgToJS/Rts/Types.hs
=====================================
@@ -69,12 +69,3 @@ stackFrameSize tgt f =
(tgt |= mask8 tag + 1) -- else set to mask'd tag + 1
]
))
-
- --------------------------------------------------------------------------------
--- Register utilities
---------------------------------------------------------------------------------
-
--- | Perform the computation 'f', on the range of registers bounded by 'start'
--- and 'end'.
-withRegs :: StgReg -> StgReg -> (StgReg -> JStgStat) -> JStgStat
-withRegs start end f = mconcat $ fmap f [start..end]
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -256,4 +256,4 @@ test('T24893', normal, compile_and_run, ['-O'])
test('CCallConv', [req_c], compile_and_run, ['CCallConv_c.c'])
test('T25364', normal, compile_and_run, [''])
test('T26061', normal, compile_and_run, [''])
-test('T26537', js_broken(26558), compile_and_run, ['-O2 -fregs-graph'])
+test('T26537', normal, compile_and_run, ['-O2 -fregs-graph'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0a1e5748d90c1cbd2e6a90ccbe7d9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0a1e5748d90c1cbd2e6a90ccbe7d9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
15 Nov '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
c0a1e574 by Georgios Karachalias at 2025-11-15T05:14:31-05:00
Report all missing modules with -M
We now report all missing modules at once in GHC.Driver.Makefile.processDeps,
as opposed to only reporting a single missing module. Fixes #26551.
- - - - -
5 changed files:
- compiler/GHC/Driver/MakeFile.hs
- testsuite/tests/driver/Makefile
- + testsuite/tests/driver/T26551.hs
- + testsuite/tests/driver/T26551.stderr
- testsuite/tests/driver/all.T
Changes:
=====================================
compiler/GHC/Driver/MakeFile.hs
=====================================
@@ -55,6 +55,7 @@ import Data.IORef
import qualified Data.Set as Set
import GHC.Iface.Errors.Types
import Data.Either
+import GHC.Data.Bag (listToBag)
-----------------------------------------------------------------
--
@@ -237,19 +238,6 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ (ModuleN
obj_file = msObjFilePath node
obj_files = insertSuffixes obj_file extra_suffixes
- do_imp loc is_boot pkg_qual imp_mod
- = do { mb_hi <- findDependency hsc_env loc pkg_qual imp_mod
- is_boot include_pkg_deps
- ; case mb_hi of {
- Nothing -> return () ;
- Just hi_file -> do
- { let hi_files = insertSuffixes hi_file extra_suffixes
- write_dep (obj,hi) = writeDependency root hdl [obj] hi
-
- -- Add one dependency for each suffix;
- -- e.g. A.o : B.hi
- -- A.x_o : B.x_hi
- ; mapM_ write_dep (obj_files `zip` hi_files) }}}
-- Emit std dependency of the object(s) on the source file
@@ -280,15 +268,33 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ (ModuleN
-- Emit a dependency for each import
- ; let do_imps is_boot idecls = sequence_
- [ do_imp loc is_boot mb_pkg mod
+ ; let find_dep loc is_boot pkg_qual imp_mod = findDependency hsc_env loc pkg_qual imp_mod is_boot include_pkg_deps
+
+ find_deps is_boot idecls = sequence
+ [ find_dep loc is_boot mb_pkg mod
| (_lvl, mb_pkg, L loc mod) <- idecls,
mod `notElem` excl_mods ]
- ; do_imps IsBoot (map ((,,) NormalLevel NoPkgQual) (ms_srcimps node))
- ; do_imps NotBoot (ms_imps node)
- }
+ do_imp hi_file = do
+ let hi_files = insertSuffixes hi_file extra_suffixes
+ write_dep (obj,hi) = writeDependency root hdl [obj] hi
+
+ -- Add one dependency for each suffix;
+ -- e.g. A.o : B.hi
+ -- A.x_o : B.x_hi
+ mapM_ write_dep (obj_files `zip` hi_files)
+ ; (missing_boot_dep_errs, boot_deps) <- partitionEithers <$> find_deps IsBoot (map ((,,) NormalLevel NoPkgQual) (ms_srcimps node))
+ ; (missing_not_boot_dep_errs, not_boot_deps) <- partitionEithers <$> find_deps NotBoot (ms_imps node)
+
+ ; let all_missing_errors = missing_boot_dep_errs ++ missing_not_boot_dep_errs
+
+ ; if null all_missing_errors
+ then mapM_ (mapM_ do_imp) (boot_deps ++ not_boot_deps)
+ else do
+ let sec = initSourceErrorContext (hsc_dflags hsc_env)
+ throwErrors sec (mkMessages (listToBag all_missing_errors))
+ }
findDependency :: HscEnv
-> SrcSpan
@@ -296,7 +302,7 @@ findDependency :: HscEnv
-> ModuleName -- Imported module
-> IsBootInterface -- Source import
-> Bool -- Record dependency on package modules
- -> IO (Maybe FilePath) -- Interface file
+ -> IO (Either (MsgEnvelope GhcMessage) (Maybe FilePath)) -- Interface file
findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
-- Find the module; this will be fast because
-- we've done it once during downsweep
@@ -305,16 +311,15 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
Found loc _
-- Home package: just depend on the .hi or hi-boot file
| isJust (ml_hs_file loc) || include_pkg_deps
- -> return (Just (ml_hi_file loc))
+ -> return (Right (Just (ml_hi_file loc)))
-- Not in this package: we don't need a dependency
| otherwise
- -> return Nothing
+ -> return (Right Nothing)
fail ->
- let sec = initSourceErrorContext (hsc_dflags hsc_env)
- in
- throwOneError sec $
+ return $
+ Left $
mkPlainErrorMsgEnvelope srcloc $
GhcDriverMessage $ DriverInterfaceError $
(Can'tFindInterface (cannotFindModule hsc_env imp fail) (LookingForModule imp is_boot))
=====================================
testsuite/tests/driver/Makefile
=====================================
@@ -415,6 +415,10 @@ test200:
"$(TEST_HC)" $(TEST_HC_OPTS) -M -dep-suffix "" -dep-makefile $(DEPFILE200) D200.hs B200/C.hs A200.hs
test -f $(DEPFILE200)
+# Test that we produce "could not find module" errors for _all_ missing imports.
+T26551:
+ "$(TEST_HC)" $(TEST_HC_OPTS) -M T26551.hs || true
+
# -----------------------------------------------------------------------------
T2566::
=====================================
testsuite/tests/driver/T26551.hs
=====================================
@@ -0,0 +1,5 @@
+module Main where
+
+import Foo
+import Bar
+import Baz
=====================================
testsuite/tests/driver/T26551.stderr
=====================================
@@ -0,0 +1,11 @@
+T26551.hs:3:8: [GHC-87110]
+ Could not find module ‘Foo’.
+ Use -v to see a list of the files searched for.
+
+T26551.hs:4:8: [GHC-87110]
+ Could not find module ‘Bar’.
+ Use -v to see a list of the files searched for.
+
+T26551.hs:5:8: [GHC-87110]
+ Could not find module ‘Baz’.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -332,3 +332,4 @@ test('t25150', [extra_files(["t25150"])], multimod_compile, ['Main.hs', '-v0 -wo
test('T25382', normal, makefile_test, [])
test('T26018', req_c, makefile_test, [])
test('T24120', normal, compile, ['-Wunused-packages -hide-all-packages -package base -package system-cxx-std-lib'])
+test('T26551', [extra_files(['T26551.hs'])], makefile_test, [])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0a1e5748d90c1cbd2e6a90ccbe7d96…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0a1e5748d90c1cbd2e6a90ccbe7d96…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
15 Nov '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
a00840ea by Simon Peyton Jones at 2025-11-14T15:23:56+00:00
Make TYPE and CONSTRAINT apart again
This patch finally fixes #24279.
* The story started with #11715
* Then #21623 articulated a plan, which made Type and Constraint
not-apart; a horrible hack but it worked. The main patch was
commit 778c6adca2c995cd8a1b84394d4d5ca26b915dac
Author: Simon Peyton Jones <simonpj(a)microsoft.com>
Date: Wed Nov 9 10:33:22 2022 +0000
Type vs Constraint: finally nailed
* #24279 reported a bug in the above big commit; this small patch fixes it
commit af6932d6c068361c6ae300d52e72fbe13f8e1f18
Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com>
Date: Mon Jan 8 10:49:49 2024 +0000
Make TYPE and CONSTRAINT not-apart
Issue #24279 showed up a bug in the logic in GHC.Core.Unify.unify_ty
which is supposed to make TYPE and CONSTRAINT be not-apart.
* Then !10479 implemented "unary classes".
* That change in turn allows us to make Type and Constraint apart again,
cleaning up the compiler and allowing a little bit more expressiveness.
It fixes the original hope in #24279, namely that `Type` and `Constraint`
should be distinct throughout.
- - - - -
14 changed files:
- compiler/GHC/Builtin/Types/Prim.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/RoughMap.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Tc/Instance/Class.hs
- docs/users_guide/9.16.1-notes.rst
- testsuite/tests/indexed-types/should_fail/T21092.hs
- − testsuite/tests/indexed-types/should_fail/T21092.stderr
- testsuite/tests/indexed-types/should_fail/all.T
- testsuite/tests/typecheck/should_fail/T24279.hs
- − testsuite/tests/typecheck/should_fail/T24279.stderr
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
compiler/GHC/Builtin/Types/Prim.hs
=====================================
@@ -752,8 +752,9 @@ Specifically (a ~# b) :: CONSTRAINT (TupleRep [])
Wrinkles
-(W1) Type and Constraint are considered distinct throughout GHC. But they
- are not /apart/: see Note [Type and Constraint are not apart]
+(W1) Type and Constraint are considered distinct throughout GHC.
+ That wasn't always the case:
+ see Historical Note [Type and Constraint are not apart]
(W2) We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and
aBSENT_CONSTRAINT_ERROR_ID for types of kind Constraint.
@@ -768,8 +769,24 @@ Wrinkles
of type TYPE rr. See (CPR2) in Note [Which types are unboxed?] in
GHC.Core.Opt.WorkWrap.Utils.
-Note [Type and Constraint are not apart]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-------------------------------------------------------------
+Historical Note [Type and Constraint are not apart]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Nov 2025:
+ In the past, Type and Constraint were carefully coonsiderd to be
+ not /apart/. But the necessity for that vanished with unary classes
+ (see Note [Unary class magic]), done in
+
+ commit 9bd7fcc518111a1549c98720c222cdbabd32ed46
+ Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com>
+ Date: Tue Apr 15 17:43:46 2025 +0100
+ Implement unary classes
+
+ So now Type and Constraint are simply distinct type constructors, just as
+ much as Int and Bool.
+
+ The rest of this Note is preserved for historical interest.
+
Type and Constraint are not equal (eqType) but they are not /apart/
either. Reason (c.f. #7451):
@@ -841,6 +858,9 @@ Wrinkles
So in GHC.Tc.Instance.Class.matchTypeable, Type and Constraint are
treated as separate TyCons; i.e. given no special treatment.
+End of Historical Note
+-------------------------------------------------------------
+
Note [RuntimeRep polymorphism]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Generally speaking, you can't be polymorphic in `RuntimeRep`. E.g
=====================================
compiler/GHC/Core/Coercion.hs
=====================================
@@ -641,11 +641,6 @@ eqTyConRole tc
-- | Given a coercion `co :: (t1 :: TYPE r1) ~ (t2 :: TYPE r2)`
-- produce a coercion `rep_co :: r1 ~ r2`
--- But actually it is possible that
--- co :: (t1 :: CONSTRAINT r1) ~ (t2 :: CONSTRAINT r2)
--- or co :: (t1 :: TYPE r1) ~ (t2 :: CONSTRAINT r2)
--- or co :: (t1 :: CONSTRAINT r1) ~ (t2 :: TYPE r2)
--- See Note [mkRuntimeRepCo]
mkRuntimeRepCo :: HasDebugCallStack => Coercion -> Coercion
mkRuntimeRepCo co
= assert (isTYPEorCONSTRAINT k1 && isTYPEorCONSTRAINT k2) $
@@ -654,26 +649,6 @@ mkRuntimeRepCo co
kind_co = mkKindCo co -- kind_co :: TYPE r1 ~ TYPE r2
Pair k1 k2 = coercionKind kind_co
-{- Note [mkRuntimeRepCo]
-~~~~~~~~~~~~~~~~~~~~~~~~
-Given
- class C a where { op :: Maybe a }
-we will get an axiom
- axC a :: (C a :: CONSTRAINT r1) ~ (Maybe a :: TYPE r2)
-(See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim.)
-
-Then we may call mkRuntimeRepCo on (axC ty), and that will return
- mkSelCo (SelTyCon 0 Nominal) (Kind (axC ty)) :: r1 ~ r2
-
-So mkSelCo needs to be happy with decomposing a coercion of kind
- CONSTRAINT r1 ~ TYPE r2
-
-Hence the use of `tyConIsTYPEorCONSTRAINT` in the assertion `good_call`
-in `mkSelCo`. See #23018 for a concrete example. (In this context it's
-important that TYPE and CONSTRAINT have the same arity and kind, not
-merely that they are not-apart; otherwise SelCo would not make sense.)
--}
-
isReflCoVar_maybe :: Var -> Maybe Coercion
-- If cv :: t~t then isReflCoVar_maybe cv = Just (Refl t)
-- Works on all kinds of Vars, not just CoVars
@@ -1305,8 +1280,7 @@ mkSelCo_maybe cs co
, Just (tc2, tys2) <- splitTyConApp_maybe ty2
, let { len1 = length tys1
; len2 = length tys2 }
- = (tc1 == tc2 || (tyConIsTYPEorCONSTRAINT tc1 && tyConIsTYPEorCONSTRAINT tc2))
- -- tyConIsTYPEorCONSTRAINT: see Note [mkRuntimeRepCo]
+ = tc1 == tc2
&& len1 == len2
&& n < len1
&& r == tyConRole (coercionRole co) tc1 n
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -2891,13 +2891,9 @@ lint_branch ax_tc (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs
hang (text "Inhomogeneous axiom")
2 (text "lhs:" <+> ppr lhs <+> dcolon <+> ppr lhs_kind $$
text "rhs:" <+> ppr rhs <+> dcolon <+> ppr rhs_kind) }
- -- Type and Constraint are not Apart, so this test allows
- -- the newtype axiom for a single-method class. Indeed the
- -- whole reason Type and Constraint are not Apart is to allow
- -- such axioms!
--- these checks do not apply to newtype axioms
lint_family_branch :: TyCon -> CoAxBranch -> LintM ()
+-- These checks do not apply to newtype axioms
lint_family_branch fam_tc br@(CoAxBranch { cab_tvs = tvs
, cab_eta_tvs = eta_tvs
, cab_cvs = cvs
=====================================
compiler/GHC/Core/RoughMap.hs
=====================================
@@ -36,7 +36,6 @@ import GHC.Core.Type
import GHC.Utils.Outputable
import GHC.Types.Name
import GHC.Types.Name.Env
-import GHC.Builtin.Types.Prim( cONSTRAINTTyConName, tYPETyConName )
import Control.Monad (join)
import Data.Data (Data)
@@ -347,16 +346,7 @@ typeToRoughMatchTc ty
roughMatchTyConName :: TyCon -> Name
roughMatchTyConName tc
- | tc_name == cONSTRAINTTyConName
- = tYPETyConName -- TYPE and CONSTRAINT are not apart, so they must use
- -- the same rough-map key. We arbitrarily use TYPE.
- -- See Note [Type and Constraint are not apart]
- -- wrinkle (W1) in GHC.Builtin.Types.Prim
- | otherwise
- = assertPpr (isGenerativeTyCon tc Nominal) (ppr tc) tc_name
- where
- tc_name = tyConName tc
-
+ = assertPpr (isGenerativeTyCon tc Nominal) (ppr tc) (tyConName tc)
-- | Trie of @[RoughMatchTc]@
--
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -1421,8 +1421,6 @@ piResultTy ty arg = case piResultTy_maybe ty arg of
Nothing -> pprPanic "piResultTy" (ppr ty $$ ppr arg)
piResultTy_maybe :: Type -> Type -> Maybe Type
--- We don't need a 'tc' version, because
--- this function behaves the same for Type and Constraint
piResultTy_maybe ty arg = case coreFullView ty of
FunTy { ft_res = res } -> Just res
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -27,7 +27,6 @@ import GHC.Prelude
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Var.Set
-import GHC.Builtin.Names( tYPETyConKey, cONSTRAINTTyConKey )
import GHC.Core.Type hiding ( getTvSubstEnv )
import GHC.Core.Coercion hiding ( getCvSubstEnv )
import GHC.Core.Predicate( scopedSort )
@@ -98,8 +97,6 @@ of ways. Here we summarise, but see Note [Specification of unification].
See Note [Apartness and type families]
* MARInfinite (occurs check):
See Note [Infinitary substitutions]
- * MARTypeVsConstraint:
- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim
* MARCast (obscure):
See (KCU2) in Note [Kind coercions in Unify]
@@ -997,16 +994,12 @@ data UnifyResultM a = Unifiable a -- the subst that unifies the types
-- | Why are two types 'MaybeApart'? 'MARInfinite' takes precedence:
-- This is used (only) in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv
--- As of Feb 2022, we never differentiate between MARTypeFamily and MARTypeVsConstraint;
--- it's really only MARInfinite that's interesting here.
+-- It's really only MARInfinite that's interesting here.
data MaybeApartReason
= MARTypeFamily -- ^ matching e.g. F Int ~? Bool
| MARInfinite -- ^ matching e.g. a ~? Maybe a
- | MARTypeVsConstraint -- ^ matching Type ~? Constraint or the arrow types
- -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim
-
| MARCast -- ^ Very obscure.
-- See (KCU2) in Note [Kind coercions in Unify]
@@ -1015,13 +1008,11 @@ combineMAR :: MaybeApartReason -> MaybeApartReason -> MaybeApartReason
-- See (UR1) in Note [Unification result] for why MARInfinite wins
combineMAR MARInfinite _ = MARInfinite -- MARInfinite wins
combineMAR MARTypeFamily r = r -- Otherwise it doesn't really matter
-combineMAR MARTypeVsConstraint r = r
combineMAR MARCast r = r
instance Outputable MaybeApartReason where
ppr MARTypeFamily = text "MARTypeFamily"
ppr MARInfinite = text "MARInfinite"
- ppr MARTypeVsConstraint = text "MARTypeVsConstraint"
ppr MARCast = text "MARCast"
instance Semigroup MaybeApartReason where
@@ -1729,30 +1720,6 @@ unify_ty env ty1 ty2 kco
; unify_tc_app env tc1 tys1 tys2
}
- -- TYPE and CONSTRAINT are not Apart
- -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim
- -- NB: at this point we know that the two TyCons do not match
- | Just (tc1,_) <- mb_tc_app1, let u1 = tyConUnique tc1
- , Just (tc2,_) <- mb_tc_app2, let u2 = tyConUnique tc2
- , (u1 == tYPETyConKey && u2 == cONSTRAINTTyConKey) ||
- (u2 == tYPETyConKey && u1 == cONSTRAINTTyConKey)
- = maybeApart MARTypeVsConstraint
- -- We don't bother to look inside; wrinkle (W3) in GHC.Builtin.Types.Prim
- -- Note [Type and Constraint are not apart]
-
- -- The arrow types are not Apart
- -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim
- -- wrinkle (W2)
- -- NB1: at this point we know that the two TyCons do not match
- -- NB2: In the common FunTy/FunTy case you might wonder if we want to go via
- -- splitTyConApp_maybe. But yes we do: we need to look at those implied
- -- kind argument in order to satisfy (Unification Kind Invariant)
- | FunTy {} <- ty1
- , FunTy {} <- ty2
- = maybeApart MARTypeVsConstraint
- -- We don't bother to look inside; wrinkle (W3) in GHC.Builtin.Types.Prim
- -- Note [Type and Constraint are not apart]
-
where
mb_tc_app1 = splitTyConApp_maybe ty1
mb_tc_app2 = splitTyConApp_maybe ty2
=====================================
compiler/GHC/Tc/Instance/Class.hs
=====================================
@@ -963,11 +963,6 @@ matchTypeable clas [k,t] -- clas = Typeable
| k `eqType` naturalTy = doTyLit knownNatClassName t
| k `eqType` typeSymbolKind = doTyLit knownSymbolClassName t
| k `eqType` charTy = doTyLit knownCharClassName t
-
- -- TyCon applied to its kind args
- -- No special treatment of Type and Constraint; they get distinct TypeReps
- -- see wrinkle (W4) of Note [Type and Constraint are not apart]
- -- in GHC.Builtin.Types.Prim.
| Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)]
, onlyNamedBndrsApplied tc ks = doTyConApp clas t tc ks
=====================================
docs/users_guide/9.16.1-notes.rst
=====================================
@@ -16,6 +16,17 @@ Language
result, you may need to enable :extension:`DataKinds` in code that did not
previously require it.
+- ``Type`` and ``Constraint`` are now (at last) completely distinct types, just as much
+ as ``Int`` and ``Bool``. For example, you can now
+ write::
+
+ type family F a
+
+ type instance F Type = Int
+ type instance F Constraint = Bool
+
+ which was previously rejected with "Conflicting family instance declarations".
+
Compiler
~~~~~~~~
=====================================
testsuite/tests/indexed-types/should_fail/T21092.hs
=====================================
@@ -7,3 +7,5 @@ type family F a
type instance F Type = Int
type instance F Constraint = Bool
+
+-- Nov 2025: Type and Constraint are now Apart (#24279)
=====================================
testsuite/tests/indexed-types/should_fail/T21092.stderr deleted
=====================================
@@ -1,5 +0,0 @@
-
-T21092.hs:8:15: error: [GHC-34447]
- Conflicting family instance declarations:
- F (*) = Int -- Defined at T21092.hs:8:15
- F Constraint = Bool -- Defined at T21092.hs:9:15
=====================================
testsuite/tests/indexed-types/should_fail/all.T
=====================================
@@ -107,7 +107,7 @@ test('T8368', normal, compile_fail, [''])
test('T8368a', normal, compile_fail, [''])
test('T8518', normal, compile_fail, [''])
test('T9036', normal, compile_fail, [''])
-test('T21092', normal, compile_fail, [''])
+test('T21092', normal, compile, ['']) # Now compiles fine
test('T9167', normal, compile_fail, [''])
test('T9171', normal, compile_fail, [''])
test('T9097', normal, compile_fail, [''])
=====================================
testsuite/tests/typecheck/should_fail/T24279.hs
=====================================
@@ -13,7 +13,7 @@ type G :: Type -> RuntimeRep -> Type
type family G a where
G (a b) = a
--- Should be rejected
+-- Now (Nov 2025) accepted
foo :: (F (G Constraint)) -> Bool
foo x = x
@@ -22,10 +22,10 @@ type family H a b where
H a a = Int
H a b = Bool
--- Should be rejected
-bar1 :: H TYPE CONSTRAINT -> Int
+-- Now (Nov 2025) accepted
+bar1 :: H TYPE CONSTRAINT -> Bool
bar1 x = x
--- Should be rejected
-bar2 :: H Type Constraint -> Int
+-- Now (Nov 2025) accepted
+bar2 :: H Type Constraint -> Bool
bar2 x = x
=====================================
testsuite/tests/typecheck/should_fail/T24279.stderr deleted
=====================================
@@ -1,19 +0,0 @@
-
-T24279.hs:18:9: error: [GHC-83865]
- • Couldn't match type ‘F CONSTRAINT’ with ‘Bool’
- Expected: Bool
- Actual: F (G Constraint)
- • In the expression: x
- In an equation for ‘foo’: foo x = x
-
-T24279.hs:27:10: error: [GHC-83865]
- • Couldn't match expected type ‘Int’
- with actual type ‘H TYPE CONSTRAINT’
- • In the expression: x
- In an equation for ‘bar1’: bar1 x = x
-
-T24279.hs:31:10: error: [GHC-83865]
- • Couldn't match expected type ‘Int’
- with actual type ‘H (*) Constraint’
- • In the expression: x
- In an equation for ‘bar2’: bar2 x = x
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -718,7 +718,7 @@ test('T24064', normal, compile_fail, [''])
test('T24090a', normal, compile_fail, [''])
test('T24090b', normal, compile, ['']) # scheduled to become an actual error in GHC 9.16
test('T24298', normal, compile_fail, [''])
-test('T24279', normal, compile_fail, [''])
+test('T24279', normal, compile, ['']) # Now accepted (Nov 2025)
test('T24318', normal, compile_fail, [''])
# all the various do expansion fail messages
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a00840eacb6e98f0cdc9867db4ebdc6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a00840eacb6e98f0cdc9867db4ebdc6…
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: Make TYPE and CONSTRAINT apart again
by Marge Bot (＠marge-bot) 15 Nov '25
by Marge Bot (＠marge-bot) 15 Nov '25
15 Nov '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
a00840ea by Simon Peyton Jones at 2025-11-14T15:23:56+00:00
Make TYPE and CONSTRAINT apart again
This patch finally fixes #24279.
* The story started with #11715
* Then #21623 articulated a plan, which made Type and Constraint
not-apart; a horrible hack but it worked. The main patch was
commit 778c6adca2c995cd8a1b84394d4d5ca26b915dac
Author: Simon Peyton Jones <simonpj(a)microsoft.com>
Date: Wed Nov 9 10:33:22 2022 +0000
Type vs Constraint: finally nailed
* #24279 reported a bug in the above big commit; this small patch fixes it
commit af6932d6c068361c6ae300d52e72fbe13f8e1f18
Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com>
Date: Mon Jan 8 10:49:49 2024 +0000
Make TYPE and CONSTRAINT not-apart
Issue #24279 showed up a bug in the logic in GHC.Core.Unify.unify_ty
which is supposed to make TYPE and CONSTRAINT be not-apart.
* Then !10479 implemented "unary classes".
* That change in turn allows us to make Type and Constraint apart again,
cleaning up the compiler and allowing a little bit more expressiveness.
It fixes the original hope in #24279, namely that `Type` and `Constraint`
should be distinct throughout.
- - - - -
b674971c by Georgios Karachalias at 2025-11-14T20:12:40-05:00
Report all missing modules with -M
We now report all missing modules at once in GHC.Driver.Makefile.processDeps,
as opposed to only reporting a single missing module. Fixes #26551.
- - - - -
23c9ebc9 by Sylvain Henry at 2025-11-14T20:13:08-05:00
JS: fix array index for registers
We used to store R32 in h$regs[-1]. While it's correct in JavaScript,
fix this to store R32 in h$regs[0] instead.
- - - - -
d43cc50d by Sylvain Henry at 2025-11-14T20:13:08-05:00
JS: support more than 128 registers (#26558)
The JS backend only supported 128 registers (JS variables/array slots
used to pass function arguments). It failed in T26537 when 129
registers were required.
This commit adds support for more than 128 registers: it is now limited to
maxBound :: Int (compiler's Int). If we ever go above this threshold the
compiler now panics with a more descriptive message.
A few built-in JS functions were assuming 128 registers and have been
rewritten to use loops. Note that loops are only used for "high"
registers that are stored in an array: the 31 "low" registers are still
handled with JS global variables and with explicit switch-cases to
maintain good performance in the most common cases (i.e. few registers
used). Adjusting the number of low registers is now easy: just one
constant to adjust (GHC.StgToJS.Regs.lowRegsCount).
No new test added: T26537 is used as a regression test instead.
- - - - -
25 changed files:
- compiler/GHC/Builtin/Types/Prim.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/RoughMap.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/Expr.hs
- compiler/GHC/StgToJS/Regs.hs
- compiler/GHC/StgToJS/Rts/Rts.hs
- compiler/GHC/StgToJS/Rts/Types.hs
- compiler/GHC/Tc/Instance/Class.hs
- docs/users_guide/9.16.1-notes.rst
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/driver/Makefile
- + testsuite/tests/driver/T26551.hs
- + testsuite/tests/driver/T26551.stderr
- testsuite/tests/driver/all.T
- testsuite/tests/indexed-types/should_fail/T21092.hs
- − testsuite/tests/indexed-types/should_fail/T21092.stderr
- testsuite/tests/indexed-types/should_fail/all.T
- testsuite/tests/typecheck/should_fail/T24279.hs
- − testsuite/tests/typecheck/should_fail/T24279.stderr
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
compiler/GHC/Builtin/Types/Prim.hs
=====================================
@@ -752,8 +752,9 @@ Specifically (a ~# b) :: CONSTRAINT (TupleRep [])
Wrinkles
-(W1) Type and Constraint are considered distinct throughout GHC. But they
- are not /apart/: see Note [Type and Constraint are not apart]
+(W1) Type and Constraint are considered distinct throughout GHC.
+ That wasn't always the case:
+ see Historical Note [Type and Constraint are not apart]
(W2) We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and
aBSENT_CONSTRAINT_ERROR_ID for types of kind Constraint.
@@ -768,8 +769,24 @@ Wrinkles
of type TYPE rr. See (CPR2) in Note [Which types are unboxed?] in
GHC.Core.Opt.WorkWrap.Utils.
-Note [Type and Constraint are not apart]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-------------------------------------------------------------
+Historical Note [Type and Constraint are not apart]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Nov 2025:
+ In the past, Type and Constraint were carefully coonsiderd to be
+ not /apart/. But the necessity for that vanished with unary classes
+ (see Note [Unary class magic]), done in
+
+ commit 9bd7fcc518111a1549c98720c222cdbabd32ed46
+ Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com>
+ Date: Tue Apr 15 17:43:46 2025 +0100
+ Implement unary classes
+
+ So now Type and Constraint are simply distinct type constructors, just as
+ much as Int and Bool.
+
+ The rest of this Note is preserved for historical interest.
+
Type and Constraint are not equal (eqType) but they are not /apart/
either. Reason (c.f. #7451):
@@ -841,6 +858,9 @@ Wrinkles
So in GHC.Tc.Instance.Class.matchTypeable, Type and Constraint are
treated as separate TyCons; i.e. given no special treatment.
+End of Historical Note
+-------------------------------------------------------------
+
Note [RuntimeRep polymorphism]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Generally speaking, you can't be polymorphic in `RuntimeRep`. E.g
=====================================
compiler/GHC/Core/Coercion.hs
=====================================
@@ -641,11 +641,6 @@ eqTyConRole tc
-- | Given a coercion `co :: (t1 :: TYPE r1) ~ (t2 :: TYPE r2)`
-- produce a coercion `rep_co :: r1 ~ r2`
--- But actually it is possible that
--- co :: (t1 :: CONSTRAINT r1) ~ (t2 :: CONSTRAINT r2)
--- or co :: (t1 :: TYPE r1) ~ (t2 :: CONSTRAINT r2)
--- or co :: (t1 :: CONSTRAINT r1) ~ (t2 :: TYPE r2)
--- See Note [mkRuntimeRepCo]
mkRuntimeRepCo :: HasDebugCallStack => Coercion -> Coercion
mkRuntimeRepCo co
= assert (isTYPEorCONSTRAINT k1 && isTYPEorCONSTRAINT k2) $
@@ -654,26 +649,6 @@ mkRuntimeRepCo co
kind_co = mkKindCo co -- kind_co :: TYPE r1 ~ TYPE r2
Pair k1 k2 = coercionKind kind_co
-{- Note [mkRuntimeRepCo]
-~~~~~~~~~~~~~~~~~~~~~~~~
-Given
- class C a where { op :: Maybe a }
-we will get an axiom
- axC a :: (C a :: CONSTRAINT r1) ~ (Maybe a :: TYPE r2)
-(See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim.)
-
-Then we may call mkRuntimeRepCo on (axC ty), and that will return
- mkSelCo (SelTyCon 0 Nominal) (Kind (axC ty)) :: r1 ~ r2
-
-So mkSelCo needs to be happy with decomposing a coercion of kind
- CONSTRAINT r1 ~ TYPE r2
-
-Hence the use of `tyConIsTYPEorCONSTRAINT` in the assertion `good_call`
-in `mkSelCo`. See #23018 for a concrete example. (In this context it's
-important that TYPE and CONSTRAINT have the same arity and kind, not
-merely that they are not-apart; otherwise SelCo would not make sense.)
--}
-
isReflCoVar_maybe :: Var -> Maybe Coercion
-- If cv :: t~t then isReflCoVar_maybe cv = Just (Refl t)
-- Works on all kinds of Vars, not just CoVars
@@ -1305,8 +1280,7 @@ mkSelCo_maybe cs co
, Just (tc2, tys2) <- splitTyConApp_maybe ty2
, let { len1 = length tys1
; len2 = length tys2 }
- = (tc1 == tc2 || (tyConIsTYPEorCONSTRAINT tc1 && tyConIsTYPEorCONSTRAINT tc2))
- -- tyConIsTYPEorCONSTRAINT: see Note [mkRuntimeRepCo]
+ = tc1 == tc2
&& len1 == len2
&& n < len1
&& r == tyConRole (coercionRole co) tc1 n
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -2891,13 +2891,9 @@ lint_branch ax_tc (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs
hang (text "Inhomogeneous axiom")
2 (text "lhs:" <+> ppr lhs <+> dcolon <+> ppr lhs_kind $$
text "rhs:" <+> ppr rhs <+> dcolon <+> ppr rhs_kind) }
- -- Type and Constraint are not Apart, so this test allows
- -- the newtype axiom for a single-method class. Indeed the
- -- whole reason Type and Constraint are not Apart is to allow
- -- such axioms!
--- these checks do not apply to newtype axioms
lint_family_branch :: TyCon -> CoAxBranch -> LintM ()
+-- These checks do not apply to newtype axioms
lint_family_branch fam_tc br@(CoAxBranch { cab_tvs = tvs
, cab_eta_tvs = eta_tvs
, cab_cvs = cvs
=====================================
compiler/GHC/Core/RoughMap.hs
=====================================
@@ -36,7 +36,6 @@ import GHC.Core.Type
import GHC.Utils.Outputable
import GHC.Types.Name
import GHC.Types.Name.Env
-import GHC.Builtin.Types.Prim( cONSTRAINTTyConName, tYPETyConName )
import Control.Monad (join)
import Data.Data (Data)
@@ -347,16 +346,7 @@ typeToRoughMatchTc ty
roughMatchTyConName :: TyCon -> Name
roughMatchTyConName tc
- | tc_name == cONSTRAINTTyConName
- = tYPETyConName -- TYPE and CONSTRAINT are not apart, so they must use
- -- the same rough-map key. We arbitrarily use TYPE.
- -- See Note [Type and Constraint are not apart]
- -- wrinkle (W1) in GHC.Builtin.Types.Prim
- | otherwise
- = assertPpr (isGenerativeTyCon tc Nominal) (ppr tc) tc_name
- where
- tc_name = tyConName tc
-
+ = assertPpr (isGenerativeTyCon tc Nominal) (ppr tc) (tyConName tc)
-- | Trie of @[RoughMatchTc]@
--
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -1421,8 +1421,6 @@ piResultTy ty arg = case piResultTy_maybe ty arg of
Nothing -> pprPanic "piResultTy" (ppr ty $$ ppr arg)
piResultTy_maybe :: Type -> Type -> Maybe Type
--- We don't need a 'tc' version, because
--- this function behaves the same for Type and Constraint
piResultTy_maybe ty arg = case coreFullView ty of
FunTy { ft_res = res } -> Just res
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -27,7 +27,6 @@ import GHC.Prelude
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Var.Set
-import GHC.Builtin.Names( tYPETyConKey, cONSTRAINTTyConKey )
import GHC.Core.Type hiding ( getTvSubstEnv )
import GHC.Core.Coercion hiding ( getCvSubstEnv )
import GHC.Core.Predicate( scopedSort )
@@ -98,8 +97,6 @@ of ways. Here we summarise, but see Note [Specification of unification].
See Note [Apartness and type families]
* MARInfinite (occurs check):
See Note [Infinitary substitutions]
- * MARTypeVsConstraint:
- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim
* MARCast (obscure):
See (KCU2) in Note [Kind coercions in Unify]
@@ -997,16 +994,12 @@ data UnifyResultM a = Unifiable a -- the subst that unifies the types
-- | Why are two types 'MaybeApart'? 'MARInfinite' takes precedence:
-- This is used (only) in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv
--- As of Feb 2022, we never differentiate between MARTypeFamily and MARTypeVsConstraint;
--- it's really only MARInfinite that's interesting here.
+-- It's really only MARInfinite that's interesting here.
data MaybeApartReason
= MARTypeFamily -- ^ matching e.g. F Int ~? Bool
| MARInfinite -- ^ matching e.g. a ~? Maybe a
- | MARTypeVsConstraint -- ^ matching Type ~? Constraint or the arrow types
- -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim
-
| MARCast -- ^ Very obscure.
-- See (KCU2) in Note [Kind coercions in Unify]
@@ -1015,13 +1008,11 @@ combineMAR :: MaybeApartReason -> MaybeApartReason -> MaybeApartReason
-- See (UR1) in Note [Unification result] for why MARInfinite wins
combineMAR MARInfinite _ = MARInfinite -- MARInfinite wins
combineMAR MARTypeFamily r = r -- Otherwise it doesn't really matter
-combineMAR MARTypeVsConstraint r = r
combineMAR MARCast r = r
instance Outputable MaybeApartReason where
ppr MARTypeFamily = text "MARTypeFamily"
ppr MARInfinite = text "MARInfinite"
- ppr MARTypeVsConstraint = text "MARTypeVsConstraint"
ppr MARCast = text "MARCast"
instance Semigroup MaybeApartReason where
@@ -1729,30 +1720,6 @@ unify_ty env ty1 ty2 kco
; unify_tc_app env tc1 tys1 tys2
}
- -- TYPE and CONSTRAINT are not Apart
- -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim
- -- NB: at this point we know that the two TyCons do not match
- | Just (tc1,_) <- mb_tc_app1, let u1 = tyConUnique tc1
- , Just (tc2,_) <- mb_tc_app2, let u2 = tyConUnique tc2
- , (u1 == tYPETyConKey && u2 == cONSTRAINTTyConKey) ||
- (u2 == tYPETyConKey && u1 == cONSTRAINTTyConKey)
- = maybeApart MARTypeVsConstraint
- -- We don't bother to look inside; wrinkle (W3) in GHC.Builtin.Types.Prim
- -- Note [Type and Constraint are not apart]
-
- -- The arrow types are not Apart
- -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim
- -- wrinkle (W2)
- -- NB1: at this point we know that the two TyCons do not match
- -- NB2: In the common FunTy/FunTy case you might wonder if we want to go via
- -- splitTyConApp_maybe. But yes we do: we need to look at those implied
- -- kind argument in order to satisfy (Unification Kind Invariant)
- | FunTy {} <- ty1
- , FunTy {} <- ty2
- = maybeApart MARTypeVsConstraint
- -- We don't bother to look inside; wrinkle (W3) in GHC.Builtin.Types.Prim
- -- Note [Type and Constraint are not apart]
-
where
mb_tc_app1 = splitTyConApp_maybe ty1
mb_tc_app2 = splitTyConApp_maybe ty2
=====================================
compiler/GHC/Driver/MakeFile.hs
=====================================
@@ -55,6 +55,7 @@ import Data.IORef
import qualified Data.Set as Set
import GHC.Iface.Errors.Types
import Data.Either
+import GHC.Data.Bag (listToBag)
-----------------------------------------------------------------
--
@@ -237,19 +238,6 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ (ModuleN
obj_file = msObjFilePath node
obj_files = insertSuffixes obj_file extra_suffixes
- do_imp loc is_boot pkg_qual imp_mod
- = do { mb_hi <- findDependency hsc_env loc pkg_qual imp_mod
- is_boot include_pkg_deps
- ; case mb_hi of {
- Nothing -> return () ;
- Just hi_file -> do
- { let hi_files = insertSuffixes hi_file extra_suffixes
- write_dep (obj,hi) = writeDependency root hdl [obj] hi
-
- -- Add one dependency for each suffix;
- -- e.g. A.o : B.hi
- -- A.x_o : B.x_hi
- ; mapM_ write_dep (obj_files `zip` hi_files) }}}
-- Emit std dependency of the object(s) on the source file
@@ -280,15 +268,33 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ (ModuleN
-- Emit a dependency for each import
- ; let do_imps is_boot idecls = sequence_
- [ do_imp loc is_boot mb_pkg mod
+ ; let find_dep loc is_boot pkg_qual imp_mod = findDependency hsc_env loc pkg_qual imp_mod is_boot include_pkg_deps
+
+ find_deps is_boot idecls = sequence
+ [ find_dep loc is_boot mb_pkg mod
| (_lvl, mb_pkg, L loc mod) <- idecls,
mod `notElem` excl_mods ]
- ; do_imps IsBoot (map ((,,) NormalLevel NoPkgQual) (ms_srcimps node))
- ; do_imps NotBoot (ms_imps node)
- }
+ do_imp hi_file = do
+ let hi_files = insertSuffixes hi_file extra_suffixes
+ write_dep (obj,hi) = writeDependency root hdl [obj] hi
+
+ -- Add one dependency for each suffix;
+ -- e.g. A.o : B.hi
+ -- A.x_o : B.x_hi
+ mapM_ write_dep (obj_files `zip` hi_files)
+ ; (missing_boot_dep_errs, boot_deps) <- partitionEithers <$> find_deps IsBoot (map ((,,) NormalLevel NoPkgQual) (ms_srcimps node))
+ ; (missing_not_boot_dep_errs, not_boot_deps) <- partitionEithers <$> find_deps NotBoot (ms_imps node)
+
+ ; let all_missing_errors = missing_boot_dep_errs ++ missing_not_boot_dep_errs
+
+ ; if null all_missing_errors
+ then mapM_ (mapM_ do_imp) (boot_deps ++ not_boot_deps)
+ else do
+ let sec = initSourceErrorContext (hsc_dflags hsc_env)
+ throwErrors sec (mkMessages (listToBag all_missing_errors))
+ }
findDependency :: HscEnv
-> SrcSpan
@@ -296,7 +302,7 @@ findDependency :: HscEnv
-> ModuleName -- Imported module
-> IsBootInterface -- Source import
-> Bool -- Record dependency on package modules
- -> IO (Maybe FilePath) -- Interface file
+ -> IO (Either (MsgEnvelope GhcMessage) (Maybe FilePath)) -- Interface file
findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
-- Find the module; this will be fast because
-- we've done it once during downsweep
@@ -305,16 +311,15 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
Found loc _
-- Home package: just depend on the .hi or hi-boot file
| isJust (ml_hs_file loc) || include_pkg_deps
- -> return (Just (ml_hi_file loc))
+ -> return (Right (Just (ml_hi_file loc)))
-- Not in this package: we don't need a dependency
| otherwise
- -> return Nothing
+ -> return (Right Nothing)
fail ->
- let sec = initSourceErrorContext (hsc_dflags hsc_env)
- in
- throwOneError sec $
+ return $
+ Left $
mkPlainErrorMsgEnvelope srcloc $
GhcDriverMessage $ DriverInterfaceError $
(Can'tFindInterface (cannotFindModule hsc_env imp fail) (LookingForModule imp is_boot))
=====================================
compiler/GHC/StgToJS/Apply.hs
=====================================
@@ -185,7 +185,7 @@ genApp ctx i args
as' <- concatMapM genArg args
ei <- varForEntryId i
let ra = mconcat . reverse $
- zipWith (\r a -> toJExpr r |= a) [R1 ..] as'
+ zipWith (\r a -> toJExpr r |= a) regsFromR1 as'
p <- pushLneFrame n ctx
a <- adjSp 1 -- for the header (which will only be written when the thread is suspended)
return (ra <> p <> a <> returnS ei, ExprCont)
@@ -464,42 +464,31 @@ specTag spec = Bits.shiftL (specVars spec) 8 Bits..|. specArgs spec
specTagExpr :: ApplySpec -> JStgExpr
specTagExpr = toJExpr . specTag
--- | Build arrays to quickly lookup apply functions
+-- | Build functions to quickly lookup apply functions
--
--- h$apply[r << 8 | n] = function application for r regs, n args
--- h$paps[r] = partial application for r registers (number of args is in the object)
+-- h$apply(r << 8 | n) = function application for r regs, n args
+-- h$paps(r) = partial application for r registers (number of args is in the object)
mkApplyArr :: JSM JStgStat
mkApplyArr =
- do mk_ap_gens <- jFor (|= zero_) (.<. Int 65536) preIncrS
- \j -> hdApply .! j |= hdApGen
- mk_pap_gens <- jFor (|= zero_) (.<. Int 128) preIncrS
- \j -> hdPaps .! j |= hdPapGen
+ do paps_fun <- jFunction (name hdPapsStr) \(MkSolo i) -> pure $ SwitchStat i (map case_pap specPap) (returnS hdPapGen)
+ apply_fun <- jFunction (name hdApplyStr) \(MkSolo i) -> pure $ SwitchStat i (mapMaybe' case_apply applySpec) (returnS hdApGen)
return $ mconcat
- [ name hdApplyStr ||= toJExpr (JList [])
- , name hdPapsStr ||= toJExpr (JList [])
- , ApplStat (hdInitStatic .^ "push")
- [ jLam' $
- mconcat
- [ mk_ap_gens
- , mk_pap_gens
- , mconcat (map assignSpec applySpec)
- , mconcat (map assignPap specPap)
- ]
- ]
+ [ paps_fun
+ , apply_fun
]
where
- assignSpec :: ApplySpec -> JStgStat
- assignSpec spec = case specConv spec of
+ case_apply :: ApplySpec -> Maybe (JStgExpr,JStgStat)
+ case_apply spec = case specConv spec of
-- both fast/slow (regs/stack) specialized apply functions have the same
-- tags. We store the stack ones in the array because they are used as
-- continuation stack frames.
- StackConv -> hdApply .! specTagExpr spec |= specApplyExpr spec
- RegsConv -> mempty
+ StackConv -> Just (specTagExpr spec, returnS (specApplyExpr spec))
+ RegsConv -> Nothing
hdPap_ = unpackFS hdPapStr_
- assignPap :: Int -> JStgStat
- assignPap p = hdPaps .! toJExpr p |= global (mkFastString (hdPap_ ++ show p))
+ case_pap :: Int -> (JStgExpr, JStgStat)
+ case_pap p = (toJExpr p, returnS $ global (mkFastString (hdPap_ ++ show p)))
-- | Push a continuation on the stack
--
@@ -619,7 +608,7 @@ genericStackApply cfg = closure info body
-- compute new tag with consumed register values and args removed
, newTag |= ((given_regs-needed_regs).<<.8) .|. (given_args - needed_args)
-- find application function for the remaining regs/args
- , newAp |= hdApply .! newTag
+ , newAp |= ApplExpr hdApply [newTag]
, traceRts cfg (jString "h$ap_gen: next: " + (newAp .^ "n"))
-- Drop used registers from the stack.
@@ -643,7 +632,7 @@ genericStackApply cfg = closure info body
-----------------------------
[ traceRts cfg (jString "h$ap_gen: undersat")
-- find PAP entry function corresponding to given_regs count
- , p |= hdPaps .! given_regs
+ , p |= ApplExpr hdPaps [given_regs]
-- build PAP payload: R1 + tag + given register values
, newTag |= ((needed_regs-given_regs) .<<. 8) .|. (needed_args-given_args)
@@ -716,7 +705,7 @@ genericFastApply s =
do push_all_regs <- pushAllRegs tag
return $ mconcat $
[ push_all_regs
- , ap |= hdApply .! tag
+ , ap |= ApplExpr hdApply [tag]
, ifS (ap .===. hdApGen)
((sp |= sp + 2) <> (stack .! (sp-1) |= tag))
(sp |= sp + 1)
@@ -750,7 +739,7 @@ genericFastApply s =
, traceRts s (jString "h$ap_gen_fast: oversat " + sp)
, push_args
, newTag |= ((myRegs-( arity.>>.8)).<<.8).|.myAr-ar
- , newAp |= hdApply .! newTag
+ , newAp |= ApplExpr hdApply [newTag]
, ifS (newAp .===. hdApGen)
((sp |= sp + 2) <> (stack .! (sp - 1) |= newTag))
(sp |= sp + 1)
@@ -761,7 +750,7 @@ genericFastApply s =
-- else
[traceRts s (jString "h$ap_gen_fast: undersat: " + myRegs + jString " " + tag)
, jwhenS (tag .!=. 0) $ mconcat
- [ p |= hdPaps .! myRegs
+ [ p |= ApplExpr hdPaps [myRegs]
, dat |= toJExpr [r1, ((arity .>>. 8)-myRegs)*256+ar-myAr]
, get_regs
, r1 |= initClosure s p dat jCurrentCCS
@@ -773,14 +762,24 @@ genericFastApply s =
pushAllRegs :: JStgExpr -> JSM JStgStat
pushAllRegs tag =
jVar \regs ->
- return $ mconcat $
- [ regs |= tag .>>. 8
- , sp |= sp + regs
- , SwitchStat regs (map pushReg [65,64..2]) mempty
- ]
- where
- pushReg :: Int -> (JStgExpr, JStgStat)
- pushReg r = (toJExpr (r-1), stack .! (sp - toJExpr (r - 2)) |= jsReg r)
+ let max_low_reg = regNumber maxLowReg
+ low_regs = [max_low_reg, max_low_reg-1..2] -- R1 isn't used for arguments
+ pushReg :: Int -> (JStgExpr, JStgStat)
+ pushReg r = (toJExpr r, stack .! (sp - toJExpr (r - 2)) |= jsReg r)
+ in return $ mconcat $
+ [ regs |= tag .>>. 8
+ , sp |= sp + regs
+ -- increment the number of regs by 1, so that it matches register
+ -- numbers (R1 is not used for args)
+ , postIncrS regs
+ -- copy high registers with a loop
+ , WhileStat False (regs .>. toJExpr max_low_reg) $ mconcat
+ -- rN stored in stack[sp - N - 2] so that r2 is stored in stack[sp], etc.
+ [ stack .! (sp - regs - 2) |= highReg_expr regs
+ , postDecrS regs
+ ]
+ , SwitchStat regs (map pushReg low_regs) mempty
+ ]
pushArgs :: JStgExpr -> JStgExpr -> JSM JStgStat
pushArgs start end =
@@ -906,7 +905,7 @@ stackApply s fun_name nargs nvars =
[ rs |= (arity .>>. 8)
, loadRegs rs
, sp |= sp - rs
- , newAp |= (hdApply .! ((toJExpr nargs-arity0).|.((toJExpr nvars-rs).<<.8)))
+ , newAp |= ApplExpr hdApply [(toJExpr nargs-arity0).|.((toJExpr nvars-rs).<<.8)]
, stack .! sp |= newAp
, profStat s pushRestoreCCS
, traceRts s (toJExpr (fun_name <> ": new stack frame: ") + (newAp .^ "n"))
@@ -989,7 +988,7 @@ fastApply s fun_name nargs nvars = if nargs == 0 && nvars == 0
+ rsRemain)
, saveRegs rs
, sp |= sp + rsRemain + 1
- , stack .! sp |= hdApply .! ((rsRemain.<<.8).|. (toJExpr nargs - mask8 arity))
+ , stack .! sp |= ApplExpr hdApply [(rsRemain.<<.8).|. (toJExpr nargs - mask8 arity)]
, profStat s pushRestoreCCS
, returnS c
]
@@ -1238,14 +1237,30 @@ pap s r = closure (ClosureInfo
, profStat s (enterCostCentreFun currentCCS)
, extra |= (funOrPapArity c (Just f) .>>. 8) - toJExpr r
, traceRts s (toJExpr (funcName <> ": pap extra args moving: ") + extra)
- , moveBy extra
+ , case r of
+ 0 -> mempty -- in pap_0 we don't shift any register
+ _ -> moveBy extra
, loadOwnArgs d
, r1 |= c
, returnS f
]
- moveBy extra = SwitchStat extra
- (reverse $ map moveCase [1..maxReg-r-1]) mempty
- moveCase m = (toJExpr m, jsReg (m+r+1) |= jsReg (m+1))
+ moveBy extra =
+ let max_low_reg = regNumber maxLowReg
+ low_regs = [max_low_reg, max_low_reg-1..2] -- R1 isn't used for arguments
+ move_case m = (toJExpr m, jsReg (m+r) |= jsReg m)
+ in mconcat
+ [ -- increment the number of args by 1, so that it matches register
+ -- numbers (R1 is not used for args)
+ postIncrS extra
+ -- copy high registers with a loop
+ , WhileStat False (extra .>. toJExpr max_low_reg) $ mconcat
+ [ highReg_expr (extra + toJExpr r) |= highReg_expr extra
+ , postDecrS extra
+ ]
+ -- then copy low registers with a case
+ , SwitchStat extra (map move_case low_regs) mempty
+ ]
+
loadOwnArgs d = mconcat $ map (\r ->
jsReg (r+1) |= dField d (r+2)) [1..r]
dField d n = SelExpr d (name . mkFastString $ ('d':show (n-1)))
@@ -1274,7 +1289,9 @@ papGen cfg =
(jString "h$pap_gen: expected function or pap")
, profStat cfg (enterCostCentreFun currentCCS)
, traceRts cfg (jString "h$pap_gen: generic pap extra args moving: " + or)
+ -- shift newly applied arguments into appropriate registers
, appS hdMoveRegs2 [or, r]
+ -- load stored arguments into lowest argument registers (i.e. starting from R2)
, loadOwnArgs d r
, r1 |= c
, returnS f
@@ -1285,9 +1302,22 @@ papGen cfg =
funcIdent = name funcName
funcName = hdPapGenStr
loadOwnArgs d r =
- let prop n = d .^ ("d" <> mkFastString (show $ n+1))
- loadOwnArg n = (toJExpr n, jsReg (n+1) |= prop n)
- in SwitchStat r (map loadOwnArg [127,126..1]) mempty
+ let prop n = d .^ (mkFastString ("d" ++ show n))
+ loadOwnArg n = (toJExpr n, jsReg n |= prop n)
+ max_low_reg = regNumber maxLowReg
+ low_regs = [max_low_reg, max_low_reg-1..2] -- R1 isn't used for arguments
+ in mconcat
+ [ -- increment the number of args by 1, so that it matches register
+ -- numbers (R1 is not used for args) and PAP fields (starting from d2)
+ postIncrS r
+ -- copy high registers with a loop
+ , WhileStat False (r .>. toJExpr max_low_reg) $ mconcat
+ [ highReg_expr r |= (d .! (jString (fsLit "d") + r))
+ , postDecrS r
+ ]
+ -- then copy low registers with a case.
+ , SwitchStat r (map loadOwnArg low_regs) mempty
+ ]
-- general utilities
-- move the first n registers, starting at R2, m places up (do not use with negative m)
@@ -1301,7 +1331,7 @@ moveRegs2 = jFunction (name hdMoveRegs2) moveSwitch
switchCase n m = (toJExpr $
(n `Bits.shiftL` 8) Bits..|. m
, mconcat (map (`moveRegFast` m) [n+1,n..2])
- <> BreakStat Nothing {-[j| break; |]-})
+ <> BreakStat Nothing)
moveRegFast n m = jsReg (n+m) |= jsReg n
-- fallback
defaultCase n m =
=====================================
compiler/GHC/StgToJS/Expr.hs
=====================================
@@ -312,7 +312,7 @@ genBody ctx startReg args e typ = do
-- load arguments into local variables
la <- do
args' <- concatMapM genIdArgI args
- return (declAssignAll args' (fmap toJExpr [startReg..]))
+ return (declAssignAll args' (jsRegsFrom startReg))
-- assert that arguments have valid runtime reps
lav <- verifyRuntimeReps args
@@ -665,7 +665,7 @@ genCase ctx bnd e at alts l
| otherwise = do
rj <- genRet ctx bnd at alts l
let ctx' = ctxSetTop bnd
- $ ctxSetTarget (assocIdExprs bnd (map toJExpr [R1 ..]))
+ $ ctxSetTarget (assocIdExprs bnd jsRegsFromR1)
$ ctx
(ej, _r) <- genExpr ctx' e
return (rj <> ej, ExprCont)
@@ -730,7 +730,7 @@ genRet ctx e at as l = freshIdent >>= f
fun free = resetSlots $ do
decs <- declVarsForId e
- load <- flip assignAll (map toJExpr [R1 ..]) . map toJExpr <$> identsForId e
+ load <- flip assignAll jsRegsFromR1 . map toJExpr <$> identsForId e
loadv <- verifyRuntimeReps [e]
ras <- loadRetArgs free
rasv <- verifyRuntimeReps (map (\(x,_,_)->x) free)
=====================================
compiler/GHC/StgToJS/Regs.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
module GHC.StgToJS.Regs
( StgReg (..)
@@ -6,17 +7,25 @@ module GHC.StgToJS.Regs
, sp
, stack
, r1, r2, r3, r4
+ , pattern R1, pattern R2, pattern R3, pattern R4
, regsFromR1
, regsFromR2
+ , regsFromTo
+ , jsRegsFrom
, jsRegsFromR1
, jsRegsFromR2
, StgRet (..)
- , jsRegToInt
- , intToJSReg
+ , regNumber
, jsReg
+ , highReg
+ , highReg_expr
, maxReg
+ , maxLowReg
, minReg
+ , minHighReg
, lowRegs
+ , lowRegsCount
+ , lowRegsIdents
, retRegs
, register
, foreignRegister
@@ -32,6 +41,7 @@ import GHC.JS.Make
import GHC.StgToJS.Symbols
import GHC.Data.FastString
+import GHC.Utils.Panic.Plain
import Data.Array
import qualified Data.ByteString.Char8 as BSC
@@ -39,26 +49,15 @@ import Data.Char
import Data.Semigroup ((<>))
-- | General purpose "registers"
---
--- The JS backend arbitrarily supports 128 registers
-data StgReg
- = R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8
- | R9 | R10 | R11 | R12 | R13 | R14 | R15 | R16
- | R17 | R18 | R19 | R20 | R21 | R22 | R23 | R24
- | R25 | R26 | R27 | R28 | R29 | R30 | R31 | R32
- | R33 | R34 | R35 | R36 | R37 | R38 | R39 | R40
- | R41 | R42 | R43 | R44 | R45 | R46 | R47 | R48
- | R49 | R50 | R51 | R52 | R53 | R54 | R55 | R56
- | R57 | R58 | R59 | R60 | R61 | R62 | R63 | R64
- | R65 | R66 | R67 | R68 | R69 | R70 | R71 | R72
- | R73 | R74 | R75 | R76 | R77 | R78 | R79 | R80
- | R81 | R82 | R83 | R84 | R85 | R86 | R87 | R88
- | R89 | R90 | R91 | R92 | R93 | R94 | R95 | R96
- | R97 | R98 | R99 | R100 | R101 | R102 | R103 | R104
- | R105 | R106 | R107 | R108 | R109 | R110 | R111 | R112
- | R113 | R114 | R115 | R116 | R117 | R118 | R119 | R120
- | R121 | R122 | R123 | R124 | R125 | R126 | R127 | R128
- deriving (Eq, Ord, Show, Enum, Bounded, Ix)
+newtype StgReg
+ = StgReg Int
+ deriving (Eq,Ord,Ix)
+
+pattern R1, R2, R3, R4 :: StgReg
+pattern R1 = StgReg 0
+pattern R2 = StgReg 1
+pattern R3 = StgReg 2
+pattern R4 = StgReg 3
-- | Stack registers
data Special
@@ -78,7 +77,7 @@ instance ToJExpr Special where
toJExpr Sp = hdStackPtr
instance ToJExpr StgReg where
- toJExpr r = registers ! r
+ toJExpr r = register r
instance ToJExpr StgRet where
toJExpr r = rets ! r
@@ -99,25 +98,42 @@ r2 = toJExpr R2
r3 = toJExpr R3
r4 = toJExpr R4
+-- | 1-indexed register number (R1 has index 1)
+regNumber :: StgReg -> Int
+regNumber (StgReg r) = r+1
-jsRegToInt :: StgReg -> Int
-jsRegToInt = (+1) . fromEnum
+-- | StgReg from 1-indexed number
+regFromNumber :: Int -> StgReg
+regFromNumber r = assert (r >= 1) $ StgReg (r-1)
-intToJSReg :: Int -> StgReg
-intToJSReg r = toEnum (r - 1)
+regsFromTo :: StgReg -> StgReg -> [StgReg]
+regsFromTo (StgReg x) (StgReg y) = map StgReg [x .. y]
+-- | Register expression from its 1-indexed index
jsReg :: Int -> JStgExpr
-jsReg r = toJExpr (intToJSReg r)
+jsReg r = toJExpr (regFromNumber r)
+
+minReg :: StgReg
+minReg = R1
-maxReg :: Int
-maxReg = jsRegToInt maxBound
+maxReg :: StgReg
+maxReg = regFromNumber maxBound
-minReg :: Int
-minReg = jsRegToInt minBound
+lowRegsCount :: Int
+lowRegsCount = 31
+
+maxLowReg :: StgReg
+maxLowReg = regFromNumber lowRegsCount
+
+-- | First register stored in h$regs array instead of having its own top-level
+-- variable
+minHighReg :: StgReg
+minHighReg = case maxLowReg of
+ StgReg r -> StgReg (r+1)
-- | List of registers, starting from R1
regsFromR1 :: [StgReg]
-regsFromR1 = enumFrom R1
+regsFromR1 = regsFromTo R1 maxReg ++ repeat (panic "StgToJS: code requires too many registers")
-- | List of registers, starting from R2
regsFromR2 :: [StgReg]
@@ -131,35 +147,59 @@ jsRegsFromR1 = fmap toJExpr regsFromR1
jsRegsFromR2 :: [JStgExpr]
jsRegsFromR2 = tail jsRegsFromR1
+-- | List of registers, starting from given reg as JExpr
+jsRegsFrom :: StgReg -> [JStgExpr]
+jsRegsFrom (StgReg n) = drop n jsRegsFromR1
+
+-- | High register
+highReg :: Int -> JStgExpr
+highReg r = assert (r >= regNumber minHighReg) $ IdxExpr hdRegs (toJExpr (r - regNumber minHighReg))
+
+-- | High register indexing with a JS expression
+highReg_expr :: JStgExpr -> JStgExpr
+highReg_expr r = IdxExpr hdRegs (r - toJExpr (regNumber minHighReg))
+
+
---------------------------------------------------
-- caches
---------------------------------------------------
-lowRegs :: [Ident]
-lowRegs = map reg_to_ident [R1 .. R31]
- where reg_to_ident = name . mkFastString . (unpackFS hdStr ++) . map toLower . show
+lowRegs :: [StgReg]
+lowRegs = regsFromTo minReg maxLowReg
+
+lowRegsIdents :: [Ident]
+lowRegsIdents = map reg_to_ident lowRegs
+ where
+ -- low regs are named h$r1, h$r2, etc.
+ reg_to_ident r = name (mkFastString (unpackFS hdStr ++ "r" ++ show (regNumber r)))
retRegs :: [Ident]
retRegs = [name . mkFastStringByteString
$ hdB <> BSC.pack (map toLower $ show n) | n <- enumFrom Ret1]
--- cache JExpr representing StgReg
-registers :: Array StgReg JStgExpr
-registers = listArray (minBound, maxBound) (map (global . identFS) lowRegs ++ map regN [R32 .. R128])
- where
- regN :: StgReg -> JStgExpr
- regN r = IdxExpr hdRegs (toJExpr (fromEnum r - 32))
-
-- cache JExpr representing StgRet
rets :: Array StgRet JStgExpr
rets = listArray (minBound, maxBound) (map retN (enumFrom Ret1))
where
retN = global . mkFastString . (unpackFS hdStr ++) . map toLower . show
--- | Given a register, return the JS syntax object representing that register
-register :: StgReg -> JStgExpr
-register i = registers ! i
-
-- | Given a register, return the JS syntax object representing that register
foreignRegister :: StgRet -> JStgExpr
foreignRegister i = rets ! i
+
+-- | Given a register, return the JS syntax object representing that register
+register :: StgReg -> JStgExpr
+register i
+ | i <= maxCachedReg = register_cache ! i -- Expressions of common registers are cached.
+ | otherwise = make_high_reg i -- Expression of higher registers are made on the fly
+
+maxCachedReg :: StgReg
+maxCachedReg = regFromNumber 128
+
+-- cache JExpr representing StgReg
+register_cache :: Array StgReg JStgExpr
+register_cache = listArray (minReg, maxCachedReg) (map (global . identFS) lowRegsIdents ++ map make_high_reg (regsFromTo minHighReg maxCachedReg))
+
+-- | Make h$regs[XXX] expression for the register
+make_high_reg :: StgReg -> JStgExpr
+make_high_reg r = highReg (regNumber r)
=====================================
compiler/GHC/StgToJS/Rts/Rts.hs
=====================================
@@ -54,7 +54,12 @@ import qualified Data.Bits as Bits
-- | The garbageCollector resets registers and result variables.
garbageCollector :: JSM JStgStat
garbageCollector = jBlock
- [ jFunction' hdResetRegisters (return $ mconcat $ map resetRegister [minBound..maxBound])
+ [ jFunction' hdResetRegisters $ return $ mconcat
+ [ -- reset low registers explicitly
+ mconcat (map resetRegister lowRegs)
+ -- reset the whole h$regs array with h$regs.fill(null)
+ , toStat $ ApplExpr (hdRegs .^ "fill") [null_]
+ ]
, jFunction' hdResetResultVars (return $ mconcat $ map resetResultVar [minBound..maxBound])
]
@@ -249,7 +254,7 @@ declRegs = do
loaders <- loadRegs
return $
mconcat [ hdRegsStr ||= toJExpr (JList [])
- , mconcat (map declReg lowRegs)
+ , mconcat (map declReg lowRegsIdents)
, getters_setters
, loaders
]
@@ -259,15 +264,15 @@ declRegs = do
-- | JS payload to define getters and setters on the registers.
regGettersSetters :: JSM JStgStat
regGettersSetters =
- do setters <- jFunction (name hdGetRegStr) (\(MkSolo n) -> return $ SwitchStat n getRegCases mempty)
- getters <- jFunction (name hdSetRegStr) (\(n,v) -> return $ SwitchStat n (setRegCases v) mempty)
+ do getters <- jFunction (name hdGetRegStr) (\(MkSolo n) -> return $ SwitchStat n getRegCases (defaultGetRegCase n))
+ setters <- jFunction (name hdSetRegStr) (\(n,v) -> return $ SwitchStat n (setRegCases v) (defaultSetRegCase n v))
return $ setters <> getters
where
- getRegCases =
- map (\r -> (toJExpr (jsRegToInt r) , returnS (toJExpr r))) regsFromR1
- setRegCases :: JStgExpr -> [(JStgExpr,JStgStat)]
- setRegCases v =
- map (\r -> (toJExpr (jsRegToInt r), (toJExpr r |= toJExpr v) <> returnS undefined_)) regsFromR1
+ getRegCases = map (\r -> (toJExpr (regNumber r) , returnS (toJExpr r))) lowRegs
+ defaultGetRegCase n = returnS (highReg_expr n)
+
+ setRegCases v = map (\r -> (toJExpr (regNumber r), (toJExpr r |= v) <> BreakStat Nothing)) lowRegs
+ defaultSetRegCase n v = highReg_expr n |= v
-- | JS payload that defines the functions to load each register
loadRegs :: JSM JStgStat
=====================================
compiler/GHC/StgToJS/Rts/Types.hs
=====================================
@@ -69,12 +69,3 @@ stackFrameSize tgt f =
(tgt |= mask8 tag + 1) -- else set to mask'd tag + 1
]
))
-
- --------------------------------------------------------------------------------
--- Register utilities
---------------------------------------------------------------------------------
-
--- | Perform the computation 'f', on the range of registers bounded by 'start'
--- and 'end'.
-withRegs :: StgReg -> StgReg -> (StgReg -> JStgStat) -> JStgStat
-withRegs start end f = mconcat $ fmap f [start..end]
=====================================
compiler/GHC/Tc/Instance/Class.hs
=====================================
@@ -963,11 +963,6 @@ matchTypeable clas [k,t] -- clas = Typeable
| k `eqType` naturalTy = doTyLit knownNatClassName t
| k `eqType` typeSymbolKind = doTyLit knownSymbolClassName t
| k `eqType` charTy = doTyLit knownCharClassName t
-
- -- TyCon applied to its kind args
- -- No special treatment of Type and Constraint; they get distinct TypeReps
- -- see wrinkle (W4) of Note [Type and Constraint are not apart]
- -- in GHC.Builtin.Types.Prim.
| Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)]
, onlyNamedBndrsApplied tc ks = doTyConApp clas t tc ks
=====================================
docs/users_guide/9.16.1-notes.rst
=====================================
@@ -16,6 +16,17 @@ Language
result, you may need to enable :extension:`DataKinds` in code that did not
previously require it.
+- ``Type`` and ``Constraint`` are now (at last) completely distinct types, just as much
+ as ``Int`` and ``Bool``. For example, you can now
+ write::
+
+ type family F a
+
+ type instance F Type = Int
+ type instance F Constraint = Bool
+
+ which was previously rejected with "Conflicting family instance declarations".
+
Compiler
~~~~~~~~
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -256,4 +256,4 @@ test('T24893', normal, compile_and_run, ['-O'])
test('CCallConv', [req_c], compile_and_run, ['CCallConv_c.c'])
test('T25364', normal, compile_and_run, [''])
test('T26061', normal, compile_and_run, [''])
-test('T26537', js_broken(26558), compile_and_run, ['-O2 -fregs-graph'])
+test('T26537', normal, compile_and_run, ['-O2 -fregs-graph'])
=====================================
testsuite/tests/driver/Makefile
=====================================
@@ -415,6 +415,10 @@ test200:
"$(TEST_HC)" $(TEST_HC_OPTS) -M -dep-suffix "" -dep-makefile $(DEPFILE200) D200.hs B200/C.hs A200.hs
test -f $(DEPFILE200)
+# Test that we produce "could not find module" errors for _all_ missing imports.
+T26551:
+ "$(TEST_HC)" $(TEST_HC_OPTS) -M T26551.hs || true
+
# -----------------------------------------------------------------------------
T2566::
=====================================
testsuite/tests/driver/T26551.hs
=====================================
@@ -0,0 +1,5 @@
+module Main where
+
+import Foo
+import Bar
+import Baz
=====================================
testsuite/tests/driver/T26551.stderr
=====================================
@@ -0,0 +1,11 @@
+T26551.hs:3:8: [GHC-87110]
+ Could not find module ‘Foo’.
+ Use -v to see a list of the files searched for.
+
+T26551.hs:4:8: [GHC-87110]
+ Could not find module ‘Bar’.
+ Use -v to see a list of the files searched for.
+
+T26551.hs:5:8: [GHC-87110]
+ Could not find module ‘Baz’.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -332,3 +332,4 @@ test('t25150', [extra_files(["t25150"])], multimod_compile, ['Main.hs', '-v0 -wo
test('T25382', normal, makefile_test, [])
test('T26018', req_c, makefile_test, [])
test('T24120', normal, compile, ['-Wunused-packages -hide-all-packages -package base -package system-cxx-std-lib'])
+test('T26551', [extra_files(['T26551.hs'])], makefile_test, [])
=====================================
testsuite/tests/indexed-types/should_fail/T21092.hs
=====================================
@@ -7,3 +7,5 @@ type family F a
type instance F Type = Int
type instance F Constraint = Bool
+
+-- Nov 2025: Type and Constraint are now Apart (#24279)
=====================================
testsuite/tests/indexed-types/should_fail/T21092.stderr deleted
=====================================
@@ -1,5 +0,0 @@
-
-T21092.hs:8:15: error: [GHC-34447]
- Conflicting family instance declarations:
- F (*) = Int -- Defined at T21092.hs:8:15
- F Constraint = Bool -- Defined at T21092.hs:9:15
=====================================
testsuite/tests/indexed-types/should_fail/all.T
=====================================
@@ -107,7 +107,7 @@ test('T8368', normal, compile_fail, [''])
test('T8368a', normal, compile_fail, [''])
test('T8518', normal, compile_fail, [''])
test('T9036', normal, compile_fail, [''])
-test('T21092', normal, compile_fail, [''])
+test('T21092', normal, compile, ['']) # Now compiles fine
test('T9167', normal, compile_fail, [''])
test('T9171', normal, compile_fail, [''])
test('T9097', normal, compile_fail, [''])
=====================================
testsuite/tests/typecheck/should_fail/T24279.hs
=====================================
@@ -13,7 +13,7 @@ type G :: Type -> RuntimeRep -> Type
type family G a where
G (a b) = a
--- Should be rejected
+-- Now (Nov 2025) accepted
foo :: (F (G Constraint)) -> Bool
foo x = x
@@ -22,10 +22,10 @@ type family H a b where
H a a = Int
H a b = Bool
--- Should be rejected
-bar1 :: H TYPE CONSTRAINT -> Int
+-- Now (Nov 2025) accepted
+bar1 :: H TYPE CONSTRAINT -> Bool
bar1 x = x
--- Should be rejected
-bar2 :: H Type Constraint -> Int
+-- Now (Nov 2025) accepted
+bar2 :: H Type Constraint -> Bool
bar2 x = x
=====================================
testsuite/tests/typecheck/should_fail/T24279.stderr deleted
=====================================
@@ -1,19 +0,0 @@
-
-T24279.hs:18:9: error: [GHC-83865]
- • Couldn't match type ‘F CONSTRAINT’ with ‘Bool’
- Expected: Bool
- Actual: F (G Constraint)
- • In the expression: x
- In an equation for ‘foo’: foo x = x
-
-T24279.hs:27:10: error: [GHC-83865]
- • Couldn't match expected type ‘Int’
- with actual type ‘H TYPE CONSTRAINT’
- • In the expression: x
- In an equation for ‘bar1’: bar1 x = x
-
-T24279.hs:31:10: error: [GHC-83865]
- • Couldn't match expected type ‘Int’
- with actual type ‘H (*) Constraint’
- • In the expression: x
- In an equation for ‘bar2’: bar2 x = x
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -718,7 +718,7 @@ test('T24064', normal, compile_fail, [''])
test('T24090a', normal, compile_fail, [''])
test('T24090b', normal, compile, ['']) # scheduled to become an actual error in GHC 9.16
test('T24298', normal, compile_fail, [''])
-test('T24279', normal, compile_fail, [''])
+test('T24279', normal, compile, ['']) # Now accepted (Nov 2025)
test('T24318', normal, compile_fail, [''])
# all the various do expansion fail messages
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a604dd877075ec803abb2f0f286905…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a604dd877075ec803abb2f0f286905…
You're receiving this email because of your account on gitlab.haskell.org.
1
0