[Git][ghc/ghc] Pushed new branch wip/andreask/ww_cbv_docs
by Andreas Klebinger (@AndreasK) 04 Mar '26
by Andreas Klebinger (@AndreasK) 04 Mar '26
04 Mar '26
Andreas Klebinger pushed new branch wip/andreask/ww_cbv_docs at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/ww_cbv_docs
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/linkable-usage] Record `LinkableUsage` instead of `Linkable` in `LoaderState`
by Hannes Siebenhandl (@fendor) 04 Mar '26
by Hannes Siebenhandl (@fendor) 04 Mar '26
04 Mar '26
Hannes Siebenhandl pushed to branch wip/fendor/linkable-usage at Glasgow Haskell Compiler / GHC
Commits:
884dba21 by fendor at 2026-03-04T14:34:09+01:00
Record `LinkableUsage` instead of `Linkable` in `LoaderState`
Retaining a ByteCode `Linkable` after it has been loaded retains its
`UnlinkedBCO`, keeping it alive for the remainder of the program.
This starts accumulating a lot of `UnlinkedBCO` and memory over time.
However, the `Linkable` is merely used to later record its usage in
`mkObjectUsage`, which is used for recompilation checking.
However, this is incorrect, as the interface file and bytecode objects
could be in different states, e.g. the interface changes, but the
bytecode library hasn't changed so we don't need to recompile and vice
versa.
By computing a `Fingerprint` for the `ModuleByteCode`, and recording it
in the `LinkableUsage`, we know precisely whether the `ByteCode` object
on disk is outdated.
Thus, parts of this commit just makes sure that we efficiently compute a
`Fingerprint` for `ModuleByteCode` and store it in the on-disk
representation of `ModuleByteCode`.
We change the `LoaderState` to retain `LinkableUsage`, which is smaller
representation of a `Linkable`. This allows us to free the unneeded
fields of `Linkable` after linking them.
We declare the following memory invariants that this commit implements:
* No `LinkablePart` should be retained from `LoaderState`.
* `Linkable`s should be unloaded after they have been loaded.
These invariants are unfortunately tricky to automatically uphold, so we
are simply documenting our assumptions for now.
-------------------------
Metric Increase:
MultiLayerModulesTH_OneShot
-------------------------
We allocate a bit more, but the peak number of bytes doesn't change.
While a bit unfortunate, accepting the metric increase.
We add multiple new performance measurements where we were able to
observe the desired memory invariants. Further, we add regression tests
to validate that the recompilation checker behaves more correct than
before.
- - - - -
32 changed files:
- + compiler/GHC/ByteCode/Binary.hs
- + compiler/GHC/ByteCode/Recomp/Binary.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Driver/Hooks.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Recomp/Types.hs
- compiler/GHC/Linker/ByteCode.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Unit/Home/ModInfo.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/Status.hs
- compiler/GHC/Utils/Binary.hs
- compiler/ghc.cabal.in
- ghc/GHCi/Leak.hs
- + testsuite/ghc-config/ghc-config
- + testsuite/tests/bytecode/TLinkable/Makefile
- + testsuite/tests/bytecode/TLinkable/all.T
- + testsuite/tests/bytecode/TLinkable/genSplices
- + testsuite/tests/bytecode/TLinkable/genSplices2
- + testsuite/tests/bytecode/TLinkable/linkable_bytecodelib.stdout
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/884dba21c5f56e71ce2e7fa59737f2b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/884dba21c5f56e71ce2e7fa59737f2b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/andreask/inlineable_docs
by Andreas Klebinger (@AndreasK) 04 Mar '26
by Andreas Klebinger (@AndreasK) 04 Mar '26
04 Mar '26
Andreas Klebinger pushed new branch wip/andreask/inlineable_docs at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/inlineable_docs
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/io-manager-deadlock-detection] FIXUP: Make the IOManager API use CapIOManager rather than Capability
by Duncan Coutts (@dcoutts) 04 Mar '26
by Duncan Coutts (@dcoutts) 04 Mar '26
04 Mar '26
Duncan Coutts pushed to branch wip/io-manager-deadlock-detection at Glasgow Haskell Compiler / GHC
Commits:
ac791614 by Duncan Coutts at 2026-03-04T10:58:13+00:00
FIXUP: Make the IOManager API use CapIOManager rather than Capability
We had updated the type of appendToIOBlockedQueue, but had not updated
the CMM call sites.
It makes one realise that sometimes C's primitive type system is useful!
- - - - -
1 changed file:
- rts/PrimOps.cmm
Changes:
=====================================
rts/PrimOps.cmm
=====================================
@@ -2351,7 +2351,8 @@ stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf )
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32);
%release StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I32;
- ccall appendToIOBlockedQueue(MyCapability() "ptr", CurrentTSO "ptr");
+ ccall appendToIOBlockedQueue(Capability_iomgr(MyCapability()) "ptr",
+ CurrentTSO "ptr");
jump stg_block_async();
#endif
}
@@ -2377,7 +2378,8 @@ stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf )
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32);
%release StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I32;
- ccall appendToIOBlockedQueue(MyCapability() "ptr", CurrentTSO "ptr");
+ ccall appendToIOBlockedQueue(Capability_iomgr(MyCapability()) "ptr",
+ CurrentTSO "ptr");
jump stg_block_async();
#endif
}
@@ -2403,7 +2405,8 @@ stg_asyncDoProczh ( W_ proc, W_ param )
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32);
%release StgTSO_why_blocked(CurrentTSO) = BlockedOnDoProc::I32;
- ccall appendToIOBlockedQueue(MyCapability() "ptr", CurrentTSO "ptr");
+ ccall appendToIOBlockedQueue(Capability_iomgr(MyCapability()) "ptr",
+ CurrentTSO "ptr");
jump stg_block_async();
#endif
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac79161475ca41f462e6b1ff66e6410…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac79161475ca41f462e6b1ff66e6410…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Fix determinism of linker arguments
by Marge Bot (@marge-bot) 04 Mar '26
by Marge Bot (@marge-bot) 04 Mar '26
04 Mar '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
84b66b4d by Ilias Tsitsimpis at 2026-03-04T02:38:57-05:00
Fix determinism of linker arguments
The switch from Data.Map to UniqMap in 3b5be05ac29 introduced
non-determinism in the order of packages passed to the linker.
This resulted in non-reproducible builds where the DT_NEEDED entries in
dynamic libraries were ordered differently across builds.
Fix the regression by explicitly sorting the package list derived from
UniqMap.
Fixes #26838
- - - - -
07dac97f by Matthew Pickering at 2026-03-04T02:38:58-05:00
determinism: Use a deterministic renaming when writing bytecode files
Now when writing the bytecode file, a counter and substitution are used
to provide deterministic keys to local variables (rather than relying on
uniques). This change ensures that `.gbc` are produced
deterministically.
Fixes #26499
- - - - -
5919ed75 by Teo Camarasu at 2026-03-04T02:39:00-05:00
ghc-internal: delete Version hs-boot loop
Version has a Read instance which needs Unicode but part of the Unicode interface is the unicode version. This is easy to resolve. We simply don't re-export the version from the Unicode module.
Resolves #26940
- - - - -
ed4663ec by Wolfgang Jeltsch at 2026-03-04T02:39:02-05:00
Remove in-package dependencies on `GHC.Internal.System.IO`
This contribution eliminates all dependencies on
`GHC.Internal.System.IO` from within `ghc-internal`. It comprises the
following changes:
* Make `GHC.Internal.Fingerprint` independent of I/O support
* Tighten the dependencies of `GHC.Internal.Data.Version`
* Tighten the dependencies of `GHC.Internal.TH.Monad`
* Tighten the dependencies of `GHCi.Helpers`
* Move some code that needs `System.IO` to `template-haskell`
* Move the `GHC.ResponseFile` implementation into `base`
* Move the `System.Exit` implementation into `base`
* Move the `System.IO.OS` implementation into `base`
Metric Decrease:
size_hello_artifact
size_hello_artifact_gzip
size_hello_unicode
size_hello_unicode_gzip
- - - - -
64fa6d67 by Sylvain Henry at 2026-03-04T02:39:09-05:00
Linker: implement support for COMMON symbols (#6107)
Add some support for COMMON symbols. We don't support common symbols
having different sizes where the larger one is allocated after the
smaller one. The linker will fail with an appropriate error message if
it happens.
- - - - -
698647cb by Cheng Shao at 2026-03-04T02:39:10-05:00
compiler: fix redundant import of GHC.Hs.Lit
This patch removes a redundant import of `GHC.Hs.Lit` which causes a
ghc build failure with validate flavours when bootstrapping from 9.14.
Fixes #26972.
- - - - -
3e101535 by Cheng Shao at 2026-03-04T02:39:11-05:00
compiler: avoid unneeded traversals in GHC.Unit.State
Following !15591, this patch avoids unneeded traversals in
`reportCycles`/`reportUnusable` when log verbosity is below given
threshold. Also applies `logVerbAtLeast` when appropriate.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
12075109 by Cheng Shao at 2026-03-04T02:39:12-05:00
ghc-internal: fix redundant import in GHC.Internal.Event.Windows.ManagedThreadPool
This patch fixes redundant import in
`GHC.Internal.Event.Windows.ManagedThreadPool` that causes a
compilation error when building windows target with validate flavours
and bootstrapping from 9.14. Fixes #26976.
- - - - -
35 changed files:
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Utils/Error.hs
- libraries/base/src/GHC/Fingerprint.hs
- libraries/base/src/GHC/ResponseFile.hs
- libraries/base/src/GHC/Unicode.hs
- libraries/base/src/System/Exit.hs
- libraries/base/src/System/IO/OS.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- − libraries/ghc-internal/src/GHC/Internal/Data/Version.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- − libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs
- − libraries/ghc-internal/src/GHC/Internal/System/Exit.hs
- − libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Version.hs
- libraries/ghc-internal/tools/ucd2haskell/exe/UCD2Haskell/ModuleGenerators.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- rts/Linker.c
- rts/LinkerInternals.h
- rts/linker/Elf.c
- rts/linker/MachO.c
- rts/linker/PEi386.c
- testsuite/tests/rts/linker/Makefile
- + testsuite/tests/rts/linker/T6107.hs
- + testsuite/tests/rts/linker/T6107.stdout
- + testsuite/tests/rts/linker/T6107_sym1.s
- + testsuite/tests/rts/linker/T6107_sym2.s
- testsuite/tests/rts/linker/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/055d865255ec949fb2bcfbfad9c1a1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/055d865255ec949fb2bcfbfad9c1a1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/backports-9.12.4] 6 commits: Fix a horrible shadowing bug in implicit parameters
by Zubin (@wz1000) 04 Mar '26
by Zubin (@wz1000) 04 Mar '26
04 Mar '26
Zubin pushed to branch wip/backports-9.12.4 at Glasgow Haskell Compiler / GHC
Commits:
451c6a43 by Simon Peyton Jones at 2026-03-04T12:15:09+05:30
Fix a horrible shadowing bug in implicit parameters
Fixes #26451. The change is in GHC.Tc.Solver.Monad.updInertDicts
where we now do /not/ delete /Wanted/ implicit-parameeter constraints.
This bug has been in GHC since 9.8! But it's quite hard to provoke;
I contructed a tests in T26451, but it was hard to do so.
(cherry picked from commit c052c724d2dfc994994b6548545836969aee8ed8)
- - - - -
85b0aae2 by Simon Peyton Jones at 2026-03-04T12:15:09+05:30
Fix subtle bug in GHC.Core.Utils.mkTick
This patch fixes a decade-old bug in `mkTick`, which
could generate type-incorrect code! See the diagnosis
in #26772.
The new code is simpler and easier to understand.
(As #26772 says, I think it could be improved further.)
(cherry picked from commit cbe4300ef586c8bee1800426624db12e0237c6b5)
- - - - -
55885e4b by Simon Peyton Jones at 2026-03-04T12:15:09+05:30
Fix long-standing interaction between ticks and casts
The code for Note [Eliminate Identity Cases] was simply wrong when
ticks and casts interacted. This patch fixes the interaction.
It was shown up when validating #26772, although it's not the exactly
the bug that's reported by #26772. Nor is it easy to reproduce, hence
no regression test.
(cherry picked from commit b579dfdc614e288b0fd754ac69ae7ff723d808be)
- - - - -
4fdab7ca by sheaf at 2026-03-04T12:15:09+05:30
NamedDefaults: require the class to be standard
We now only default type variables if they only appear in constraints
of the form `C v`, where `C` is either a standard class or a class with
an in-scope default declaration.
This rectifies an oversight in the original implementation of the
NamedDefault extensions that was remarked in #25775; that implementation
allowed type variables to appear in unary constraints which had arbitrary
classes at the head.
See the rewritten Note [How type-class constraints are defaulted] for
details of the implementation.
Fixes #25775
Fixes #25778
(cherry picked from commit f1acdd2c2b664ad0bdcaae4064b50e84aa7bc599)
- - - - -
cfbec95d by Rodrigo Mesquita at 2026-03-04T12:15:09+05:30
bytecode: Use 32bits for breakpoint index
Fixes #26325
(cherry picked from commit e368e24779f8a7bf110a025383db23521b313407)
- - - - -
7d22504b by Zubin Duggal at 2026-03-04T12:15:44+05:30
Prepare release 9.12.4
- - - - -
21 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Types/DefaultEnv.hs
- + docs/users_guide/9.12.4-notes.rst
- docs/users_guide/release-notes.rst
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- rts/Disassembler.c
- rts/Interpreter.c
- + testsuite/tests/default/T25775.hs
- + testsuite/tests/default/T25775.stderr
- testsuite/tests/default/all.T
- + testsuite/tests/typecheck/should_compile/T26451.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T12921.stderr
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -660,9 +660,22 @@ assembleI platform i = case i of
tick_addr <- addr tick_mod
info_addr <- addr info_mod
np <- addr cc
+ let -- cast that checks that round-tripping through
+ -- Word32 doesn't change the value
+ toW32 x = let r = fromIntegral x :: Word32
+ in if fromIntegral r == x
+ then r
+ else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
+ tick32 = toW32 tickx
+ tick_hi = fromIntegral (tick32 `shiftR` 16)
+ tick_lo = fromIntegral (tick32 .&. 0xffff)
+ info32 = toW32 infox
+ info_hi = fromIntegral (info32 `shiftR` 16)
+ info_lo = fromIntegral (info32 .&. 0xffff)
emit bci_BRK_FUN [ Op p1
, Op tick_addr, Op info_addr
- , SmallOp tickx, SmallOp infox
+ , SmallOp tick_hi, SmallOp tick_lo
+ , SmallOp info_hi, SmallOp info_lo
, Op np
]
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -1731,6 +1731,7 @@ simplCast env body co0 cont0
, sc_hole_ty = coercionLKind co }) }
-- NB! As the cast goes past, the
-- type of the hole changes (#16312)
+
-- (f |> co) e ===> (f (e |> co1)) |> co2
-- where co :: (s1->s2) ~ (t1->t2)
-- co1 :: t1 ~ s1
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -73,6 +73,7 @@ import GHC.Types.Tickish
import GHC.Types.Demand
import GHC.Types.Var.Set
import GHC.Types.Basic
+import GHC.Types.Name.Env
import GHC.Data.OrdList ( isNilOL )
import GHC.Data.FastString ( fsLit )
@@ -82,9 +83,9 @@ import GHC.Utils.Monad
import GHC.Utils.Outputable
import GHC.Utils.Panic
-import Control.Monad ( when )
+import Control.Monad ( guard, when )
import Data.List ( sortBy )
-import GHC.Types.Name.Env
+import Data.Maybe
import Data.Graph
{- *********************************************************************
@@ -2471,7 +2472,27 @@ Note [Eliminate Identity Case]
True -> True;
False -> False
-and similar friends.
+and similar friends. There are some tricky wrinkles:
+
+(EIC1) Casts. We've seen this:
+ case e of x { _ -> x `cast` c }
+ And we definitely want to eliminate this case, to give
+ e `cast` c
+(EIC2) Ticks. Similarly
+ case e of x { _ -> Tick t x }
+ At least if the tick is 'floatable' we want to eliminate the case
+ to give
+ Tick t e
+
+So `check_eq` strips off enclosing casts and ticks from the RHS of the
+alternative, returning a wrapper function that will rebuild them around
+the scrutinee if case-elim is successful.
+
+(EIC3) What if there are many alternatives, all identities. If casts
+ are involved they must be the same cast, to make the types line up.
+ In principle there could be different ticks in each RHS, but we just
+ pick the ticks from the first alternative. (In the common case there
+ is only one alternative.)
Note [Scrutinee Constant Folding]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2665,45 +2686,47 @@ mkCase mode scrut outer_bndr alts_ty alts
-- See Note [Eliminate Identity Case]
--------------------------------------------------
-mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : alts') -- Identity case
- | all identity_alt alts
+mkCase1 _mode scrut case_bndr _ (alt1 : alts) -- Identity case
+ | Just wrap <- identity_alt alt1 -- `wrap`: see (EIC1) and (EIC2)
+ , all (isJust . identity_alt) alts -- See (EIC3) in Note [Eliminate Identity Case]
= do { tick (CaseIdentity case_bndr)
- ; return (mkTicks ticks $ re_cast scrut rhs1) }
+ ; return (wrap scrut) }
where
- ticks = concatMap (\(Alt _ _ rhs) -> stripTicksT tickishFloatable rhs) alts'
- identity_alt (Alt con args rhs) = check_eq rhs con args
-
- check_eq (Cast rhs co) con args -- See Note [RHS casts]
- = not (any (`elemVarSet` tyCoVarsOfCo co) args) && check_eq rhs con args
- check_eq (Tick t e) alt args
- = tickishFloatable t && check_eq e alt args
-
- check_eq (Lit lit) (LitAlt lit') _ = lit == lit'
- check_eq (Var v) _ _ | v == case_bndr = True
- check_eq (Var v) (DataAlt con) args
- | null arg_tys, null args = v == dataConWorkId con
- -- Optimisation only
- check_eq rhs (DataAlt con) args = cheapEqExpr' tickishFloatable rhs $
- mkConApp2 con arg_tys args
- check_eq _ _ _ = False
+ identity_alt :: CoreAlt -> Maybe (CoreExpr -> CoreExpr)
+ identity_alt (Alt con args rhs) = check_eq con args rhs
+
+ check_eq :: AltCon -> [Var] -> CoreExpr -> Maybe (CoreExpr -> CoreExpr)
+ -- (check_eq con args e) return True if
+ -- e looks like (Tick (Cast (Tick (con args))))
+ -- where (con args) is the LHS of the alternative
+ -- In that case it returns (\e. Tick (Cast (Tick e))),
+ -- a wrapper function that can rebuild the tick/cast stuff
+ -- See (EIC1) and (EIC2) in Note [Eliminate Identity Case]
+ check_eq alt_con args (Cast e co) -- See (EIC1)
+ = do { guard (not (any (`elemVarSet` tyCoVarsOfCo co) args))
+ ; wrap <- check_eq alt_con args e
+ ; return (flip mkCast co . wrap) }
+ check_eq alt_con args (Tick t e) -- See (EIC2)
+ = do { guard (tickishFloatable t)
+ ; wrap <- check_eq alt_con args e
+ ; return (Tick t . wrap) }
+ check_eq alt_con args e
+ | is_id alt_con args e = Just (\e -> e)
+ | otherwise = Nothing
+
+ is_id :: AltCon -> [Var] -> CoreExpr -> Bool
+ is_id _ _ (Var v) | v == case_bndr = True
+ is_id (LitAlt lit') _ (Lit lit) = lit == lit'
+ is_id (DataAlt con) args rhs
+ | Var v <- rhs -- Optimisation only
+ , null arg_tys
+ , null args = v == dataConWorkId con
+ | otherwise = cheapEqExpr' tickishFloatable rhs $
+ mkConApp2 con arg_tys args
+ is_id _ _ _ = False
arg_tys = tyConAppArgs (idType case_bndr)
- -- Note [RHS casts]
- -- ~~~~~~~~~~~~~~~~
- -- We've seen this:
- -- case e of x { _ -> x `cast` c }
- -- And we definitely want to eliminate this case, to give
- -- e `cast` c
- -- So we throw away the cast from the RHS, and reconstruct
- -- it at the other end. All the RHS casts must be the same
- -- if (all identity_alt alts) holds.
- --
- -- Don't worry about nested casts, because the simplifier combines them
-
- re_cast scrut (Cast rhs co) = Cast (re_cast scrut rhs) co
- re_cast scrut _ = scrut
-
mkCase1 mode scrut bndr alts_ty alts = mkCase2 mode scrut bndr alts_ty alts
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -251,7 +251,7 @@ applyTypeToArgs pp_e op_ty args
mkCastMCo :: CoreExpr -> MCoercionR -> CoreExpr
mkCastMCo e MRefl = e
-mkCastMCo e (MCo co) = Cast e co
+mkCastMCo e (MCo co) = mkCast e co
-- We are careful to use (MCo co) only when co is not reflexive
-- Hence (Cast e co) rather than (mkCast e co)
@@ -302,40 +302,41 @@ mkCast expr co
-- | Wraps the given expression in the source annotation, dropping the
-- annotation if possible.
mkTick :: CoreTickish -> CoreExpr -> CoreExpr
-mkTick t orig_expr = mkTick' id id orig_expr
+mkTick t orig_expr = mkTick' id orig_expr
where
-- Some ticks (cost-centres) can be split in two, with the
-- non-counting part having laxer placement properties.
canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t
+
-- mkTick' handles floating of ticks *into* the expression.
- -- In this function, `top` is applied after adding the tick, and `rest` before.
- -- This will result in applications that look like (top $ Tick t $ rest expr).
- -- If we want to push the tick deeper, we pre-compose `top` with a function
- -- adding the tick.
- mkTick' :: (CoreExpr -> CoreExpr) -- apply after adding tick (float through)
- -> (CoreExpr -> CoreExpr) -- apply before adding tick (float with)
- -> CoreExpr -- current expression
+ mkTick' :: (CoreExpr -> CoreExpr) -- Apply before adding tick (float with)
+ -- Always a composition of (Tick t) wrappers
+ -> CoreExpr -- Current expression
-> CoreExpr
- mkTick' top rest expr = case expr of
+ -- So in the call (mkTick' rest e), the expression
+ -- (rest e)
+ -- has the same type as e
+ -- Returns an expression equivalent to (Tick t (rest e))
+ mkTick' rest expr = case expr of
-- Float ticks into unsafe coerce the same way we would do with a cast.
Case scrut bndr ty alts@[Alt ac abs _rhs]
| Just rhs <- isUnsafeEqualityCase scrut bndr alts
- -> top $ mkTick' (\e -> Case scrut bndr ty [Alt ac abs e]) rest rhs
+ -> Case scrut bndr ty [Alt ac abs (mkTick' rest rhs)]
-- Cost centre ticks should never be reordered relative to each
-- other. Therefore we can stop whenever two collide.
Tick t2 e
- | ProfNote{} <- t2, ProfNote{} <- t -> top $ Tick t $ rest expr
+ | ProfNote{} <- t2, ProfNote{} <- t -> Tick t $ rest expr
-- Otherwise we assume that ticks of different placements float
-- through each other.
- | tickishPlace t2 /= tickishPlace t -> mkTick' (top . Tick t2) rest e
+ | tickishPlace t2 /= tickishPlace t -> Tick t2 $ mkTick' rest e
-- For annotations this is where we make sure to not introduce
-- redundant ticks.
- | tickishContains t t2 -> mkTick' top rest e
- | tickishContains t2 t -> orig_expr
- | otherwise -> mkTick' top (rest . Tick t2) e
+ | tickishContains t t2 -> mkTick' rest e -- Drop t2
+ | tickishContains t2 t -> rest e -- Drop t
+ | otherwise -> mkTick' (rest . Tick t2) e
-- Ticks don't care about types, so we just float all ticks
-- through them. Note that it's not enough to check for these
@@ -343,14 +344,14 @@ mkTick t orig_expr = mkTick' id id orig_expr
-- expressions below ticks, such constructs can be the result of
-- unfoldings. We therefore make an effort to put everything into
-- the right place no matter what we start with.
- Cast e co -> mkTick' (top . flip Cast co) rest e
- Coercion co -> Coercion co
+ Cast e co -> mkCast (mkTick' rest e) co
+ Coercion co -> Tick t $ rest (Coercion co)
Lam x e
-- Always float through type lambdas. Even for non-type lambdas,
-- floating is allowed for all but the most strict placement rule.
| not (isRuntimeVar x) || tickishPlace t /= PlaceRuntime
- -> mkTick' (top . Lam x) rest e
+ -> Lam x $ mkTick' rest e
-- If it is both counting and scoped, we split the tick into its
-- two components, often allowing us to keep the counting tick on
@@ -359,25 +360,25 @@ mkTick t orig_expr = mkTick' id id orig_expr
-- floated, and the lambda may then be in a position to be
-- beta-reduced.
| canSplit
- -> top $ Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e
+ -> Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e
App f arg
-- Always float through type applications.
| not (isRuntimeArg arg)
- -> mkTick' (top . flip App arg) rest f
+ -> App (mkTick' rest f) arg
-- We can also float through constructor applications, placement
-- permitting. Again we can split.
| isSaturatedConApp expr && (tickishPlace t==PlaceCostCentre || canSplit)
-> if tickishPlace t == PlaceCostCentre
- then top $ rest $ tickHNFArgs t expr
- else top $ Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr
+ then rest $ tickHNFArgs t expr
+ else Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr
Var x
| notFunction && tickishPlace t == PlaceCostCentre
- -> orig_expr
+ -> rest expr -- Drop t
| notFunction && canSplit
- -> top $ Tick (mkNoScope t) $ rest expr
+ -> Tick (mkNoScope t) $ rest expr
where
-- SCCs can be eliminated on variables provided the variable
-- is not a function. In these cases the SCC makes no difference:
@@ -389,10 +390,10 @@ mkTick t orig_expr = mkTick' id id orig_expr
Lit{}
| tickishPlace t == PlaceCostCentre
- -> orig_expr
+ -> rest expr -- Drop t
-- Catch-all: Annotate where we stand
- _any -> top $ Tick t $ rest expr
+ _any -> Tick t $ rest expr
mkTicks :: [CoreTickish] -> CoreExpr -> CoreExpr
mkTicks ticks expr = foldr mkTick expr ticks
=====================================
compiler/GHC/Tc/Instance/Class.hs
=====================================
@@ -47,6 +47,7 @@ import GHC.Core.Make ( mkCharExpr, mkNaturalExpr, mkStringExprFS, mkCoreLams )
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Core.Class
+import GHC.Core.Utils( mkCast )
import GHC.Core ( Expr(..) )
@@ -456,7 +457,7 @@ matchWithDict [cls, mty]
mkCoreLams [ runtimeRep1TyVar, openAlphaTyVar, sv, k ] $
Var k
`App`
- (Var sv `Cast` mkTransCo (mkSubCo co2) (mkSymCo co))
+ (Var sv `mkCast` mkTransCo (mkSubCo co2) (mkSymCo co))
; tc <- tcLookupTyCon withDictClassName
; let Just withdict_data_con
@@ -935,7 +936,7 @@ matchDataToTag dataToTagClass [levity, dty] = do
dataToTagDataCon = tyConSingleDataCon (classTyCon dataToTagClass)
mk_ev _ = evDataConApp dataToTagDataCon
[levity, dty]
- [methodRep `Cast` methodCo]
+ [methodRep `mkCast` methodCo]
-> addUsedDataCons rdr_env repTyCon -- See wrinkles DTW2 and DTW3
$> OneInst { cir_new_theta = [] -- (Ignore stupid theta.)
, cir_mk_ev = mk_ev
=====================================
compiler/GHC/Tc/Solver.hs
=====================================
@@ -93,7 +93,7 @@ import Control.Monad
import Control.Monad.Trans.Class ( lift )
import Control.Monad.Trans.State.Strict ( StateT(runStateT), put )
import Data.Foldable ( toList, traverse_ )
-import Data.List ( partition, intersect )
+import Data.List ( partition )
import Data.List.NonEmpty ( NonEmpty(..), nonEmpty )
import qualified Data.List.NonEmpty as NE
import GHC.Data.Maybe ( isJust, mapMaybe, catMaybes )
@@ -3755,32 +3755,74 @@ Type-class defaulting deals with the situation where we have unsolved
constraints like (Num alpha), where `alpha` is a unification variable. We want
to pick a default for `alpha`, such as `alpha := Int` to resolve the ambiguity.
-Type-class defaulting is guided by the `DefaultEnv`: see Note [Named default declarations]
-in GHC.Tc.Gen.Default
+The function 'tryTypeClassDefaulting' implements type-class defaulting. The
+algorithm for defaulting depends on whether certain extensions are enabled,
+such as -XOverloadedStrings or -XExtendedDefaultRules. To explain this, let us
+define the following:
-The entry point for defaulting the unsolved constraints is `applyDefaultingRules`,
-which depends on `disambigGroup`, which in turn depends on workhorse
-`disambigProposalSequences`. The latter is also used by defaulting plugins through
-`disambigMultiGroup` (see Note [Defaulting plugins] below).
+ Unary typeclass:
+ a typeclass with a single visible type argument.
-The algorithm works as follows. Let S be the complete set of unsolved
-constraints, and initialize Sx to an empty set of constraints. For every type
-variable `v` that is free in S:
+ Examples:
-1. Define Cv = { Ci v | Ci v ∈ S }, the subset of S consisting of all constraints in S of
- form (Ci v), where Ci is a single-parameter type class. (We do no defaulting for
- multi-parameter type classes.)
+ Num :: Type -> Constraint
+ Eq :: Type -> Constraint
+ Foldable :: (Type -> Type) -> Constraint
+ Typeable :: forall k. k -> Constraint -- NB: also has an /invisible/ argument
-2. Define Dv, by extending Cv with the superclasses of every Ci in Cv
+ Non-examples:
-3. Define Ev, by filtering Dv to contain only classes with a default declaration.
+ Nullary :: Constraint
+ Binary :: Type -> Type -> Constraint
+ Binary2 :: forall k -> k -> Constraint -- Two visible arguments
-4. For each Ci in Ev, if Ci has a non-empty default list in the `DefaultEnv`, find the first
- type T in the default list for Ci for which, for every (Ci v) in Cv, the constraint (Ci T)
- is soluble.
+ Defaultable class
+ a typeclass which has at least one in-scope default declaration
-5. If there is precisely one type T in the resulting type set, resolve the ambiguity by adding
- a constraint (v~ Ti) constraint to a set Sx; otherwise report a static error.
+ This includes the two different categories of default declarations:
+
+ - Haskell 98 default declarations such as 'default (Integer, Float)'.
+
+ - `Num` is always defaultable; either the user says 'default( Integer, Float )'
+ or (absent such a declaration) the system fills in a fallback default declaration.
+ See Section 4.3.4 in https://www.haskell.org/onlinereport/haskell2010/haskellch4.html
+
+ - With `OverloadedStrings`, the class `IsString` is defaultable
+ - With `ExtendedDefaultRules`, the classes `Show`, `Eq`, `Ord`, `Foldable` and `Traversable`
+ are defaultable
+
+ - Named default declarations, which apply to the named class, e.g.
+ 'default Cls(X, Y)' applies precisely to 'Cls'.
+ Note that these may be locally defined, or they may be imported.
+
+ Standard class:
+ a class defined in the Prelude or the standard library, as defined
+ by the Haskell 98 report (section 4.3.4)
+
+ These are defined in GHC.Builtin.Names.standardClassKeys.
+
+The rules for defaulting a collection 'S' of unsolved constraints are as follows:
+
+ 1. For each metavariable 'v' appearing in 'S', define
+
+ U_v = { C v | C v ∈ U, C is a unary typeclass }
+
+ We then process each 'U_v' in turn, in order to find a defaulting
+ assignment 'v := ty' that solves all of 'U_v'.
+
+ 2. Unless -XExtendedDefaultRules is in effect, give up if 'v' appears:
+
+ - in any constraint that isn't a unary class constraint
+ - in a class constraint which is non-standard and does not have
+ a default declaration in scope.
+
+ 3. Compute candidate assignments: for each unary typeclass 'C' in 'U_v' which
+ has a default declaration in scope, find the first type 'ty' in the list
+ of in-scope default types for 'C' for which all of 'U_v' is soluble.
+
+ 4. If there is precisely one type candidate type assignment 'ty' that allows
+ all of 'U_v' to be solved, we default 'v := ty'. Otherwise, do nothing
+ ('v' remains ambiguous).
Note [Defaulting plugins]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -3919,8 +3961,8 @@ findDefaultableGroups (default_tys, extended_defaults) wanteds
-- Finds unary type-class constraints
-- But take account of polykinded classes like Typeable,
- -- which may look like (Typeable * (a:*)) (#8931)
- -- step (1) in Note [How type-class constraints are defaulted]
+ -- which may look like (Typeable Type (a:Type)) (#8931)
+ -- See step (1) in Note [How type-class constraints are defaulted]
find_unary :: Ct -> Either (Ct, Class, TyVar) Ct
find_unary cc
| Just (cls,tys) <- getClassPredTys_maybe (ctPred cc)
@@ -3932,21 +3974,42 @@ findDefaultableGroups (default_tys, extended_defaults) wanteds
= Left (cc, cls, tv)
find_unary cc = Right cc -- Non unary or non dictionary
- bad_tvs :: TcTyCoVarSet -- TyVars mentioned by non-unaries
- bad_tvs = mapUnionVarSet tyCoVarsOfCt non_unaries
+ nonunary_tvs :: TcTyCoVarSet -- TyVars mentioned by non-unaries
+ nonunary_tvs = mapUnionVarSet tyCoVarsOfCt non_unaries
cmp_tv (_,_,tv1) (_,_,tv2) = tv1 `compare` tv2
defaultable_tyvar :: TcTyVar -> Bool
defaultable_tyvar tv
= let b1 = isTyConableTyVar tv -- Note [Avoiding spurious errors]
- b2 = not (tv `elemVarSet` bad_tvs)
+ b2 = not (tv `elemVarSet` nonunary_tvs)
in b1 && (b2 || extended_defaults) -- Note [Multi-parameter defaults]
- -- Determines if any of the given type class constructors is in default_tys
- -- step (3) in Note [How type-class constraints are defaulted]
+ -- Determines whether the collection of class constraints permits defaulting.
+ -- See step (2) in Note [How type-class constraints are defaulted]
defaultable_classes :: [Class] -> Bool
- defaultable_classes clss = not . null . intersect clss $ map cd_class default_tys
+ defaultable_classes clss =
+ -- One of the classes has a default declaration in scope
+ -- (this includes 'Num', and e.g. 'IsString' with -XOverloadedStrings)
+ any (`elementOfUniqSet` classes_with_defaults) clss
+ &&
+ -- AND, either:
+ -- - ExtendedDefaultRules is in effect, or
+ -- - all the classes are standard or have a default declaration in scope
+ (extended_defaults || all is_std_or_has_default clss)
+ is_std_or_has_default :: Class -> Bool
+ is_std_or_has_default cls =
+ (getUnique cls `elem` standardClassKeys)
+ ||
+ (cls `elementOfUniqSet` classes_with_defaults)
+
+ -- All classes with a default declaration in scope; either:
+ --
+ -- - a named default declaration such as 'default C(Double, Bool)', or
+ -- - a Haskell 98 default declaration such as 'default(Int, Float)',
+ -- which adds defaults for Num, for IsString with OverloadedStrings,
+ -- and for Foldable/Traversable/... with ExtendedDefaultRules
+ classes_with_defaults = mkUniqSet $ map cd_class default_tys
------------------------------
@@ -3996,14 +4059,14 @@ disambigProposalSequences orig_wanteds wanteds proposalSequences allConsistent
= do { traverse_ (traverse_ reportInvalidDefaultedTyVars . getProposalSequence) proposalSequences
; fake_ev_binds_var <- TcS.newTcEvBinds
; tclvl <- TcS.getTcLevel
- -- Step (4) in Note [How type-class constraints are defaulted]
+ -- Step (3) in Note [How type-class constraints are defaulted]
; successes <- fmap catMaybes $
nestImplicTcS fake_ev_binds_var (pushTcLevel tclvl) $
mapM firstSuccess proposalSequences
; traceTcS "disambigProposalSequences" (vcat [ ppr wanteds
, ppr proposalSequences
, ppr successes ])
- -- Step (5) in Note [How type-class constraints are defaulted]
+ -- Step (4) in Note [How type-class constraints are defaulted]
; case successes of
success@(tvs, subst) : rest
| allConsistent (success :| rest)
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -102,28 +102,53 @@ solveDict dict_ct@(DictCt { di_ev = ev, di_cls = cls, di_tys = tys })
; stopWithStage (dictCtEvidence dict_ct) "Kept inert DictCt" }
updInertDicts :: DictCt -> TcS ()
-updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev, di_tys = tys })
- = do { traceTcS "Adding inert dict" (ppr dict_ct $$ ppr cls <+> ppr tys)
-
- ; if | isGiven ev, Just (str_ty, _) <- isIPPred_maybe cls tys
- -> -- See (SIP1) and (SIP2) in Note [Shadowing of implicit parameters]
- -- Update /both/ inert_cans /and/ inert_solved_dicts.
- updInertSet $ \ inerts@(IS { inert_cans = ics, inert_solved_dicts = solved }) ->
- inerts { inert_cans = updDicts (filterDicts (does_not_mention_ip_for str_ty)) ics
- , inert_solved_dicts = filterDicts (does_not_mention_ip_for str_ty) solved }
- | otherwise
- -> return ()
+updInertDicts dict_ct
+ = do { traceTcS "Adding inert dict" (ppr dict_ct)
+
+ -- For Given implicit parameters (only), delete any existing
+ -- Givens for the same implicit parameter.
+ -- See Note [Shadowing of implicit parameters]
+ ; deleteGivenIPs dict_ct
-- Add the new constraint to the inert set
; updInertCans (updDicts (addDict dict_ct)) }
+
+deleteGivenIPs :: DictCt -> TcS ()
+-- Special magic when adding a Given implicit parameter to the inert set
+-- For [G] ?x::ty, remove any existing /Givens/ mentioning ?x,
+-- from /both/ inert_cans /and/ inert_solved_dicts (#23761)
+-- See Note [Shadowing of implicit parameters]
+deleteGivenIPs (DictCt { di_cls = cls, di_ev = ev, di_tys = tys })
+ | isGiven ev
+ , Just (str_ty, _) <- isIPPred_maybe cls tys
+ = updInertSet $ \ inerts@(IS { inert_cans = ics, inert_solved_dicts = solved }) ->
+ inerts { inert_cans = updDicts (filterDicts (keep_can str_ty)) ics
+ , inert_solved_dicts = filterDicts (keep_solved str_ty) solved }
+ | otherwise
+ = return ()
where
- -- Does this class constraint or any of its superclasses mention
- -- an implicit parameter (?str :: ty) for the given 'str' and any type 'ty'?
- does_not_mention_ip_for :: Type -> DictCt -> Bool
- does_not_mention_ip_for str_ty (DictCt { di_cls = cls, di_tys = tys })
- = not $ mentionsIP (not . typesAreApart str_ty) (const True) cls tys
- -- See Note [Using typesAreApart when calling mentionsIP]
- -- in GHC.Core.Predicate
+ keep_can, keep_solved :: Type -> DictCt -> Bool
+ -- keep_can: we keep an inert dictionary UNLESS
+ -- (1) it is a Given
+ -- (2) it binds an implicit parameter (?str :: ty) for the given 'str'
+ -- regardless of 'ty', possibly via its superclasses
+ -- The test is a bit conservative, hence `mentionsIP` and `typesAreApart`
+ -- See Note [Using typesAreApart when calling mentionsIP]
+ -- in GHC.Core.Predicate
+ --
+ -- keep_solved: same as keep_can, but for /all/ constraints not just Givens
+ --
+ -- Why two functions? See (SIP3) in Note [Shadowing of implicit parameters]
+ keep_can str (DictCt { di_ev = ev, di_cls = cls, di_tys = tys })
+ = not (isGiven ev -- (1)
+ && mentions_ip str cls tys) -- (2)
+ keep_solved str (DictCt { di_cls = cls, di_tys = tys })
+ = not (mentions_ip str cls tys)
+
+ -- mentions_ip: the inert constraint might provide evidence
+ -- for an implicit parameter (?str :: ty) for the given 'str'
+ mentions_ip str cls tys
+ = mentionsIP (not . typesAreApart str) (const True) cls tys
canDictCt :: CtEvidence -> Class -> [Type] -> SolverStage DictCt
-- Once-only processing of Dict constraints:
@@ -220,7 +245,9 @@ in two places:
* In `updInertDicts`, in this module, when adding [G] (?x :: ty), remove any
existing [G] (?x :: ty'), regardless of ty'.
-* Wrinkle (SIP1): we must be careful of superclasses. Consider
+There are wrinkles:
+
+* Wrinkle (SIP1): we must be careful of superclasses (#14218). Consider
f,g :: (?x::Int, C a) => a -> a
f v = let ?x = 4 in g v
@@ -228,24 +255,31 @@ in two places:
We must /not/ solve this from the Given (?x::Int, C a), because of
the intervening binding for (?x::Int). #14218.
- We deal with this by arranging that when we add [G] (?x::ty) we delete
+ We deal with this by arranging that when we add [G] (?x::ty) we /delete/
* from the inert_cans, and
* from the inert_solved_dicts
any existing [G] (?x::ty) /and/ any [G] D tys, where (D tys) has a superclass
with (?x::ty). See Note [Local implicit parameters] in GHC.Core.Predicate.
- An important special case is constraint tuples like [G] (% ?x::ty, Eq a %).
- But it could happen for `class xx => D xx where ...` and the constraint D
- (?x :: int). This corner (constraint-kinded variables instantiated with
- implicit parameter constraints) is not well explored.
+ An very important special case is constraint tuples like [G] (% ?x::ty, Eq a %).
+
+ But it could also happen for `class xx => D xx where ...` and the constraint
+ D (?x :: int); again see Note [Local implicit parameters]. This corner
+ (constraint-kinded variables instantiated with implicit parameter constraints)
+ is not well explored.
- Example in #14218, and #23761
+ You might worry about whether deleting an /entire/ constraint just because
+ a distant superclass has an implicit parameter might make another Wanted for
+ that constraint un-solvable. Indeed so. But for constraint tuples it doesn't
+ matter -- their entire payload is their superclasses. And the other case is
+ the ill-explored corner above.
The code that accounts for (SIP1) is in updInertDicts; in particular the call to
GHC.Core.Predicate.mentionsIP.
* Wrinkle (SIP2): we must apply this update semantics for `inert_solved_dicts`
- as well as `inert_cans`.
+ as well as `inert_cans` (#23761).
+
You might think that wouldn't be necessary, because an element of
`inert_solved_dicts` is never an implicit parameter (see
Note [Solved dictionaries] in GHC.Tc.Solver.InertSet).
@@ -258,6 +292,19 @@ in two places:
Now (C (?x::Int)) has a superclass (?x::Int). This may look exotic, but it
happens particularly for constraint tuples, like `(% ?x::Int, Eq a %)`.
+* Wrinkle (SIP3)
+ - Note that for the inert dictionaries, `inert_cans`, we must /only/ delete
+ existing /Givens/! Deleting an existing Wanted led to #26451; we just never
+ solved it!
+
+ - In contrast, the solved dictionaries, `inert_solved_dicts`, are really like
+ Givens; they may be "inherited" from outer scopes, so we must delete any
+ solved dictionaries for this implicit parameter for /both/ Givens /and/
+ Wanteds.
+
+ Otherwise the new Given doesn't properly shadow those inherited solved
+ dictionaries. Test T23761 showed this up.
+
Example 1:
Suppose we have (typecheck/should_compile/ImplicitParamFDs)
=====================================
compiler/GHC/Tc/Types/Evidence.hs
=====================================
@@ -56,6 +56,7 @@ import GHC.Types.Var
import GHC.Types.Id( idScaledType )
import GHC.Core.Coercion.Axiom
import GHC.Core.Coercion
+import GHC.Core.Utils( mkCast )
import GHC.Core.Ppr () -- Instance OutputableBndr TyVar
import GHC.Tc.Utils.TcType
import GHC.Core.Type
@@ -528,7 +529,7 @@ evCoercion co = EvExpr (Coercion co)
-- | d |> co
evCast :: EvExpr -> TcCoercion -> EvTerm
evCast et tc | isReflCo tc = EvExpr et
- | otherwise = EvExpr (Cast et tc)
+ | otherwise = EvExpr (mkCast et tc)
-- Dictionary instance application
evDFunApp :: DFunId -> [Type] -> [EvExpr] -> EvTerm
=====================================
compiler/GHC/Types/DefaultEnv.hs
=====================================
@@ -31,9 +31,13 @@ import Data.List (sortBy)
import Data.Function (on)
-- See Note [Named default declarations] in GHC.Tc.Gen.Default
+
-- | Default environment mapping class name @Name@ to their default type lists
+--
+-- NB: this includes Haskell98 default declarations, at the 'Num' key.
type DefaultEnv = NameEnv ClassDefaults
+-- | Defaulting type assignments for the given class.
data ClassDefaults
= ClassDefaults { cd_class :: Class -- ^ The class whose defaults are being defined
, cd_types :: [Type]
=====================================
docs/users_guide/9.12.4-notes.rst
=====================================
@@ -0,0 +1,154 @@
+.. _release-9-12-4:
+
+Version 9.12.4
+==============
+
+The significant changes to the various parts of the compiler are listed in the
+following sections. See the `migration guide
+<https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.12>`_ on the GHC Wiki
+for specific guidance on migrating programs to this release.
+
+Compiler
+~~~~~~~~
+
+- Fixed a bug in CSE where the in-scope set was not properly maintained (:ghc-ticket:`25468`)
+- Fixed ``matchExpectedFunTys`` to use ``tcMkScaledFunTys`` (:ghc-ticket:`26277`)
+- Fixed ``parenBreakableList`` usage in ``ppHsContext`` for better pretty-printing of contexts
+- Improved error messages for bad record updates to allow out-of-scope data constructors (:ghc-ticket:`26391`)
+- Fixed a missing InVar->OutVar lookup in ``SetLevels`` (:ghc-ticket:`26681`)
+- Fixed split sections on Windows (:ghc-ticket:`26696`, :ghc-ticket:`26494`)
+- Fixed split sections for the LLVM backend (:ghc-ticket:`26770`)
+- Don't re-use stack slots for growing registers (:ghc-ticket:`26668`)
+- Fixed cast worker/wrapper incorrectly firing on INLINE functions (:ghc-ticket:`26903`)
+- Fixed non-determinism in ``TyLitMap`` by using deterministic maps for strings (:ghc-ticket:`26846`)
+- Fixed non-determinism in ``WithHsDocIdentifiers`` binary instance by using a stable sort (:ghc-ticket:`26858`)
+- Added ``-mcmodel=medium`` module flag to generated LLVM IR on LoongArch
+- Pass the ``mcmodel=medium`` parameter to CC via GHC on LoongArch
+- Pass the ``+evex512`` attribute to LLVM 18+ when ``-mavx512f`` is set (:ghc-ticket:`26410`)
+- Improved error handling in ``getPackageArchives`` (:ghc-ticket:`26383`)
+- Fixed a shadowing bug in implicit parameters (:ghc-ticket:`26451`)
+- Fixed a subtle bug in ``GHC.Core.Utils.mkTick`` that could generate type-incorrect code (:ghc-ticket:`26772`)
+- Fixed a long-standing interaction between ticks and casts in ``Eliminate Identity Cases``
+- ``NamedDefaults``: require the class to be standard or have an in-scope default declaration (:ghc-ticket:`25775`, :ghc-ticket:`25778`)
+
+Runtime System
+~~~~~~~~~~~~~~
+
+- Fixed a deadlock with eventlog flush interval and RTS shutdown (:ghc-ticket:`26573`)
+- Fixed eager black holes: record mutated closure and fix assertion (:ghc-ticket:`26495`)
+- Fixed object file format detection in ``loadArchive`` (:ghc-ticket:`26630`)
+- Use ``INFO_TABLE_CONSTR`` for ``stg_dummy_ret_closure`` (:ghc-ticket:`26745`)
+- Fixed lost wakeups in ``threadPaused`` for threads blocked on black holes (:ghc-ticket:`26324`)
+- Fixed ``stg_AP_STACK`` to push the correct update frame (:ghc-ticket:`26324`)
+- Fixed potential loop in heap reservation logic on certain kernels (:ghc-ticket:`26151`)
+- Don't use CAS without ``PARALLEL_GC`` on
+- Switch prim to use modern atomic compiler builtins (:ghc-ticket:`26729`)
+- Removed obsolete ``CC_SUPPORTS_TLS``, ``HAS_VISIBILITY_HIDDEN``, ``COMPILING_WINDOWS_DLL``,
+ and ``__GNUC__``-related logic
+- Removed the ``-O3`` pragma hack in ``Hash.c``
+- Removed unnecessary Cabal flags
+
+Code Generation
+~~~~~~~~~~~~~~~
+
+- NCG for PPC: add pattern for ``CmmRegOff`` to ``iselExpr64`` (:ghc-ticket:`26828`)
+- PPC NCG: Use libcall for 64-bit ``cmpxchg`` on 32-bit PowerPC (:ghc-ticket:`23969`)
+
+Bytecode Compiler
+~~~~~~~~~~~~~~~~~
+
+- Use 32 bits for breakpoint index (:ghc-ticket:`26325`)
+
+``base`` library
+~~~~~~~~~~~~~~~~
+
+- Expose ``Backtraces`` constructor and fields (:ghc-ticket:`26049`)
+- Store ``StackTrace`` and ``StackSnapshot`` in ``Backtraces``, deferring decoding until display
+- Evaluate backtraces for ``error`` exceptions at the moment they are thrown
+ (`CLC proposal #383 <https://github.com/haskell/core-libraries-committee/issues/383>`__,
+ :ghc-ticket:`26751`)
+
+``ghc-experimental`` library
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+- Fixed ``GHC.Exception.Backtrace.Experimental`` module
+- Added ability to customise the collection of exception annotations
+
+``ghc-pkg``
+~~~~~~~~~~~~
+
+- Removed ``traceId`` from ``ghc-pkg`` executable
+
+``ghc-toolchain``
+~~~~~~~~~~~~~~~~~
+
+- Dropped ``ld.gold`` from merge object command
+
+Build System
+~~~~~~~~~~~~
+
+- Added ``hpc`` to release script
+- Use a response file to invoke GHC when analysing dependencies
+- Fixed ``GHC.Platform.Host`` generation for cross stage1 (:ghc-ticket:`26449`)
+- Fixed runtime error during ``users_guide`` build with Sphinx 9.1.0 (:ghc-ticket:`26810`)
+- Added ``ghc-{experimental,internal}.cabal`` to the list of dependencies of the doc target (:ghc-ticket:`26738`)
+
+Wasm Backend
+~~~~~~~~~~~~
+
+- Fixed dyld handling for forward declared ``GOT.func`` items (:ghc-ticket:`26430`)
+- Ensure ``setKeepCAFs()`` is called in GHCi (:ghc-ticket:`26106`)
+- Prevent bundlers from resolving ``import("node:timers")``
+- Use ``import.meta.main`` for proper distinction of Node.js main modules (:ghc-ticket:`26916`)
+
+Included libraries
+~~~~~~~~~~~~~~~~~~
+
+The package database provided with this distribution also contains a number of
+packages other than GHC itself. See the changelogs provided with these packages
+for further change information.
+
+.. ghc-package-list::
+
+ compiler/ghc.cabal: The compiler itself
+ libraries/array/array.cabal: Dependency of ``ghc`` library
+ libraries/base/base.cabal: Core library
+ libraries/binary/binary.cabal: Dependency of ``ghc`` library
+ libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library
+ libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library
+ libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library
+ libraries/directory/directory.cabal: Dependency of ``ghc`` library
+ libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library
+ libraries/file-io/file-io.cabal: Dependency of ``directory`` library
+ libraries/filepath/filepath.cabal: Dependency of ``ghc`` library
+ libraries/ghc-boot/ghc-boot.cabal: Internal compiler library
+ libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library
+ libraries/ghc-compact/ghc-compact.cabal: Core library
+ libraries/ghc-experimental/ghc-experimental.cabal: Core library
+ libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library
+ libraries/ghci/ghci.cabal: The REPL interface
+ libraries/ghc-internal/ghc-internal.cabal: Core library
+ libraries/ghc-platform/ghc-platform.cabal: Internal library
+ libraries/ghc-prim/ghc-prim.cabal: Core library
+ libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable
+ libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable
+ libraries/integer-gmp/integer-gmp.cabal: Core library
+ libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library
+ libraries/os-string/os-string.cabal: Dependency of ``filepath`` library
+ libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library
+ libraries/pretty/pretty.cabal: Dependency of ``ghc`` library
+ libraries/process/process.cabal: Dependency of ``ghc`` library
+ libraries/semaphore-compat/semaphore-compat.cabal: Dependency of ``ghc`` library
+ libraries/stm/stm.cabal: Dependency of ``haskeline`` library
+ libraries/template-haskell/template-haskell.cabal: Core library
+ libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library
+ libraries/text/text.cabal: Dependency of ``Cabal`` library
+ libraries/time/time.cabal: Dependency of ``ghc`` library
+ libraries/transformers/transformers.cabal: Dependency of ``ghc`` library
+ libraries/unix/unix.cabal: Dependency of ``ghc`` library
+ libraries/Win32/Win32.cabal: Dependency of ``ghc`` library
+ libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable
+ utils/haddock/haddock-api/haddock-api.cabal: Dependency of ``haddock`` executable
+ utils/haddock/haddock-library/haddock-library.cabal: Dependency of ``haddock`` executable
=====================================
docs/users_guide/release-notes.rst
=====================================
@@ -7,3 +7,4 @@ Release notes
9.12.1-notes
9.12.2-notes
9.12.3-notes
+ 9.12.4-notes
=====================================
libraries/base/base.cabal.in
=====================================
@@ -4,7 +4,7 @@ cabal-version: 3.0
-- Make sure you are editing ghc-experimental.cabal.in, not ghc-experimental.cabal
name: base
-version: 4.21.1.0
+version: 4.21.2.0
-- NOTE: Don't forget to update ./changelog.md
license: BSD-3-Clause
=====================================
libraries/base/changelog.md
=====================================
@@ -1,7 +1,9 @@
# Changelog for [`base` package](http://hackage.haskell.org/package/base)
-## 4.21.2.0 *TBA*
- * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383))
+## 4.21.2.0 *March 2026*
+ * Expose `Backtraces` constructor and fields ([CLC proposal #199](https://github.com/haskell/core-libraries-committee/issues/199), [#26049](https://gitlab.haskell.org/ghc/ghc/-/issues/26049))
+ * Store `StackTrace` and `StackSnapshot` in `Backtraces`, deferring decoding until display
+ * Evaluate backtraces for "error" exceptions at the moment they are thrown ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383), [#26751](https://gitlab.haskell.org/ghc/ghc/-/issues/26751))
## 4.21.1.0 *Sept 2024*
* Fix incorrect results of `integerPowMod` when the base is 0 and the exponent is negative, and `integerRecipMod` when the modulus is zero ([#26017](https://gitlab.haskell.org/ghc/ghc/-/issues/26017)).
=====================================
rts/Disassembler.c
=====================================
@@ -87,12 +87,12 @@ disInstr ( StgBCO *bco, int pc )
case bci_BRK_FUN:
debugBelch ("BRK_FUN " ); printPtr( ptrs[instrs[pc]] );
debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] );
- CostCentre* cc = (CostCentre*)literals[instrs[pc+5]];
+ CostCentre* cc = (CostCentre*)literals[instrs[pc+7]];
if (cc) {
debugBelch(" %s", cc->label);
}
debugBelch("\n");
- pc += 6;
+ pc += 8;
break;
case bci_SWIZZLE: {
W_ stkoff = BCO_GET_LARGE_ARG;
=====================================
rts/Interpreter.c
=====================================
@@ -1286,8 +1286,8 @@ run_BCO:
arg1_brk_array = BCO_GET_LARGE_ARG;
arg2_tick_mod = BCO_GET_LARGE_ARG;
arg3_info_mod = BCO_GET_LARGE_ARG;
- arg4_tick_index = BCO_NEXT;
- arg5_info_index = BCO_NEXT;
+ arg4_tick_index = BCO_READ_NEXT_32;
+ arg5_info_index = BCO_READ_NEXT_32;
#if defined(PROFILING)
arg6_cc = BCO_GET_LARGE_ARG;
#else
=====================================
testsuite/tests/default/T25775.hs
=====================================
@@ -0,0 +1,19 @@
+
+
+module T25775 where
+
+import Data.Kind
+
+default (Int)
+
+type NonStd :: Type -> Constraint
+class NonStd a where
+
+f :: (Num a, NonStd a) => a -> a
+f = (+1)
+
+x :: String
+x = show (f 0)
+ -- We should NOT default 0 to type Int, despite the top-level default
+ -- declaration in this module, because of the presence of the
+ -- non-standard class 'NonStd'.
=====================================
testsuite/tests/default/T25775.stderr
=====================================
@@ -0,0 +1,19 @@
+T25775.hs:16:5: error: [GHC-39999]
+ • Ambiguous type variable ‘a0’ arising from a use of ‘show’
+ prevents the constraint ‘(Show a0)’ from being solved.
+ Probable fix: use a type annotation to specify what ‘a0’ should be.
+ Potentially matching instances:
+ instance Show Ordering -- Defined in ‘GHC.Internal.Show’
+ instance Show Integer -- Defined in ‘GHC.Internal.Show’
+ ...plus 25 others
+ ...plus 13 instances involving out-of-scope types
+ (use -fprint-potential-instances to see them all)
+ • In the expression: show (f 0)
+ In an equation for ‘x’: x = show (f 0)
+
+T25775.hs:16:11: error: [GHC-39999]
+ • No instance for ‘NonStd a0’ arising from a use of ‘f’
+ • In the first argument of ‘show’, namely ‘(f 0)’
+ In the expression: show (f 0)
+ In an equation for ‘x’: x = show (f 0)
+
=====================================
testsuite/tests/default/all.T
=====================================
@@ -30,6 +30,7 @@ test('default-fail05', normal, compile_fail, [''])
test('default-fail06', normal, compile_fail, [''])
test('default-fail07', normal, compile_fail, [''])
test('default-fail08', normal, compile_fail, [''])
+test('T25775', normal, compile_fail, [''])
test('T25206', [extra_files(['T25206_helper.hs'])], multimod_compile, ['T25206', ''])
test('T25858', normal, compile_and_run, [''])
test('T25858v1', [extra_files(['T25858v1_helper.hs'])], multimod_compile_and_run, ['T25858v1', ''])
=====================================
testsuite/tests/typecheck/should_compile/T26451.hs
=====================================
@@ -0,0 +1,34 @@
+{-# LANGUAGE ImplicitParams, TypeFamilies, FunctionalDependencies, ScopedTypeVariables #-}
+
+module T26451 where
+
+type family F a
+type instance F Bool = [Char]
+
+class C a b | b -> a
+instance C Bool Bool
+instance C Char Char
+
+eq :: forall a b. C a b => a -> b -> ()
+eq p q = ()
+
+g :: a -> F a
+g = g
+
+f (x::tx) (y::ty) -- x :: alpha y :: beta
+ = let ?v = g x -- ?ip :: F alpha
+ in (?v::[ty], eq x True)
+
+
+{- tx, and ty are unification variables
+
+Inert: [G] dg :: IP "v" (F tx)
+ [W] dw :: IP "v" [ty]
+Work-list: [W] dc1 :: C tx Bool
+ [W] dc2 :: C ty Char
+
+* Solve dc1, we get tx := Bool from fundep
+* Kick out dg
+* Solve dg to get [G] dc : IP "v" [Char]
+* Add that new dg to the inert set: that simply deletes dw!!!
+-}
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -938,3 +938,4 @@ test('T23501b', normal, compile, [''])
test('T25597', normal, compile, [''])
test('T25960', normal, compile, [''])
test('T26256a', normal, compile, [''])
+test('T26451', normal, compile, [''])
=====================================
testsuite/tests/typecheck/should_fail/T12921.stderr
=====================================
@@ -1,3 +1,34 @@
+T12921.hs:4:1: error: [GHC-39999]
+ • Ambiguous type variable ‘a0’ arising from an annotation
+ prevents the constraint ‘(GHC.Internal.Data.Data.Data
+ a0)’ from being solved.
+ Probable fix: use a type annotation to specify what ‘a0’ should be.
+ Potentially matching instances:
+ instance (GHC.Internal.Data.Data.Data a,
+ GHC.Internal.Data.Data.Data b) =>
+ GHC.Internal.Data.Data.Data (Either a b)
+ -- Defined in ‘GHC.Internal.Data.Data’
+ instance GHC.Internal.Data.Data.Data Ordering
+ -- Defined in ‘GHC.Internal.Data.Data’
+ ...plus 17 others
+ ...plus 49 instances involving out-of-scope types
+ (use -fprint-potential-instances to see them all)
+ • In the annotation:
+ {-# ANN module "HLint: ignore Reduce duplication" #-}
+
+T12921.hs:4:16: error: [GHC-39999]
+ • Ambiguous type variable ‘a0’ arising from the literal ‘"HLint: ignore Reduce duplication"’
+ prevents the constraint ‘(GHC.Internal.Data.String.IsString
+ a0)’ from being solved.
+ Probable fix: use a type annotation to specify what ‘a0’ should be.
+ Potentially matching instance:
+ instance (a ~ Char) => GHC.Internal.Data.String.IsString [a]
+ -- Defined in ‘GHC.Internal.Data.String’
+ ...plus two instances involving out-of-scope types
+ (use -fprint-potential-instances to see them all)
+ • In the annotation:
+ {-# ANN module "HLint: ignore Reduce duplication" #-}
T12921.hs:7:8: error: [GHC-88464]
Variable not in scope: choice :: [a0] -> Int -> Int
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9930dbc4e69ce154c81f3f99209d55…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9930dbc4e69ce154c81f3f99209d55…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/backports-9.12.4] 7 commits: Report solid equality errors before custom errors
by Zubin (@wz1000) 04 Mar '26
by Zubin (@wz1000) 04 Mar '26
04 Mar '26
Zubin pushed to branch wip/backports-9.12.4 at Glasgow Haskell Compiler / GHC
Commits:
741a4ff3 by Simon Peyton Jones at 2026-03-04T10:52:43+05:30
Report solid equality errors before custom errors
This MR fixes #26255 by
* Reporting solid equality errors like
Int ~ Bool
before "custom type errors". See comments in `report1` in
`reportWanteds`
* Suppressing errors that arise from superclasses of
Wanteds. See (SCE1) in Note [Suppressing confusing errors]
More details in #26255.
(cherry picked from commit ba210d981b0812aea604f884d3c0aada4c8ca75c)
- - - - -
2050c915 by Simon Peyton Jones at 2026-03-04T10:52:43+05:30
Fix a horrible shadowing bug in implicit parameters
Fixes #26451. The change is in GHC.Tc.Solver.Monad.updInertDicts
where we now do /not/ delete /Wanted/ implicit-parameeter constraints.
This bug has been in GHC since 9.8! But it's quite hard to provoke;
I contructed a tests in T26451, but it was hard to do so.
(cherry picked from commit c052c724d2dfc994994b6548545836969aee8ed8)
- - - - -
c15e880f by Simon Peyton Jones at 2026-03-04T10:52:43+05:30
Fix subtle bug in GHC.Core.Utils.mkTick
This patch fixes a decade-old bug in `mkTick`, which
could generate type-incorrect code! See the diagnosis
in #26772.
The new code is simpler and easier to understand.
(As #26772 says, I think it could be improved further.)
(cherry picked from commit cbe4300ef586c8bee1800426624db12e0237c6b5)
- - - - -
a9805db7 by Simon Peyton Jones at 2026-03-04T10:52:43+05:30
Fix long-standing interaction between ticks and casts
The code for Note [Eliminate Identity Cases] was simply wrong when
ticks and casts interacted. This patch fixes the interaction.
It was shown up when validating #26772, although it's not the exactly
the bug that's reported by #26772. Nor is it easy to reproduce, hence
no regression test.
(cherry picked from commit b579dfdc614e288b0fd754ac69ae7ff723d808be)
- - - - -
bbe53332 by sheaf at 2026-03-04T10:52:43+05:30
NamedDefaults: require the class to be standard
We now only default type variables if they only appear in constraints
of the form `C v`, where `C` is either a standard class or a class with
an in-scope default declaration.
This rectifies an oversight in the original implementation of the
NamedDefault extensions that was remarked in #25775; that implementation
allowed type variables to appear in unary constraints which had arbitrary
classes at the head.
See the rewritten Note [How type-class constraints are defaulted] for
details of the implementation.
Fixes #25775
Fixes #25778
(cherry picked from commit f1acdd2c2b664ad0bdcaae4064b50e84aa7bc599)
- - - - -
b9826bf5 by Rodrigo Mesquita at 2026-03-04T10:52:43+05:30
bytecode: Use 32bits for breakpoint index
Fixes #26325
(cherry picked from commit e368e24779f8a7bf110a025383db23521b313407)
- - - - -
9930dbc4 by Zubin Duggal at 2026-03-04T10:52:43+05:30
Prepare release 9.12.4
- - - - -
35 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Types/DefaultEnv.hs
- + docs/users_guide/9.12.4-notes.rst
- docs/users_guide/release-notes.rst
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- rts/Disassembler.c
- rts/Interpreter.c
- + testsuite/tests/default/T25775.hs
- + testsuite/tests/default/T25775.stderr
- testsuite/tests/default/all.T
- + testsuite/tests/typecheck/should_compile/T26451.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T12921.stderr
- testsuite/tests/typecheck/should_fail/T18851.hs
- + testsuite/tests/typecheck/should_fail/T26255a.hs
- + testsuite/tests/typecheck/should_fail/T26255a.stderr
- + testsuite/tests/typecheck/should_fail/T26255b.hs
- + testsuite/tests/typecheck/should_fail/T26255b.stderr
- + testsuite/tests/typecheck/should_fail/T26255c.hs
- + testsuite/tests/typecheck/should_fail/T26255c.stderr
- testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr
- testsuite/tests/typecheck/should_fail/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/538ea5698b993e8f8ae5e40ec27694…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/538ea5698b993e8f8ae5e40ec27694…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/int-index/out-of-scope
by Vladislav Zavialov (@int-index) 04 Mar '26
by Vladislav Zavialov (@int-index) 04 Mar '26
04 Mar '26
Vladislav Zavialov pushed new branch wip/int-index/out-of-scope at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/out-of-scope
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/io-manager-deadlock-detection] Make the IOManager API use CapIOManager rather than Capability
by Duncan Coutts (@dcoutts) 03 Mar '26
by Duncan Coutts (@dcoutts) 03 Mar '26
03 Mar '26
Duncan Coutts pushed to branch wip/io-manager-deadlock-detection at Glasgow Haskell Compiler / GHC
Commits:
f340f464 by Duncan Coutts at 2026-02-11T22:48:35+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()).
- - - - -
13 changed files:
- rts/Capability.c
- rts/IOManager.c
- rts/IOManager.h
- rts/IOManagerInternals.h
- rts/PrimOps.cmm
- rts/RaiseAsync.c
- rts/Schedule.c
- rts/posix/Poll.c
- rts/posix/Poll.h
- rts/posix/Select.c
- rts/posix/Select.h
- rts/posix/Timeout.c
- rts/posix/Timeout.h
Changes:
=====================================
rts/Capability.c
=====================================
@@ -286,7 +286,8 @@ initCapability (Capability *cap, uint32_t i)
#endif
cap->total_allocated = 0;
- initCapabilityIOManager(cap); /* initialises cap->iomgr */
+ cap->iomgr = allocCapabilityIOManager(cap);
+ initCapabilityIOManager(cap->iomgr);
cap->f.stgEagerBlackholeInfo = (W_)&__stg_EAGER_BLACKHOLE_info;
cap->f.stgGCEnter1 = (StgFunPtr)__stg_gc_enter_1;
@@ -1344,7 +1345,7 @@ markCapability (evac_fn evac, void *user, Capability *cap,
}
#endif
- markCapabilityIOManager(evac, user, cap);
+ markCapabilityIOManager(evac, user, cap->iomgr);
// Free STM structures for this Capability
stmPreGCHook(cap);
=====================================
rts/IOManager.c
=====================================
@@ -316,22 +316,29 @@ char * showIOManager(void)
}
}
+/* Allocate a CapIOManager for a given Capability. Having this helps us keep
+ * struct CapIOManager opaque from most of the rest of the RTS.
+ */
+CapIOManager *allocCapabilityIOManager(Capability *cap)
+{
+ CapIOManager *iomgr = stgMallocBytes(sizeof(CapIOManager),
+ "allocCapabilityIOManager");
+ iomgr->cap = cap; /* link back */
+ return iomgr;
+}
+
-/* Allocate and initialise the per-capability CapIOManager that lives in each
- * Capability. Called from initCapability(), which is done in the RTS startup
- * in initCapabilities(), and later at runtime via setNumCapabilities().
+/* Initialise the per-capability CapIOManager that lives in each Capability.
+ * Called from initCapability(), which is done in the RTS startup in
+ * initCapabilities(), and later at runtime via setNumCapabilities().
*
* Note that during RTS startup this is called _before_ the storage manager
* is initialised, so this is not allowed to allocate on the GC heap.
*/
-void initCapabilityIOManager(Capability *cap)
+void initCapabilityIOManager(CapIOManager *iomgr)
{
debugTrace(DEBUG_iomanager, "initialising I/O manager %s for cap %d",
- showIOManager(), cap->no);
-
- CapIOManager *iomgr =
- (CapIOManager *) stgMallocBytes(sizeof(CapIOManager),
- "initCapabilityIOManager");
+ showIOManager(), iomgr->cap->no);
switch (iomgr_type) {
#if defined(IOMGR_ENABLED_SELECT)
@@ -363,8 +370,6 @@ void initCapabilityIOManager(Capability *cap)
default:
break;
}
-
- cap->iomgr = iomgr;
}
@@ -436,7 +441,7 @@ void initIOManager(void)
/* Called from forkProcess in the child process on the surviving capability.
*/
void
-initIOManagerAfterFork(Capability **pcap)
+initIOManagerAfterFork(CapIOManager *iomgr, Capability **pcap)
{
switch (iomgr_type) {
@@ -467,7 +472,7 @@ initIOManagerAfterFork(Capability **pcap)
/* Called from setNumCapabilities.
*/
-void notifyIOManagerCapabilitiesChanged(Capability **pcap)
+void notifyIOManagerCapabilitiesChanged(CapIOManager *iomgr, Capability **pcap)
{
switch (iomgr_type) {
#if defined(IOMGR_ENABLED_MIO_POSIX)
@@ -572,38 +577,29 @@ void wakeupIOManager(void)
}
}
-void markCapabilityIOManager(evac_fn evac, void *user, Capability *cap)
+void markCapabilityIOManager(evac_fn evac, void *user, CapIOManager *iomgr)
{
switch (iomgr_type) {
#if defined(IOMGR_ENABLED_SELECT)
case IO_MANAGER_SELECT:
- {
- CapIOManager *iomgr = cap->iomgr;
evac(user, (StgClosure **)(void *)&iomgr->blocked_queue_hd);
evac(user, (StgClosure **)(void *)&iomgr->blocked_queue_tl);
evac(user, (StgClosure **)(void *)&iomgr->sleeping_queue);
break;
- }
#endif
#if defined(IOMGR_ENABLED_POLL)
case IO_MANAGER_POLL:
- {
- CapIOManager *iomgr = cap->iomgr;
markClosureTable(evac, user, &iomgr->aiop_table);
evac(user, (StgClosure **)(void *)&iomgr->timeout_queue);
break;
- }
#endif
#if defined(IOMGR_ENABLED_WIN32_LEGACY)
case IO_MANAGER_WIN32_LEGACY:
- {
- CapIOManager *iomgr = cap->iomgr;
evac(user, (StgClosure **)(void *)&iomgr->blocked_queue_hd);
evac(user, (StgClosure **)(void *)&iomgr->blocked_queue_tl);
break;
- }
#endif
default:
break;
@@ -665,29 +661,23 @@ setIOManagerControlFd(uint32_t cap_no, int fd) {
#endif
-bool anyPendingTimeoutsOrIO(Capability *cap)
+bool anyPendingTimeoutsOrIO(CapIOManager *iomgr)
{
switch (iomgr_type) {
#if defined(IOMGR_ENABLED_SELECT)
case IO_MANAGER_SELECT:
- {
- CapIOManager *iomgr = cap->iomgr;
return (iomgr->blocked_queue_hd != END_TSO_QUEUE)
|| (iomgr->sleeping_queue != END_TSO_QUEUE);
- }
#endif
#if defined(IOMGR_ENABLED_POLL)
case IO_MANAGER_POLL:
- return anyPendingTimeoutsOrIOPoll(cap->iomgr);
+ return anyPendingTimeoutsOrIOPoll(iomgr);
#endif
#if defined(IOMGR_ENABLED_WIN32_LEGACY)
case IO_MANAGER_WIN32_LEGACY:
- {
- CapIOManager *iomgr = cap->iomgr;
return (iomgr->blocked_queue_hd != END_TSO_QUEUE);
- }
#endif
/* For the purpose of the scheduler, the threaded I/O managers never have
@@ -729,19 +719,19 @@ bool anyPendingTimeoutsOrIO(Capability *cap)
}
-void pollCompletedTimeoutsOrIO(Capability *cap)
+void pollCompletedTimeoutsOrIO(CapIOManager *iomgr)
{
debugTrace(DEBUG_iomanager, "polling for completed IO or timeouts");
switch (iomgr_type) {
#if defined(IOMGR_ENABLED_SELECT)
case IO_MANAGER_SELECT:
- awaitCompletedTimeoutsOrIOSelect(cap, false);
+ awaitCompletedTimeoutsOrIOSelect(iomgr, false);
break;
#endif
#if defined(IOMGR_ENABLED_POLL)
case IO_MANAGER_POLL:
- pollCompletedTimeoutsOrIOPoll(cap);
+ pollCompletedTimeoutsOrIOPoll(iomgr);
break;
#endif
@@ -753,7 +743,7 @@ void pollCompletedTimeoutsOrIO(Capability *cap)
#if defined(IOMGR_ENABLED_WINIO)
case IO_MANAGER_WINIO:
#endif
- awaitCompletedTimeoutsOrIOWin32(cap, false);
+ awaitCompletedTimeoutsOrIOWin32(iomgr->cap, false);
break;
#endif
default:
@@ -762,19 +752,19 @@ void pollCompletedTimeoutsOrIO(Capability *cap)
}
-void awaitCompletedTimeoutsOrIO(Capability *cap)
+void awaitCompletedTimeoutsOrIO(CapIOManager *iomgr)
{
debugTrace(DEBUG_iomanager, "waiting for completed IO or timeouts");
switch (iomgr_type) {
#if defined(IOMGR_ENABLED_SELECT)
case IO_MANAGER_SELECT:
- awaitCompletedTimeoutsOrIOSelect(cap, true);
+ awaitCompletedTimeoutsOrIOSelect(iomgr, true);
break;
#endif
#if defined(IOMGR_ENABLED_POLL)
case IO_MANAGER_POLL:
- awaitCompletedTimeoutsOrIOPoll(cap);
+ awaitCompletedTimeoutsOrIOPoll(iomgr);
break;
#endif
@@ -786,17 +776,18 @@ void awaitCompletedTimeoutsOrIO(Capability *cap)
#if defined(IOMGR_ENABLED_WINIO)
case IO_MANAGER_WINIO:
#endif
- awaitCompletedTimeoutsOrIOWin32(cap, true);
+ awaitCompletedTimeoutsOrIOWin32(iomgr->cap, true);
break;
#endif
default:
barf("pollCompletedTimeoutsOrIO not implemented");
}
- ASSERT(!emptyRunQueue(cap) || getSchedState() != SCHED_RUNNING);
+ ASSERT(!emptyRunQueue(iomgr->cap) || getSchedState() != SCHED_RUNNING);
}
-bool syncIOWaitReady(Capability *cap,
+/* CMM primop. Result is true on success, or false on allocation failure. */
+bool syncIOWaitReady(CapIOManager *iomgr,
StgTSO *tso,
IOReadOrWrite rw,
HsInt fd)
@@ -812,14 +803,14 @@ bool syncIOWaitReady(Capability *cap,
StgWord why_blocked = rw == IORead ? BlockedOnRead : BlockedOnWrite;
tso->block_info.fd = fd;
RELEASE_STORE(&tso->why_blocked, why_blocked);
- appendToIOBlockedQueue(cap, tso);
+ appendToIOBlockedQueue(iomgr, tso);
return true;
}
#endif
#if defined(IOMGR_ENABLED_POLL)
case IO_MANAGER_POLL:
ASSERT(tso->why_blocked == NotBlocked);
- return syncIOWaitReadyPoll(cap, tso, rw, fd);
+ return syncIOWaitReadyPoll(iomgr, tso, rw, fd);
#endif
default:
barf("waitRead# / waitWrite# not available for current I/O manager");
@@ -827,25 +818,29 @@ bool syncIOWaitReady(Capability *cap,
}
-void syncIOCancel(Capability *cap, StgTSO *tso)
+void syncIOCancel(CapIOManager *iomgr, StgTSO *tso)
{
debugTrace(DEBUG_iomanager, "cancelling I/O for thread %ld", (long) tso->id);
switch (iomgr_type) {
#if defined(IOMGR_ENABLED_SELECT)
case IO_MANAGER_SELECT:
- removeThreadFromDeQueue(cap, &cap->iomgr->blocked_queue_hd,
- &cap->iomgr->blocked_queue_tl, tso);
+ removeThreadFromDeQueue(iomgr->cap,
+ &iomgr->blocked_queue_hd,
+ &iomgr->blocked_queue_tl,
+ tso);
break;
#endif
#if defined(IOMGR_ENABLED_POLL)
case IO_MANAGER_POLL:
- syncIOCancelPoll(cap, tso);
+ syncIOCancelPoll(iomgr, tso);
break;
#endif
#if defined(IOMGR_ENABLED_WIN32_LEGACY)
case IO_MANAGER_WIN32_LEGACY:
- removeThreadFromDeQueue(cap, &cap->iomgr->blocked_queue_hd,
- &cap->iomgr->blocked_queue_tl, tso);
+ removeThreadFromDeQueue(iomgr->cap,
+ &iomgr->blocked_queue_hd,
+ &iomgr->blocked_queue_tl,
+ tso);
abandonWorkRequest(tso->block_info.async_result->reqID);
break;
#endif
@@ -856,11 +851,12 @@ void syncIOCancel(Capability *cap, StgTSO *tso)
#if defined(IOMGR_ENABLED_SELECT)
-static void insertIntoSleepingQueue(Capability *cap, StgTSO *tso, LowResTime target);
+static void insertIntoSleepingQueue(CapIOManager *iomgr, StgTSO *tso, LowResTime target);
#endif
-bool syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay)
+/* CMM primop. Result is true on success, or false on allocation failure. */
+bool syncDelay(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay)
{
debugTrace(DEBUG_iomanager, "thread %ld waiting for %lld us", tso->id, us_delay);
ASSERT(tso->why_blocked == NotBlocked);
@@ -871,13 +867,13 @@ bool syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay)
LowResTime target = getDelayTarget(us_delay);
tso->block_info.target = target;
RELEASE_STORE(&tso->why_blocked, BlockedOnDelay);
- insertIntoSleepingQueue(cap, tso, target);
+ insertIntoSleepingQueue(iomgr, tso, target);
return true;
}
#endif
#if defined(IOMGR_ENABLED_POLL)
case IO_MANAGER_POLL:
- return syncDelayTimeout(cap, tso, us_delay);
+ return syncDelayTimeout(iomgr, tso, us_delay);
#endif
#if defined(IOMGR_ENABLED_WIN32_LEGACY)
case IO_MANAGER_WIN32_LEGACY:
@@ -897,7 +893,7 @@ bool syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay)
* delayed thread on the blocked_queue.
*/
RELEASE_STORE(&tso->why_blocked, BlockedOnDoProc);
- appendToIOBlockedQueue(cap, tso);
+ appendToIOBlockedQueue(iomgr, tso);
return true;
}
#endif
@@ -907,18 +903,18 @@ bool syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay)
}
-void syncDelayCancel(Capability *cap, StgTSO *tso)
+void syncDelayCancel(CapIOManager *iomgr, StgTSO *tso)
{
debugTrace(DEBUG_iomanager, "cancelling delay for thread %ld", (long) tso->id);
switch (iomgr_type) {
#if defined(IOMGR_ENABLED_SELECT)
case IO_MANAGER_SELECT:
- removeThreadFromQueue(cap, &cap->iomgr->sleeping_queue, tso);
+ removeThreadFromQueue(iomgr->cap, &iomgr->sleeping_queue, tso);
break;
#endif
#if defined(IOMGR_ENABLED_POLL)
case IO_MANAGER_POLL:
- syncDelayCancelTimeout(cap, tso);
+ syncDelayCancelTimeout(iomgr, tso);
break;
#endif
/* Note: no case for IO_MANAGER_WIN32_LEGACY despite it having a case
@@ -935,14 +931,13 @@ void syncDelayCancel(Capability *cap, StgTSO *tso)
#if defined(IOMGR_ENABLED_SELECT) || defined(IOMGR_ENABLED_WIN32_LEGACY)
-void appendToIOBlockedQueue(Capability *cap, StgTSO *tso)
+void appendToIOBlockedQueue(CapIOManager *iomgr, StgTSO *tso)
{
- CapIOManager *iomgr = cap->iomgr;
ASSERT(tso->_link == END_TSO_QUEUE);
if (iomgr->blocked_queue_hd == END_TSO_QUEUE) {
iomgr->blocked_queue_hd = tso;
} else {
- setTSOLink(cap, iomgr->blocked_queue_tl, tso);
+ setTSOLink(iomgr->cap, iomgr->blocked_queue_tl, tso);
}
iomgr->blocked_queue_tl = tso;
}
@@ -957,9 +952,8 @@ void appendToIOBlockedQueue(Capability *cap, StgTSO *tso)
* used. This is a wart that should be excised.
*/
// TODO: move to Select.c and rename
-static void insertIntoSleepingQueue(Capability *cap, StgTSO *tso, LowResTime target)
+static void insertIntoSleepingQueue(CapIOManager *iomgr, StgTSO *tso, LowResTime target)
{
- CapIOManager *iomgr = cap->iomgr;
StgTSO *prev = NULL;
StgTSO *t = iomgr->sleeping_queue;
while (t != END_TSO_QUEUE && t->block_info.target < target) {
@@ -971,7 +965,7 @@ static void insertIntoSleepingQueue(Capability *cap, StgTSO *tso, LowResTime tar
if (prev == NULL) {
iomgr->sleeping_queue = tso;
} else {
- setTSOLink(cap, prev, tso);
+ setTSOLink(iomgr->cap, prev, tso);
}
}
#endif
=====================================
rts/IOManager.h
=====================================
@@ -19,6 +19,7 @@
#pragma once
+#include "Capability.h"
#include "sm/GC.h" // for evac_fn
#include "BeginPrivate.h"
@@ -227,11 +228,19 @@ enum IOOpOutcome {
void selectIOManager(void);
-/* Allocate and initialise the per-capability CapIOManager that lives in each
- * Capability. Called from initCapability(), which is done in the RTS startup
- * in initCapabilities(), and later at runtime via setNumCapabilities().
+/* Allocate a CapIOManager for a given Capability. Having this helps us keep
+ * struct CapIOManager opaque from most of the rest of the RTS.
*/
-void initCapabilityIOManager(Capability *cap);
+CapIOManager *allocCapabilityIOManager(Capability *cap);
+
+/* Initialise the per-capability CapIOManager that lives in each Capability.
+ * Called from initCapability(), which is done in the RTS startup in
+ * initCapabilities(), and later at runtime via setNumCapabilities().
+ *
+ * This is separate from allocCapabilityIOManager so that we can re-initialise
+ * I/O managers after forkProcess.
+ */
+void initCapabilityIOManager(CapIOManager *iomgr);
/* Init hook: called from hs_init_ghc, very late in the startup after almost
@@ -243,10 +252,11 @@ void initIOManager(void);
/* Init hook: called from forkProcess in the child process on the surviving
* capability.
*
- * Note that this is synchronous and can run Haskell code, so can change the
- * given cap.
+ * This is synchronous and can run Haskell code, so can change the given cap.
+ * TODO: it would make for a cleaner API here if this were made asynchronous.
*/
-void initIOManagerAfterFork(/* inout */ Capability **pcap);
+void initIOManagerAfterFork(CapIOManager *iomgr,
+ /* inout */ Capability **pcap);
/* TODO: rationalise initIOManager and initIOManagerAfterFork into a single
per-capability init function.
@@ -254,8 +264,12 @@ void initIOManagerAfterFork(/* inout */ Capability **pcap);
/* Called from setNumCapabilities.
+ *
+ * This is synchronous and can run Haskell code, so can change the given cap.
+ * TODO: it would make for a cleaner API here if this were made asynchronous.
*/
-void notifyIOManagerCapabilitiesChanged(Capability **pcap);
+void notifyIOManagerCapabilitiesChanged(CapIOManager *iomgr,
+ /* inout */ Capability **pcap);
/* Shutdown hooks: called from hs_exit_ before and after the scheduler exits.
@@ -288,7 +302,7 @@ void wakeupIOManager(void);
/* GC hook: mark any per-capability GC roots the I/O manager uses.
*/
-void markCapabilityIOManager(evac_fn evac, void *user, Capability *cap);
+void markCapabilityIOManager(evac_fn evac, void *user, CapIOManager *iomgr);
/* GC hook: scavenge I/O related tso->block_info. Used by scavengeTSO.
@@ -305,21 +319,20 @@ typedef enum { IORead, IOWrite } IOReadOrWrite;
* necessarily operate on threads. The thread is suspended until the operation
* completes.
*
- * These are called from CMM primops. The ones returing int can perform heap
- * allocation, which might fail. They return 0 on success, or n > 0 on heap
- * allocation failure, needing n words. The CMM primops should invoke the
- * GC to free up at least n words and then retry the operation.
+ * Some of these are called from CMM primops. The primops returing bool can
+ * perform heap allocation, which might fail. They return true on success, or
+ * false on heap allocation failure.
*/
-/* Result is true on success, or false on allocation failure. */
-bool syncIOWaitReady(Capability *cap, StgTSO *tso, IOReadOrWrite rw, HsInt fd);
+/* Called from CMM primop */
+bool syncIOWaitReady(CapIOManager *iomgr, StgTSO *tso, IOReadOrWrite rw, HsInt fd);
-void syncIOCancel(Capability *cap, StgTSO *tso);
+void syncIOCancel(CapIOManager *iomgr, StgTSO *tso);
-/* Result is true on success, or false on allocation failure. */
-bool syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay);
+/* Called from CMM primop */
+bool syncDelay(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay);
-void syncDelayCancel(Capability *cap, StgTSO *tso);
+void syncDelayCancel(CapIOManager *iomgr, StgTSO *tso);
#if defined(IOMGR_ENABLED_SELECT) || defined(IOMGR_ENABLED_WIN32_LEGACY)
/* Add a thread to the end of the queue of threads blocked on I/O.
@@ -327,7 +340,7 @@ void syncDelayCancel(Capability *cap, StgTSO *tso);
* This is used by the select() and the Windows MIO non-threaded I/O manager
* implementation. Called from CMM code.
*/
-void appendToIOBlockedQueue(Capability *cap, StgTSO *tso);
+void appendToIOBlockedQueue(CapIOManager *iomgr, StgTSO *tso);
#endif
/* Check to see if there are any pending timeouts or I/O operations
@@ -336,7 +349,7 @@ void appendToIOBlockedQueue(Capability *cap, StgTSO *tso);
* This is used by the scheduler as part of deadlock-detection, and the
* "context switch as often as possible" test.
*/
-bool anyPendingTimeoutsOrIO(Capability *cap);
+bool anyPendingTimeoutsOrIO(CapIOManager *iomgr);
/* If there are any completed I/O operations or expired timers, process the
* completions as appropriate (which will typically unblock some waiting
@@ -344,7 +357,7 @@ bool anyPendingTimeoutsOrIO(Capability *cap);
*
* Called from schedule() both *before* and *after* scheduleDetectDeadlock().
*/
-void pollCompletedTimeoutsOrIO(Capability *cap);
+void pollCompletedTimeoutsOrIO(CapIOManager *iomgr);
/* If there are any completed I/O operations or expired timers, process the
* completions as appropriate. If there are none, wait until I/O or a timer
@@ -360,6 +373,6 @@ void pollCompletedTimeoutsOrIO(Capability *cap);
*
* Called from schedule() both *before* and *after* scheduleDetectDeadlock().
*/
-void awaitCompletedTimeoutsOrIO(Capability *cap);
+void awaitCompletedTimeoutsOrIO(CapIOManager *iomgr);
#include "EndPrivate.h"
=====================================
rts/IOManagerInternals.h
=====================================
@@ -24,7 +24,8 @@
/* The per-capability data structures belonging to the I/O manager.
*
- * It can be accessed as cap->iomgr.
+ * It can be accessed as cap->iomgr. Or given just the iomgr, you can access
+ * the owning cap as iomgr->cap.
*
* The content of the structure is defined conditionally so it is different for
* each I/O manager implementation.
@@ -33,6 +34,9 @@
*/
struct _CapIOManager {
+ /* Back reference to the containing capability */
+ Capability *cap;
+
#if defined(IOMGR_ENABLED_SELECT)
/* Thread queue for threads blocked on I/O completion. */
StgTSO *blocked_queue_hd;
=====================================
rts/PrimOps.cmm
=====================================
@@ -2279,7 +2279,8 @@ stg_waitReadzh ( W_ fd )
{
CBool ok; /* Ok, or heap alloc failure. */
- (ok) = ccall syncIOWaitReady(MyCapability() "ptr", CurrentTSO "ptr",
+ (ok) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr",
+ CurrentTSO "ptr",
/* IORead */ 0::I32, fd);
if (ok != 0::CBool) (likely: True) {
jump stg_block_noregs();
@@ -2292,7 +2293,8 @@ stg_waitWritezh ( W_ fd )
{
CBool ok; /* Ok, or heap alloc failure. */
- (ok) = ccall syncIOWaitReady(MyCapability() "ptr", CurrentTSO "ptr",
+ (ok) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr",
+ CurrentTSO "ptr",
/* IOWrite */ 1::I32, fd);
if (ok != 0::CBool) (likely: True) {
jump stg_block_noregs();
@@ -2305,7 +2307,8 @@ stg_delayzh ( W_ us_delay )
{
CBool ok; /* Ok, or heap alloc failure. */
- (ok) = ccall syncDelay(MyCapability() "ptr", CurrentTSO "ptr", us_delay);
+ (ok) = ccall syncDelay(Capability_iomgr(MyCapability()) "ptr",
+ CurrentTSO "ptr", us_delay);
if (ok != 0::CBool) (likely: True) {
/* Annoyingly, we cannot be consistent with how we wait and resume the
=====================================
rts/RaiseAsync.c
=====================================
@@ -708,12 +708,12 @@ removeFromQueues(Capability *cap, StgTSO *tso)
case BlockedOnWrite:
case BlockedOnDoProc:
// These blocking reasons are only used by some I/O managers
- syncIOCancel(cap, tso);
+ syncIOCancel(cap->iomgr, tso);
goto done;
case BlockedOnDelay:
// This blocking reasons is only used by some I/O managers
- syncDelayCancel(cap, tso);
+ syncDelayCancel(cap->iomgr, tso);
goto done;
default:
=====================================
rts/Schedule.c
=====================================
@@ -409,7 +409,7 @@ schedule (Capability *initialCapability, Task *task)
*/
if (RtsFlags.ConcFlags.ctxtSwitchTicks == 0 &&
(!emptyRunQueue(cap) ||
- anyPendingTimeoutsOrIO(cap))) {
+ anyPendingTimeoutsOrIO(cap->iomgr))) {
RELAXED_STORE(&cap->context_switch, 1);
}
@@ -923,14 +923,14 @@ scheduleCheckBlockedThreads(Capability *cap USED_IF_NOT_THREADS)
* awaitCompletedTimeoutsOrIO below for the case of !defined(THREADED_RTS)
* && defined(mingw32_HOST_OS).
*/
- if (anyPendingTimeoutsOrIO(cap))
+ if (anyPendingTimeoutsOrIO(cap->iomgr))
{
if (emptyRunQueue(cap)) {
// block and wait
- awaitCompletedTimeoutsOrIO(cap);
+ awaitCompletedTimeoutsOrIO(cap->iomgr);
} else {
// poll but do not wait
- pollCompletedTimeoutsOrIO(cap);
+ pollCompletedTimeoutsOrIO(cap->iomgr);
}
}
#endif
@@ -950,7 +950,7 @@ scheduleDetectDeadlock (Capability **pcap, Task *task)
* other tasks are waiting for work, we must have a deadlock of
* some description.
*/
- if ( emptyRunQueue(cap) && !anyPendingTimeoutsOrIO(cap) )
+ if ( emptyRunQueue(cap) && !anyPendingTimeoutsOrIO(cap->iomgr) )
{
#if defined(THREADED_RTS)
/*
@@ -2232,7 +2232,7 @@ forkProcess(HsStablePtr *entry
// like startup event, capabilities, process info etc
traceTaskCreate(task, cap);
- initIOManagerAfterFork(&cap);
+ initIOManagerAfterFork(cap->iomgr, &cap);
// start timer after the IOManager is initialized
// (the idle GC may wake up the IOManager)
@@ -2392,7 +2392,7 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS)
}
// Notify IO manager that the number of capabilities has changed.
- notifyIOManagerCapabilitiesChanged(&cap);
+ notifyIOManagerCapabilitiesChanged(cap->iomgr, &cap);
startTimer();
=====================================
rts/posix/Poll.c
=====================================
@@ -120,9 +120,9 @@ also allows the signal mask to be adjusted, but we do not make use of this.
******************************************************************************/
/* Forward declarations */
-static bool enlargeTables(Capability *cap, CapIOManager *iomgr);
-static void notifyIOCompletion(Capability *cap, StgAsyncIOOp *aiop);
-static void ioCancel(Capability *cap, StgAsyncIOOp *aiop);
+static bool enlargeTables(CapIOManager *iomgr);
+static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop);
+static void ioCancel(CapIOManager *iomgr, StgAsyncIOOp *aiop);
static void reportPollError(int res, nfds_t nfds) STG_NORETURN;
@@ -136,32 +136,31 @@ void initCapabilityIOManagerPoll(CapIOManager *iomgr)
/* Used to implement syncIOWaitReady.
* Result is true on success, or false on allocation failure. */
-bool syncIOWaitReadyPoll(Capability *cap, StgTSO *tso,
+bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso,
IOReadOrWrite rw, HsInt fd)
{
StgAsyncIOOp *aiop;
- aiop = (StgAsyncIOOp *)allocateMightFail(cap, sizeofW(StgAsyncIOOp));
+ aiop = (StgAsyncIOOp *)allocateMightFail(iomgr->cap, sizeofW(StgAsyncIOOp));
if (RTS_UNLIKELY(aiop == NULL)) return false;
- SET_HDR(aiop, &stg_ASYNCIOOP_info, cap->r.rCCCS);
+ SET_HDR(aiop, &stg_ASYNCIOOP_info, iomgr->cap->r.rCCCS);
aiop->notify.tso = tso;
aiop->notify_type = NotifyTSO;
aiop->live = &stg_ASYNCIO_LIVE0_closure;
tso->why_blocked = rw == IORead ? BlockedOnRead : BlockedOnWrite;
tso->block_info.aiop = aiop;
- return asyncIOWaitReadyPoll(cap, aiop, rw, fd);
+ return asyncIOWaitReadyPoll(iomgr, aiop, rw, fd);
}
/* Result is true on success, or false on allocation failure. */
-bool asyncIOWaitReadyPoll(Capability *cap, StgAsyncIOOp *aiop,
+bool asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop,
IOReadOrWrite rw, int fd)
{
- CapIOManager *iomgr = cap->iomgr;
if (RTS_UNLIKELY(isFullClosureTable(&iomgr->aiop_table))) {
- bool ok = enlargeTables(cap, iomgr);
+ bool ok = enlargeTables(iomgr);
if (RTS_UNLIKELY(!ok)) return false;
}
- int ix = insertClosureTable(cap, &iomgr->aiop_table, aiop);
+ int ix = insertClosureTable(iomgr->cap, &iomgr->aiop_table, aiop);
/* We use the aiop_table and aiop_poll_table densely. */
ASSERT(ix == sizeClosureTable(&iomgr->aiop_table) - 1);
@@ -169,7 +168,7 @@ bool asyncIOWaitReadyPoll(Capability *cap, StgAsyncIOOp *aiop,
/* The syncIO wrapper or CMM primop filled in the notify and live fields,
* we fill the rest.
*/
- aiop->capno = cap->no;
+ aiop->capno = iomgr->cap->no;
aiop->index = ix;
aiop->outcome = IOOpOutcomeInFlight;
@@ -183,12 +182,12 @@ bool asyncIOWaitReadyPoll(Capability *cap, StgAsyncIOOp *aiop,
}
-void syncIOCancelPoll(Capability *cap, StgTSO *tso)
+void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso)
{
StgAsyncIOOp *aiop = tso->block_info.aiop;
ASSERT(aiop->notify_type == NotifyTSO);
- ASSERT(indexClosureTable(&cap->iomgr->aiop_table, aiop->index) == aiop);
- ioCancel(cap, aiop);
+ ASSERT(indexClosureTable(&iomgr->aiop_table, aiop->index) == aiop);
+ ioCancel(iomgr, aiop);
/* We cannot use the normal notifyIOCompletion here. We are in the context
* of throwTo, interrupting a thread blocked on IO via an async exception.
* We don't put the TSO back on the run queue or change the why_blocked
@@ -198,7 +197,7 @@ void syncIOCancelPoll(Capability *cap, StgTSO *tso)
}
-void asyncIOCancelPoll(Capability *cap, StgAsyncIOOp *aiop)
+void asyncIOCancelPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop)
{
/* We can reliably determine if the aiop is still in progress by checking
* if the aiop_table still points to this aiop object. This is reliable
@@ -206,20 +205,18 @@ void asyncIOCancelPoll(Capability *cap, StgAsyncIOOp *aiop)
* is no longer retained by the application.
*/
ASSERT(aiop->notify_type != NotifyTSO);
- if (indexClosureTable(&cap->iomgr->aiop_table, aiop->index) == aiop) {
- ioCancel(cap, aiop);
- notifyIOCompletion(cap, aiop);
+ if (indexClosureTable(&iomgr->aiop_table, aiop->index) == aiop) {
+ ioCancel(iomgr, aiop);
+ notifyIOCompletion(iomgr, aiop);
}
}
-static void ioCancel(Capability *cap, StgAsyncIOOp *aiop)
+static void ioCancel(CapIOManager *iomgr, StgAsyncIOOp *aiop)
{
- CapIOManager *iomgr = cap->iomgr;
-
int ix = aiop->index;
int ix_from; int ix_to;
- removeCompactClosureTable(cap, &iomgr->aiop_table, ix,
+ removeCompactClosureTable(iomgr->cap, &iomgr->aiop_table, ix,
&ix_from, &ix_to);
if (ix_to != ix_from) {
StgAsyncIOOp *aiop_to = indexClosureTable(&iomgr->aiop_table, ix_to);
@@ -237,7 +234,7 @@ bool anyPendingTimeoutsOrIOPoll(CapIOManager *iomgr)
}
-static void notifyIOCompletion(Capability *cap, StgAsyncIOOp *aiop)
+static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop)
{
ASSERT(aiop->outcome != IOOpOutcomeInFlight);
switch (aiop->notify_type) {
@@ -251,7 +248,8 @@ static void notifyIOCompletion(Capability *cap, StgAsyncIOOp *aiop)
debugTrace(DEBUG_iomanager,
"Raising exception in thread %" FMT_StgThreadID
" blocked on an invalid fd", tso->id);
- raiseAsync(cap, tso, (StgClosure *)blockedOnBadFD_closure,
+ raiseAsync(iomgr->cap, tso,
+ (StgClosure *)blockedOnBadFD_closure,
false, NULL);
break;
} else {
@@ -262,7 +260,7 @@ static void notifyIOCompletion(Capability *cap, StgAsyncIOOp *aiop)
StgTSO *tso = aiop->notify.tso;
tso->why_blocked = NotBlocked;
tso->_link = END_TSO_QUEUE;
- pushOnRunQueue(cap, tso);
+ pushOnRunQueue(iomgr->cap, tso);
}
break;
}
@@ -277,8 +275,7 @@ static void notifyIOCompletion(Capability *cap, StgAsyncIOOp *aiop)
}
-static void processIOCompletions(Capability *cap, CapIOManager *iomgr,
- int ncompletions)
+static void processIOCompletions(CapIOManager *iomgr, int ncompletions)
{
/* The scheme we use with poll is that we have a dense poll table, and a
* corresponding table that maps to the closure table index. The poll
@@ -320,7 +317,7 @@ static void processIOCompletions(Capability *cap, CapIOManager *iomgr,
* apply the same compacting to the aiop_poll_table.
*/
int ix_from; int ix_to;
- removeCompactClosureTable(cap, &iomgr->aiop_table, i,
+ removeCompactClosureTable(iomgr->cap, &iomgr->aiop_table, i,
&ix_from, &ix_to);
if (ix_to != ix_from) {
StgAsyncIOOp *aiop_to;
@@ -329,7 +326,7 @@ static void processIOCompletions(Capability *cap, CapIOManager *iomgr,
aiop_poll_table[ix_to] = aiop_poll_table[ix_from];
}
- notifyIOCompletion(cap, aiop);
+ notifyIOCompletion(iomgr, aiop);
n--;
} else {
/* You'd expect incrementing the poll table index to be
@@ -343,13 +340,11 @@ static void processIOCompletions(Capability *cap, CapIOManager *iomgr,
}
-void pollCompletedTimeoutsOrIOPoll(Capability *cap)
+void pollCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
{
- CapIOManager *iomgr = cap->iomgr;
-
if (!isEmptyTimeoutQueue(iomgr->timeout_queue)) {
Time now = getProcessElapsedTime();
- processTimeoutCompletions(cap, now);
+ processTimeoutCompletions(iomgr, now);
}
if (!isEmptyClosureTable(&iomgr->aiop_table)) {
@@ -379,7 +374,7 @@ void pollCompletedTimeoutsOrIOPoll(Capability *cap)
} else if (res > 0) {
int ncompletions = res;
ASSERT(ncompletions <= (int)nfds);
- processIOCompletions(cap, iomgr, ncompletions);
+ processIOCompletions(iomgr, ncompletions);
} else if (errno == EINTR) {
/* We got interrupted by a signal. This is unlikely since we asked
@@ -393,10 +388,8 @@ void pollCompletedTimeoutsOrIOPoll(Capability *cap)
}
-void awaitCompletedTimeoutsOrIOPoll(Capability *cap)
+void awaitCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
{
- CapIOManager *iomgr = cap->iomgr;
-
/* Loop until we've woken up some threads. This loop is needed because the
* poll() timing isn't accurate, we sometimes sleep for a while but not
* long enough to wake up a thread in a threadDelay. Or we may need to
@@ -409,14 +402,14 @@ void awaitCompletedTimeoutsOrIOPoll(Capability *cap)
!isEmptyClosureTable(&iomgr->aiop_table));
Time now = getProcessElapsedTime();
- processTimeoutCompletions(cap, now);
+ processTimeoutCompletions(iomgr, now);
/* If we didn't wake any threads due to expiring timeouts, then we need
* to wait on I/O. Or to put it another way, even if we did wake some
* threads, we'll still poll (but not wait) for I/O. This is to ensure
* we avoid starving threads blocked on I/O.
*/
- bool wait = emptyRunQueue(cap);
+ bool wait = emptyRunQueue(iomgr->cap);
/* Decide if we are going to wait if no I/O is ready, either:
* poll only, wait indefinitely, or wait until a timeout.
@@ -461,7 +454,7 @@ void awaitCompletedTimeoutsOrIOPoll(Capability *cap)
} else if (res > 0) {
int ncompletions = res;
ASSERT(ncompletions <= (int)nfds);
- processIOCompletions(cap, iomgr, ncompletions);
+ processIOCompletions(iomgr, ncompletions);
} else if (errno == EINTR) {
/* We got interrupted by a signal. In the non-threaded RTS, if the
@@ -471,7 +464,7 @@ void awaitCompletedTimeoutsOrIOPoll(Capability *cap)
* signal is serviced.
*/
#if defined(RTS_USER_SIGNALS)
- if (startPendingSignalHandlers(cap)) break;
+ if (startPendingSignalHandlers(iomgr->cap)) break;
#endif
/* We can also be interrupted by the shutdown signal handler, which
@@ -485,7 +478,7 @@ void awaitCompletedTimeoutsOrIOPoll(Capability *cap)
reportPollError(res, nfds);
}
- } while (emptyRunQueue(cap)
+ } while (emptyRunQueue(iomgr->cap)
&& (getSchedState() == SCHED_RUNNING));
}
@@ -507,12 +500,12 @@ static void reportPollError(int res, nfds_t nfds)
/* Helper function to double the size of the aiop_table and aiop_poll_table.
*/
-static bool enlargeTables(Capability *cap, CapIOManager *iomgr)
+static bool enlargeTables(CapIOManager *iomgr)
{
int oldcapacity = capacityClosureTable(&iomgr->aiop_table);
int newcapacity = (oldcapacity == 0) ? 1 : (oldcapacity * 2);
- bool ok = enlargeClosureTable(cap, &iomgr->aiop_table, newcapacity);
+ bool ok = enlargeClosureTable(iomgr->cap, &iomgr->aiop_table, newcapacity);
if (RTS_UNLIKELY(!ok)) return false;
/* Update the auxiliary aiop_poll_table to match */
=====================================
rts/posix/Poll.h
=====================================
@@ -19,19 +19,19 @@
void initCapabilityIOManagerPoll(CapIOManager *iomgr);
/* Synchronous I/O and timer operations */
-bool syncIOWaitReadyPoll(Capability *cap, StgTSO *tso,
+bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso,
IOReadOrWrite rw, HsInt fd);
-void syncIOCancelPoll(Capability *cap, StgTSO *tso);
+void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso);
/* Asynchronous operations */
-bool asyncIOWaitReadyPoll(Capability *cap, StgAsyncIOOp *aiop,
+bool asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop,
IOReadOrWrite rw, int fd);
-void asyncIOCancelPoll(Capability *cap, StgAsyncIOOp *aiop);
+void asyncIOCancelPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop);
/* Scheduler operations */
bool anyPendingTimeoutsOrIOPoll(CapIOManager *iomgr);
-void pollCompletedTimeoutsOrIOPoll(Capability *cap);
-void awaitCompletedTimeoutsOrIOPoll(Capability *cap);
+void pollCompletedTimeoutsOrIOPoll(CapIOManager *iomgr);
+void awaitCompletedTimeoutsOrIOPoll(CapIOManager *iomgr);
#endif /* IOMGR_ENABLED_POLL */
=====================================
rts/posix/Select.c
=====================================
@@ -93,9 +93,8 @@ LowResTime getDelayTarget (HsInt us)
* if this is true, then our time has expired.
* (idea due to Andy Gill).
*/
-static bool wakeUpSleepingThreads (Capability *cap, LowResTime now)
+static bool wakeUpSleepingThreads (CapIOManager *iomgr, LowResTime now)
{
- CapIOManager *iomgr = cap->iomgr;
StgTSO *tso;
bool flag = false;
@@ -109,7 +108,7 @@ static bool wakeUpSleepingThreads (Capability *cap, LowResTime now)
tso->_link = END_TSO_QUEUE;
IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %"
FMT_StgThreadID "\n", tso->id));
- pushOnRunQueue(cap,tso);
+ pushOnRunQueue(iomgr->cap,tso);
flag = true;
}
return flag;
@@ -217,9 +216,8 @@ static enum FdState fdPollWriteState (int fd)
*
*/
void
-awaitCompletedTimeoutsOrIOSelect(Capability *cap, bool wait)
+awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait)
{
- CapIOManager *iomgr = cap->iomgr;
StgTSO *tso, *prev, *next;
fd_set rfd,wfd;
int numFound;
@@ -244,7 +242,7 @@ awaitCompletedTimeoutsOrIOSelect(Capability *cap, bool wait)
do {
now = getLowResTimeOfDay();
- if (wakeUpSleepingThreads(cap, now)) {
+ if (wakeUpSleepingThreads(iomgr, now)) {
return;
}
@@ -355,7 +353,7 @@ awaitCompletedTimeoutsOrIOSelect(Capability *cap, bool wait)
*/
#if defined(RTS_USER_SIGNALS)
if (RtsFlags.MiscFlags.install_signal_handlers && signals_pending()) {
- startSignalHandlers(cap);
+ startSignalHandlers(iomgr->cap);
return; /* still hold the lock */
}
#endif
@@ -368,12 +366,12 @@ awaitCompletedTimeoutsOrIOSelect(Capability *cap, bool wait)
/* check for threads that need waking up
*/
- wakeUpSleepingThreads(cap, getLowResTimeOfDay());
+ wakeUpSleepingThreads(iomgr, getLowResTimeOfDay());
/* If new runnable threads have arrived, stop waiting for
* I/O and run them.
*/
- if (!emptyRunQueue(cap)) {
+ if (!emptyRunQueue(iomgr->cap)) {
return; /* still hold the lock */
}
}
@@ -429,7 +427,7 @@ awaitCompletedTimeoutsOrIOSelect(Capability *cap, bool wait)
IF_DEBUG(scheduler,
debugBelch("Killing blocked thread %" FMT_StgThreadID
" on bad fd=%i\n", tso->id, fd));
- raiseAsync(cap, tso,
+ raiseAsync(iomgr->cap, tso,
(StgClosure *)blockedOnBadFD_closure, false, NULL);
break;
case RTS_FD_IS_READY:
@@ -438,13 +436,13 @@ awaitCompletedTimeoutsOrIOSelect(Capability *cap, bool wait)
tso->id));
tso->why_blocked = NotBlocked;
tso->_link = END_TSO_QUEUE;
- pushOnRunQueue(cap,tso);
+ pushOnRunQueue(iomgr->cap,tso);
break;
case RTS_FD_IS_BLOCKING:
if (prev == NULL)
iomgr->blocked_queue_hd = tso;
else
- setTSOLink(cap, prev, tso);
+ setTSOLink(iomgr->cap, prev, tso);
prev = tso;
break;
}
@@ -460,7 +458,7 @@ awaitCompletedTimeoutsOrIOSelect(Capability *cap, bool wait)
}
} while (wait && getSchedState() == SCHED_RUNNING
- && emptyRunQueue(cap));
+ && emptyRunQueue(iomgr->cap));
}
#endif /* IOMGR_ENABLED_SELECT */
=====================================
rts/posix/Select.h
=====================================
@@ -15,7 +15,7 @@ typedef StgWord LowResTime;
LowResTime getDelayTarget (HsInt us);
-void awaitCompletedTimeoutsOrIOSelect(Capability *cap, bool wait);
+void awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait);
#include "EndPrivate.h"
=====================================
rts/posix/Timeout.c
=====================================
@@ -26,7 +26,7 @@
*/
#if defined(IOMGR_ENABLED_POLL)
-bool syncDelayTimeout(Capability *cap, StgTSO *tso, HsInt us_delay)
+bool syncDelayTimeout(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay)
{
Time now = getProcessElapsedTime();
Time target;
@@ -42,16 +42,16 @@ bool syncDelayTimeout(Capability *cap, StgTSO *tso, HsInt us_delay)
/* fill in a new timeout queue entry */
StgTimeout *timeout;
- timeout = (StgTimeout *)allocateMightFail(cap, sizeofW(StgTimeout));
+ timeout = (StgTimeout *)allocateMightFail(iomgr->cap, sizeofW(StgTimeout));
if (RTS_UNLIKELY(timeout == NULL)) { return false; }
union NotifyCompletion notify = { .tso = tso };
- initElemTimeoutQueue(timeout, notify, NotifyTSO, cap->r.rCCCS);
+ initElemTimeoutQueue(timeout, notify, NotifyTSO, iomgr->cap->r.rCCCS);
ASSERT(tso->why_blocked == NotBlocked);
tso->why_blocked = BlockedOnDelay;
tso->block_info.timeout = timeout;
- insertTimeoutQueue(&cap->iomgr->timeout_queue, timeout, target);
+ insertTimeoutQueue(&iomgr->timeout_queue, timeout, target);
debugTrace(DEBUG_iomanager,
"timer for delay of %lld usec installed at time %lld ns",
@@ -60,18 +60,18 @@ bool syncDelayTimeout(Capability *cap, StgTSO *tso, HsInt us_delay)
}
-void syncDelayCancelTimeout(Capability *cap, StgTSO *tso)
+void syncDelayCancelTimeout(CapIOManager *iomgr, StgTSO *tso)
{
ASSERT(tso->why_blocked == BlockedOnDelay);
StgTimeoutQueue *timeout = tso->block_info.timeout;
- deleteTimeoutQueue(&cap->iomgr->timeout_queue, timeout);
+ deleteTimeoutQueue(&iomgr->timeout_queue, timeout);
tso->block_info.closure = (StgClosure *)END_TSO_QUEUE;
/* the timeout is no longer accessible from anywhere (except here) */
IF_NONMOVING_WRITE_BARRIER_ENABLED {
- updateRemembSetPushClosure(cap, (StgClosure *)timeout);
+ updateRemembSetPushClosure(iomgr->cap, (StgClosure *)timeout);
}
/* We don't put the TSO back on the run queue or change the why_blocked
@@ -79,7 +79,7 @@ void syncDelayCancelTimeout(Capability *cap, StgTSO *tso)
*/
}
-static void notifyTimeoutCompletion(Capability *cap, StgTimeout *timeout);
+static void notifyTimeoutCompletion(CapIOManager *iomgr, StgTimeout *timeout);
/* We use the 64bit Time type from rts/Time.h so our max time (in nanosecond
* precision) is over 290 years from the epoch of the monotonic clock.
@@ -90,10 +90,8 @@ static void notifyTimeoutCompletion(Capability *cap, StgTimeout *timeout);
* With 64bit Time we do not need to worry about clock wraparound and can just
* use the simple formula.
*/
-void processTimeoutCompletions(Capability *cap, Time now)
+void processTimeoutCompletions(CapIOManager *iomgr, Time now)
{
- CapIOManager *iomgr = cap->iomgr;
-
/* Pop entries from the front of the sleeping queue that are past their
* wake time, and unblock the corresponding MVars.
*/
@@ -105,17 +103,17 @@ void processTimeoutCompletions(Capability *cap, Time now)
debugTrace(DEBUG_iomanager,"timer expired at %lld ns", waketime);
StgTimeout *timeout;
deleteMinTimeoutQueue(&iomgr->timeout_queue, &timeout);
- notifyTimeoutCompletion(cap, timeout);
+ notifyTimeoutCompletion(iomgr, timeout);
/* the timeout is no longer accessible from anywhere (except here) */
IF_NONMOVING_WRITE_BARRIER_ENABLED {
- updateRemembSetPushClosure(cap, (StgClosure *)timeout);
+ updateRemembSetPushClosure(iomgr->cap, (StgClosure *)timeout);
}
}
}
-static void notifyTimeoutCompletion(Capability *cap, StgTimeout *timeout)
+static void notifyTimeoutCompletion(CapIOManager *iomgr, StgTimeout *timeout)
{
switch (timeout->notify_type) {
case NotifyTSO:
@@ -123,11 +121,11 @@ static void notifyTimeoutCompletion(Capability *cap, StgTimeout *timeout)
StgTSO *tso = timeout->notify.tso;
tso->why_blocked = NotBlocked;
tso->_link = END_TSO_QUEUE;
- pushOnRunQueue(cap, tso);
+ pushOnRunQueue(iomgr->cap, tso);
break;
}
case NotifyMVar:
- performTryPutMVar(cap, timeout->notify.mvar, Unit_closure);
+ performTryPutMVar(iomgr->cap, timeout->notify.mvar, Unit_closure);
break;
case NotifyTVar:
=====================================
rts/posix/Timeout.h
=====================================
@@ -12,9 +12,9 @@
#include "BeginPrivate.h"
-bool syncDelayTimeout(Capability *cap, StgTSO *tso, HsInt us_delay);
+bool syncDelayTimeout(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay);
-void syncDelayCancelTimeout(Capability *cap, StgTSO *tso);
+void syncDelayCancelTimeout(CapIOManager *iomgr, StgTSO *tso);
/* Process the completion of any timeouts that have expired: this means
* notifying whatever is waiting on the timeout, a thread, an MVar or TVar.
@@ -24,7 +24,7 @@ void syncDelayCancelTimeout(Capability *cap, StgTSO *tso);
* No result is returned: callers can check if there are now any runnable
* threads by consulting the scheduler's run queue.
*/
-void processTimeoutCompletions(Capability *cap, Time now);
+void processTimeoutCompletions(CapIOManager *iomgr, Time now);
/* Utility to compute the timeout wait time (in milliseconds) between now and
* the next timer expiry (if any), or no waiting (if !wait).
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f340f464242fda12596188be8ed2f3a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f340f464242fda12596188be8ed2f3a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
03 Mar '26
Simon Peyton Jones pushed to branch wip/T20264 at Glasgow Haskell Compiler / GHC
Commits:
1cf405bf by Simon Peyton Jones at 2026-03-03T23:44:18+00:00
Wibble GHC.Hs.Type
- - - - -
1 changed file:
- compiler/GHC/Hs/Type.hs
Changes:
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -117,7 +117,6 @@ import GHC.Core.Ppr ( pprOccWithTick)
import GHC.Core.Type
import GHC.Core.Multiplicity( pprArrowWithMultiplicity )
import GHC.Hs.Doc
-import GHC.Hs.Lit (pprHsStringLit)
import GHC.Generics (Generic, Generically(..))
import GHC.Types.Basic
import GHC.Types.SrcLoc
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cf405bf3f333a3dafd4fc7046ada0e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cf405bf3f333a3dafd4fc7046ada0e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0