- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/rafl/meaningful-main-return] Implement MeaningfulMainReturn
by Florian Ragwitz (＠rafl) 09 Oct '26

09 Oct '26

Florian Ragwitz pushed to branch wip/rafl/meaningful-main-return at Glasgow Haskell Compiler / GHC Commits: 012b0dbe by Florian Ragwitz at 2026-10-09T13:30:52-07:00 Implement MeaningfulMainReturn As per ghc-proposal#631, with one small adjustment explained in the comments. Fixes #24848. - - - - - 36 changed files: - + changelog.d/MeaningfulMainReturn - compiler/GHC/Builtin/KnownOccs.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Types/Error/Codes.hs - + docs/users_guide/exts/meaningful_main_return.rst - docs/users_guide/exts/misc.rst - docs/users_guide/using-warnings.rst - libraries/base/src/GHC/Essentials.hs - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/meaningful-main-return/MainReturn_constrained_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_exit_code_alias_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_exit_code_bottom_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_exit_code_bottom_enabled_run.stderr - + testsuite/tests/meaningful-main-return/MainReturn_exit_code_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_exit_success_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_family_always_exit_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_family_invalid_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_family_invalid_enabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_family_stuck_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_family_stuck_enabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_int_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_int_enabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_newtype_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_newtype_enabled.stderr - + testsuite/tests/meaningful-main-return/MeaningfulMainReturn.hs - + testsuite/tests/meaningful-main-return/all.T - testsuite/tests/parser/should_compile/T7476/T7476.hs - testsuite/tests/plugins/T23110.stdout - testsuite/tests/plugins/static-plugins.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/012b0dbeff1bc530fc844b82a97785a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/012b0dbeff1bc530fc844b82a97785a… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/rafl/meaningful-main-return] Implement MeaningfulMainReturn
by Florian Ragwitz (＠rafl) 09 Oct '26

09 Oct '26

Florian Ragwitz pushed to branch wip/rafl/meaningful-main-return at Glasgow Haskell Compiler / GHC Commits: d138228e by Florian Ragwitz at 2026-10-09T09:44:06-07:00 Implement MeaningfulMainReturn As per ghc-proposal#631, with one small adjustment explained in the comments. Fixes #24848. - - - - - 31 changed files: - + changelog.d/MeaningfulMainReturn - compiler/GHC/Builtin/KnownOccs.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Types/Error/Codes.hs - + docs/users_guide/exts/meaningful_main_return.rst - docs/users_guide/exts/misc.rst - docs/users_guide/using-warnings.rst - libraries/base/src/GHC/Essentials.hs - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/meaningful-main-return/MainReturn_constrained_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_exit_code_alias_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_exit_code_bottom_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_exit_code_bottom_enabled_run.stderr - + testsuite/tests/meaningful-main-return/MainReturn_exit_code_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_exit_success_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_family_always_exit_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_family_invalid_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_family_invalid_enabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_family_stuck_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_family_stuck_enabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_int_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_int_enabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_newtype_disabled.stderr - + testsuite/tests/meaningful-main-return/MainReturn_newtype_enabled.stderr - + testsuite/tests/meaningful-main-return/MeaningfulMainReturn.hs - + testsuite/tests/meaningful-main-return/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d138228eb5e3b83909776c898f9f6a5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d138228eb5e3b83909776c898f9f6a5… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/T27737] More work in progress
by Simon Peyton Jones (＠simonpj) 09 Oct '26

09 Oct '26

Simon Peyton Jones pushed to branch wip/T27737 at Glasgow Haskell Compiler / GHC Commits: a9fdc56f by Simon Peyton Jones at 2026-10-09T17:40:35+01:00 More work in progress ...with Claude Very nice refactor. The hack does about what we hoped. Changes are relative to the original branch (casts always in inner), and only tests that moved by more than 0.5% are listed: ┌──────────────────┬───────────────────────┬───────────────────────────────────────────────────────────────────┐ │ Test │ Casts always in outer │ Hack (cast only into a single-alternative case or a non-join let) │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ CoOpt_Read │ +6.9% │ +5.6% (still a regression) │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ CoOpt_Singletons │ +6.1% │ 0.0% (fully recovered) │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T13253 │ +3.7% │ +0.1% (recovered) │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T13056 │ +1.1% │ +1.1% │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T5642 │ −1.9% │ −1.9% (fix kept) │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T16577 │ −1.5% │ −1.5% │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T21839c │ −1.0% │ −1.0% │ ├──────────────────┼───────────────────────┼───────────────────────────────────────────────────────────────────┤ │ T19695 │ +0.8% │ −0.1% │ └──────────────────┴───────────────────────┴───────────────────────────────────────────────────────────────────┘ The other 56 tests are within 0.5%. Relative to master, CoOpt_Read is still about 3% better (it was 9% better with casts always pushed inside). CoOpt_Read is the only real loss left. It presumably gains from pushing a cast into a multi-alternative case, or into a join point, which the hack now forbids. The Core Lint bug. My reading is that it's caused by the hack, not latent: a cast pushed into a join point's RHS but not into a multi-alternative case in its body leaves a jump under a cast. The mightBeJoinBind test (no casts into a join-point let) fixes it, and the current tree builds cleanly with it. /tmp/tjoin/JoinCast.hs is a candidate reproducer of that shape: MkN (let j z = ... in case x of {0 -> j 1; 1 -> j 2; _ -> 3}). It passes Lint on master and on the current branch. I haven't yet seen it fail, because that needs the buggy state rebuilt, which means editing Iteration.hs. I'll do that only after your push, if you want it. State you're committing: - FloatBinds work, with addFloatBinds. - Your getFF and Note [LetFloats] changes, plus my comment fixes and the let-can-float and soft-scope assertions. - Soft-scoped ticks floated as FloatTicks. - The push_casts flag, with mightBeJoinBind. - Accepted outputs for T20510 and show-bytecode-hpc. - Tests: - The full testsuite was run before the push_casts change; the only unexpected failures were environmental ones and those two outputs, now accepted. - The push_casts version has only been built, and measured with the perf harness. simplCore and the full testsuite haven't been rerun on it. - - - - - 6 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - testsuite/tests/dmdanal/should_compile/T20510.stderr - testsuite/tests/show-bytecode/show-bytecode-hpc.stdout Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1720,10 +1720,19 @@ isEmptyFloatBinds = isNilOL data FloatBind = FloatLet CoreBind + -- let(rec) x = e + -- Invariant: satisfies the let-can-float invariant + | FloatCase CoreExpr CoreBndr AltCon [CoreBndr] -- case e of y { C ys -> ... } -- See Note [Floating single-alternative cases] in GHC.Core.Opt.SetLevels + | FloatTick CoreTickish + -- tick<t> ... + -- Invariant: the tick is always soft-scoped (tickishHasSoftScope holds) + -- Why? We are floating these FloatBinds outwards, bringing more code under + -- the bindigns; that is only OK for soft-scoped ticks. + -- See Note [Scoping ticks and counting ticks] in GHC.Types.Tickish floatsBinders :: FloatBinds -> [Var] floatsBinders fs = foldr ((++) . floatBinders) [] fs ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -38,7 +38,7 @@ module GHC.Core.Opt.Simplify.Env ( -- * Floats SimplFloats(..), emptyFloats, isEmptyFloats, mkRecFloats, - mkFloatBind, addLetFloats, addJoinFloats, addFloats, + mkFloatBind, addLetFloats, addJoinFloats, addFloats, addFloatBindsF, extendFloats, wrapFloats, isEmptyJoinFloats, isEmptyLetFloats, doFloatFromRhs, getTopFloatBinds, @@ -79,6 +79,7 @@ import GHC.Types.Var.Set import GHC.Types.Id as Id import GHC.Types.InlinePragma ( ActivationGhc, CompilerPhase, isActiveInPhase ) import GHC.Types.Basic +import GHC.Types.Tickish ( CoreTickish, tickishCounts, tickishHasSoftScope ) import GHC.Types.Unique.FM ( pprUniqFM ) import GHC.Data.OrdList @@ -745,45 +746,56 @@ setSubstEnv env tvs cvs ids = env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst Note [LetFloats] ~~~~~~~~~~~~~~~~ -The LetFloats is a bunch of bindings, classified by a FloatFlag. +The LetFloats is a bunch of FloatBinds, collectively classified by a FloatFlag. -The `FloatFlag` contains summary information about the bindings, see the data -type declaration of `FloatFlag` +The `FloatFlag` contains summary information about the bindings: see the data +type declaration of `FloatFlag`. A FloatBind can take one of three forms: +FloatLet, FloatCase, and FloatTick. We discuss the FloatFlag for each form. +Note [FloatFlag for FloatLet] -- see `getFF_Let` +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Examples - NonRec x (y:ys) FltLifted - Rec [(x,rhs)] FltLifted - - NonRec x* (p:q) FltOKSpec -- RHS is WHNF. Question: why not FltLifted? - NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n - - NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge - NonRec x# (a /# b) FltCareful -- Might fail; does not satisfy let-can-float invariant - NonRec x# (f y) FltCareful -- Might diverge; does not satisfy let-can-float invariant - -A binding that does not satisfy the let-can-float invariant (the last two -examples above) is represented by a FloatCase, not a FloatLet: - FloatCase (a /# b) x# DEFAULT [] -That is done once and for all by `unitLetFloat`, so a FloatLet in a LetFloats -is always a valid let-binding, and `wrapFloats` does not need to check. -Such bindings can arise from `makeTrivial`, because an argument need not -satisfy the let-can-float invariant. They also arise because -exprOkForSpeculation is conservative: e.g. it says False for (# s, x #) -where x is lifted, because it checks the arguments against the -(representation-polymorphic) type of the unboxed-tuple worker. - -However, a FloatLet can still be FltCareful: the first FltCareful example -above, NonRec x* (f y), where x* is lifted but has a strict demand -(isStrUsedDmd). That is a perfectly valid (lazy) let-binding, but its demand -info is valid only where it is. If we floated it out of the RHS of a lazy -binding - let v = let x* = f y in x*+1 in body - ==> let x* = f y; v = x*+1 in body -then x's demand info would be a lie, and CorePrep, which case-binds a let -whose binder has a strict demand, would evaluate (f y) eagerly. Hence -FltCareful, which doFloatFromRhs allows to float only out of a strict binding. - + NonRec x (y:ys) FltLifted + Rec [(x,rhs)] FltLifted + + NonRec x* (p:q) FltOKSpec -- RHS is WHNF. Question: why not FltLifted? + NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n + + NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge + NonRec x# (a /# b) FltCareful -- Might fail; does not satisfy let-can-float invariant + NonRec x# (f y) FltCareful -- Might diverge; does not satisfy let-can-float invariant + + NonRec s "foo"# FltLifted -- Literal string can go to top level + +* (FFL1) Note that a FloatLet can still be FltCareful: the first FltCareful example + above, NonRec x* (f y), where x* is lifted but has a strict demand + (isStrUsedDmd). That is a perfectly valid (lazy) let-binding, but its demand + info is valid only where it is. If we floated it out of the RHS of a lazy + binding + let v = let x* = f y in x*+1 in body + ==> let x* = f y; v = x*+1 in body + then x's demand info would be a lie, and CorePrep, which case-binds a let + whose binder has a strict demand, would evaluate (f y) eagerly. Hence + FltCareful, which doFloatFromRhs allows to float only out of a strict binding. + +* (FFL2) A literal-string binding is marked FltLifted (a bit of a mis-nomer + because it's not a lifted type) because it can go to top level. + See Note [Core top-level string literals] in GHC.Core. + +* A binding that does not satisfy the let-can-float invariant (the last two + examples above) is represented by a FloatCase, not a FloatLet: + FloatCase (a /# b) x# DEFAULT [] + That is done once and for all by `unitLetFloat`, so a FloatLet in a LetFloats + is always a valid let-binding, and `wrapFloats` does not need to check. + Such bindings can arise from `makeTrivial`, because an argument need not + satisfy the let-can-float invariant. They also arise because + exprOkForSpeculation is conservative: e.g. it says False for (# s, x #) + where x is lifted, because it checks the arguments against the + (representation-polymorphic) type of the unboxed-tuple worker. + +Note [FloatFlag for FloatCase] -- see `getFF_Case` +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As well as let-bindings, a LetFloats can contain single-alternative case floats (FloatCase), for example case e of b { (# a, c #) -> <hole> } @@ -795,12 +807,29 @@ These are classified just like a strict binding: Being strict they are never FltLifted, so they never float to top level or into a recursive group. -Currently, we never put a FloatTick in a LetFloats. +Note [FloatFlag for FloatTick] -- see `getFF_Tick` +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A LetFloats can contain a FloatTick for soft-scoped ticks (only -- see the +invariant on FloatTick in GHC.Core). + +* We certainly don't want a tick to go to top level, or into a recursive group, + so its FloatFlag is never FltLifted. + +* A /non-counting/ tick (e.g. a source note) is FltOkSpec. Floating it out of + the RHS of a lazy binding + let x = tick<t> (let y = e1 in e2) in body + ==> tick<t> (let y = e1 in let x = e2 in body) + just brings more code (here `body`) under the tick, which is fine for a + soft-scoped tick. + +* A /counting/ tick (e.g. an HPC tick) is FltCareful. Floating it out of a lazy + RHS would change when (and how often) it is counted: when the let is + executed rather than when `x` is evaluated. -} data LetFloats = LetFloats FloatBinds FloatFlag -- See Note [LetFloats] - -- Contains only FloatLet and FloatCase; never FloatTick + -- Invariant: every FloatLet satisfies the let-can-float invariant type JoinFloat = OutBind type JoinFloats = OrdList JoinFloat @@ -817,7 +846,7 @@ data FloatFlag -- *and* ok-for-speculation -- Hence ok to float out of the RHS -- of a lazy non-recursive let binding - -- (but not to top level, or into a rec group) + -- (but /not/ to top level, or into a rec group) -- NB: consequence: all bindings satisfy let-can-float invariant | FltCareful -- At least one binding is strict (or unlifted) @@ -899,37 +928,50 @@ emptyJoinFloats = nilOL isEmptyJoinFloats :: JoinFloats -> Bool isEmptyJoinFloats = isNilOL +getFF :: FloatBind -> FloatFlag +getFF (FloatCase e _ _ _) = getFF_Case e +getFF (FloatLet b) = getFF_Let b +getFF (FloatTick t) = getFF_Tick t + +getFF_Let :: CoreBind -> FloatFlag +-- See Note [FloatFlag for FloatLet] +getFF_Let (Rec {}) = FltLifted +getFF_Let (NonRec bndr rhs) + | not (isStrictId bndr) = FltLifted -- Lazy lifted let + | exprIsTickedString rhs = FltLifted -- See (FFL2) + | exprOkForSpeculation rhs = FltOkSpec -- Unlifted, or strict lifted, and ok-for-spec (e.g. HNF) + | otherwise = FltCareful -- See (FFL1) Strict, e.g. let x* = factorial y + +getFF_Case :: CoreExpr -> FloatFlag -- The CoreExpr is the scrutinee +-- Note [FloatFlag for FloatCase] +getFF_Case scrut | exprOkForSpeculation scrut = FltOkSpec + | otherwise = FltCareful + +getFF_Tick :: CoreTickish -> FloatFlag +-- See Note [FloatFlag for FloatTick] +getFF_Tick t | tickishCounts t = FltCareful + | otherwise = FltOkSpec + unitLetFloat :: OutBind -> LetFloats -- This key function constructs a singleton float with the right form -- If the binding does not satisfy the let-can-float invariant, it -- makes a FloatCase. See Note [LetFloats] -unitLetFloat bind = assert (all (not . isJoinId) (bindersOf bind)) $ - mk_float bind - where - mk_float bind@(Rec {}) = let_float FltLifted bind - mk_float bind@(NonRec bndr rhs) - | not (isStrictId bndr) = let_float FltLifted bind - | exprIsTickedString rhs = let_float FltLifted bind - -- String literals can be floated freely. - -- See Note [Core top-level string literals] in GHC.Core. - | exprOkForSpeculation rhs = let_float FltOkSpec bind -- Unlifted, and lifted but ok-for-spec (eg HNF) - | needsCaseBinding (idType bndr) rhs - = pprTrace "TMP-unitLetFloat-case" (ppr bind) $ - LetFloats (unitOL (FloatCase rhs bndr DEFAULT [])) FltCareful - -- Unlifted, and not ok-for-spec: does not satisfy let-can-float invariant - | otherwise = let_float FltCareful bind - - let_float flag bind = LetFloats (unitOL (FloatLet bind)) flag +unitLetFloat bind + | NonRec bndr rhs <- bind + , needsCaseBinding (idType bndr) rhs + = -- This should never happen, but currently does because of #27910 + LetFloats (unitOL (FloatCase rhs bndr DEFAULT [])) FltCareful + + | otherwise + = assert (all (not . isJoinId) (bindersOf bind)) $ + LetFloats (unitOL (FloatLet bind)) (getFF_Let bind) unitCaseFloat :: OutExpr -> OutId -> AltCon -> [OutVar] -> LetFloats -- Constructs a singleton single-alternative case float -- case scrut of bndr { con bndrs -> <hole> } -- See Note [LetFloats] unitCaseFloat scrut bndr con bndrs - = LetFloats (unitOL (FloatCase scrut bndr con bndrs)) flag - where - flag | exprOkForSpeculation scrut = FltOkSpec - | otherwise = FltCareful + = LetFloats (unitOL (FloatCase scrut bndr con bndrs)) (getFF_Case scrut) unitJoinFloat :: OutBind -> JoinFloats unitJoinFloat bind = assert (all isJoinId (bindersOf bind)) $ @@ -978,12 +1020,34 @@ addLetFloats :: SimplFloats -> LetFloats -> SimplFloats -- Add the let-floats for env2 to env1; -- *plus* the in-scope set for env2, which is bigger -- than that for env1 -addLetFloats floats let_floats +addLetFloats floats let_floats@(LetFloats fbs _) = floats { sfLetFloats = sfLetFloats floats `addLetFlts` let_floats - , sfInScope = sfInScope floats `extendInScopeFromLF` let_floats } - -extendInScopeFromLF :: InScopeSet -> LetFloats -> InScopeSet -extendInScopeFromLF in_scope (LetFloats binds _) + , sfInScope = sfInScope floats `extendInScopeFromFB` fbs } + +addFloatBindsF :: FloatBinds -> SimplFloats -> SimplFloats +-- (addFloatBindsF new_fbs floats) adds `new_fbs` /outside/ `floats`; +-- i.e. `new_fbs` scope over `floats` +-- Precondition: every FloatLet in `new_fbs` satisfies the let-can-float +-- invariant (see the FloatBind declaration in GHC.Core), so we can add +-- them directly; see Note [LetFloats] +addFloatBindsF new_fbs floats@(SimplFloats { sfLetFloats = LetFloats lf_fbs lf_ff + , sfInScope = in_scope }) + | isNilOL new_fbs + = floats + | otherwise + = assertPpr (all ok_float new_fbs) (ppr new_fbs) $ + floats { sfLetFloats = LetFloats (new_fbs `appOL` lf_fbs) + (foldr (andFF . getFF) lf_ff new_fbs) + , sfInScope = in_scope `extendInScopeFromFB` new_fbs } + where + -- Check the invariants on FloatBind; see its declaration in GHC.Core + ok_float (FloatLet (NonRec b r)) + | isId b, not (isCoVar b) = not (needsCaseBinding (idType b) r) + ok_float (FloatTick t) = tickishHasSoftScope t + ok_float _ = True + +extendInScopeFromFB :: InScopeSet -> FloatBinds -> InScopeSet +extendInScopeFromFB in_scope binds = foldlOL extend in_scope binds where extend in_scope (FloatLet bind) = in_scope `extendInScopeSetBind` bind ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -66,7 +66,7 @@ import GHC.Builtin.WiredIn.Ids( seqId ) import qualified GHC.Data.List.Infinite as Inf import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString -import GHC.Data.OrdList ( fromOL ) -- TMP +import GHC.Data.OrdList ( unitOL ) import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -1287,7 +1287,8 @@ simplExprF1 env expr@(Lam {}) cont -- and likewise drop counts all binders (incl type lambdas) simplExprF1 env expr@(Case scrut bndr _ alts) cont - | Just (inner, outer) <- splitContForNoCaseCase env cont + | Just (inner, outer) <- splitContForNoCaseCase env (isSingleton alts) cont + -- isSingleton: push casts inside only if there is just one alternative -- See (COC-INV) in Note [sm_case_case: switching off case continuations] = do { (floats, expr') <- simplExprF env expr inner ; rebuildWithFloats env floats expr' outer } @@ -1314,9 +1315,12 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont tick (PreInlineUnconditionally bndr) ; simplExprF env' body cont } -simplExprF1 env expr@(Let {}) cont - | Just (inner, outer) <- splitContForNoCaseCase env cont +simplExprF1 env expr@(Let bind _) cont + | Just (inner, outer) <- splitContForNoCaseCase env (not (mightBeJoinBind bind)) cont -- See (COC-INV) in Note [sm_case_case: switching off case continuations] + -- mightBeJoinBind: do not push a cast into a join point's RHS, because + -- then we'd have to push it to every jump, including those in + -- multi-alternative cases, where we don't want to push casts = do { (floats, expr') <- simplExprF env expr inner ; rebuildWithFloats env floats expr' outer } @@ -1342,13 +1346,22 @@ simplExprF1 env (Let (Rec pairs) body) cont simplRecE env pairs body cont -splitContForNoCaseCase :: SimplEnv -> SimplCont +mightBeJoinBind :: InBind -> Bool +-- True if joinPointBind_maybe might succeed; cheap and conservative +mightBeJoinBind bind = any might_be_join (bindersOf bind) + where + might_be_join b = isId b && (isJoinId b || isAlwaysTailCalled (idOccInfo b)) + +splitContForNoCaseCase :: SimplEnv + -> Bool -- True <=> casts may go in `inner` + -> SimplCont -> Maybe (SimplCont, SimplCont) -- When seCaseCase is off, this function splits `cont` into (inner, outer), --- where `inner` has only applications, and `outer` is non-trivial -splitContForNoCaseCase env cont +-- where `inner` has only applications (and perhaps casts), and `outer` is +-- non-trivial. See splitContArgs for the Bool. +splitContForNoCaseCase env push_casts cont | seCaseCase env = Nothing - | otherwise = splitContArgs cont + | otherwise = splitContArgs push_casts cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1503,10 +1516,16 @@ simplTick env tickish expr cont -- push the continuation inside the tick. This has the effect of moving the -- tick to the outside of a case or application context, allowing the normal -- 'case' and 'application' optimisations to fire. + -- + -- We return the tick as a FloatTick, /outside/ the floats from `expr`. + -- So all the code that was covered by the tick (including the floats, + -- notably single-alternative case floats) remains covered, as soft scope + -- requires; and yet `expr'` is exposed to the caller, e.g. for + -- case-of-known-constructor in rebuildWithFloats. + -- See Note [FloatFlag for FloatTick] in GHC.Core.Opt.Simplify.Env | tickishHasSoftScope tickish = do { (floats, expr') <- simplExprF env expr cont - ; return (floats, mkTick tickish expr') - } + ; return (unitOL (FloatTick tickish) `addFloatBindsF` floats, expr') } -- Push tick inside if the context looks like this will allow us to -- do a case-of-case - see Note [case-of-scc-of-case] @@ -2431,7 +2450,7 @@ simplOutId env fun cont , ApplyToTy { sc_cont = cont2 } <- cont1 , ApplyToVal { sc_cont = cont3, sc_arg = arg, sc_env = arg_se , sc_cast = arg_mco, sc_hole_ty = fun_ty } <- cont2 - = case splitContForNoCaseCase env cont3 of + = case splitContForNoCaseCase env True cont3 of Nothing -> do { e' <- simplRunRW env fun arg arg_se arg_mco fun_ty cont3 ; return (emptyFloats env, e') } Just (ink,outk) -> do { e' <- simplRunRW env fun arg arg_se arg_mco fun_ty ink @@ -2838,14 +2857,10 @@ fireRuleAFTER env rule_match arg_specs cont | RM { rm_rule = rule, rm_rhs = rhs, rm_args = rhs_args , rm_floats = float_bs } <- rule_match = do { let env' = env `addNewInScopeIds` floatsBinders float_bs - ; (floats, e') <- simplExprF env' rhs $ - pushOutArgs (exprType rhs) rhs_args $ - pushArgSpecs (drop (ruleArity rule) arg_specs) cont - ; return $ - if isEmptyFloatBinds float_bs -- Not very pretty - then (floats, e') - else (emptyFloats env', GHC.Core.Make.wrapFloats float_bs $ - wrapFloats floats e') } + ; addFloatBinds (contHoleScaling cont) float_bs $ + simplExprF env' rhs $ + pushOutArgs (exprType rhs) rhs_args $ + pushArgSpecs (drop (ruleArity rule) arg_specs) cont } tryRules :: SimplEnv -> [CoreRule] @@ -3553,7 +3568,6 @@ robust here. (Otherwise, there's a danger that we'll simply drop the Note [Scaling in case-of-case] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - When two cases commute, if done naively, the multiplicities will be wrong: case (case u of w[1] { (x[1], y[1]) } -> f x y) of w'[Many] @@ -3991,22 +4005,22 @@ All this should happen in one sweep. Note [FloatBinds from constructor wrappers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we have FloatBinds coming from the constructor wrapper -(as in Note [exprIsConApp_maybe on data constructors with wrappers]), -we cannot float past them. We'd need to float the FloatBind -together with the simplify floats, unfortunately the -simplifier doesn't have case-floats. The simplest thing we can -do is to wrap all the floats here. The next iteration of the -simplifier will take care of all these cases and lets. +exprIsConApp_maybe may return FloatBinds, e.g. coming from a constructor +wrapper (as in Note [exprIsConApp_maybe on data constructors with wrappers]), +or from looking through lets and single-alternative cases in the scrutinee. +These floats scope over the result of case-of-known-constructor. + +Since the Simplifier's floats can contain case-floats as well as let-floats +(see Note [LetFloats] in GHC.Core.Opt.Simplify.Env), we simply add them to +the SimplFloats, outside the floats from simplifying the alternative; see +knownConCase_maybe. We do not wrap them around the result, because then a +subsequent case-of-known-constructor on the result would have to walk +through them all over again, which can be quadratic (#27737). Given data T = MkT !Bool, this allows us to simplify case $WMkT b of { MkT x -> f x } to case b of { b' -> f b' }. - -We could try and be more clever (like maybe `wfloats` only contains -let binders, so we could float them). But the need for the extra -complication is not clear. -} knownConCase_maybe :: (SimplAltFlag, SimplEnv) @@ -4033,58 +4047,27 @@ knownConCase_maybe (saf,env) scrut case_bndr alts cont -- as well as when it's an explicit constructor application , let env0 = setInScopeSet env in_scope' = Just $ - (if isEmptyFloatBinds wfloats then id else - pprTrace "TMP-knownCon" (vcat [ text "nfloats" <+> ppr (length (fromOL wfloats)) - , text "scrut" <+> ppr scrut ])) $ do { tick (KnownBranch case_bndr) ; let -- case_bndr_unf: see Note [Do not duplicate constructor applications] case_bndr_rhs | exprIsTrivial scrut = scrut | otherwise = con_app con_app = Var (dataConWorkId con) `mkTyApps` ty_args `mkApps` other_args - ; wrapDataConFloats env wfloats case_bndr cont $ + -- The wfloats scope over the result + -- See Note [FloatBinds from constructor wrappers] + ; addFloatBinds hole_scaling wfloats $ case findAlt (DataAlt con) alts of Nothing -> missingAlt env0 case_bndr alts cont Just (Alt DEFAULT bs rhs) -> simpl_rhs env0 case_bndr_rhs bs rhs Just (Alt _ bs rhs) -> knownCon env0 scrut con other_args - case_bndr bs rhs cont - } + case_bndr bs rhs cont } | otherwise = Nothing where - simpl_rhs env case_bndr_rhs bs rhs - = assert (null bs) $ - do { (floats1, env') <- simplAuxBind (saf,env) case_bndr case_bndr_rhs - -- scrut is a constructor application, - -- hence satisfies let-can-float invariant - ; (floats2, expr') <- simplExprF env' rhs cont - ; return (floats1 `addFloats` floats2, expr') } - -wrapDataConFloats :: SimplEnv -> FloatBinds -> InId -> SimplCont - -> SimplM (SimplFloats, OutExpr) - -> SimplM (SimplFloats, OutExpr) --- See Note [FloatBinds from constructor wrappers] -wrapDataConFloats env wfloats case_bndr cont thing_inside - | isEmptyFloatBinds wfloats - = thing_inside - | otherwise - = do { (floats, expr) <- thing_inside - ; return ( emptyFloats env - , GHC.Core.Make.wrapFloats (fmap scale_float wfloats) $ - wrapFloats floats expr ) } - where - -- scale_float scales case-floats by the multiplicity of the continuation hole - -- (see Note [Scaling in case-of-case]). - -- Let floats are _not_ scaled, because they are aliases anyway. - scale_float (GHC.Core.FloatCase scrut case_bndr con vars) - = GHC.Core.FloatCase scrut (scale_id case_bndr) con (map scale_id vars) - scale_float flt@(GHC.Core.FloatLet {}) = flt - scale_float flt@(GHC.Core.FloatTick {}) = flt - - scale_id id = scaleVarBy holeScaling id - - holeScaling = contHoleScaling cont `mkMultMul` idMult case_bndr + hole_scaling = idMult case_bndr `mkMultMul` contHoleScaling cont + -- See Note [Scaling in case-of-case] + -- This is the contHoleScaling of the original Select continuation -- We are in the following situation -- case[p] case[q] u of { D x -> C v } of { C x -> w } -- And we are producing case[??] u of { D x -> w[x\v]} @@ -4100,6 +4083,33 @@ wrapDataConFloats env wfloats case_bndr cont thing_inside -- Which is ill-typed with respect to linearity. So it needs to be a -- case[Many]. + simpl_rhs env case_bndr_rhs bs rhs + = assert (null bs) $ + do { (floats1, env') <- simplAuxBind (saf,env) case_bndr case_bndr_rhs + -- scrut is a constructor application, + -- hence satisfies let-can-float invariant + ; (floats2, expr') <- simplExprF env' rhs cont + ; return (floats1 `addFloats` floats2, expr') } + +addFloatBinds :: Mult -> FloatBinds + -> SimplM (SimplFloats, a) -> SimplM (SimplFloats, a) +-- (addFloatBinds scaling fbs thing_inside) adds `fbs` outside the floats +-- returned by `thing_inside`. The `scaling` is the multiplicity of the +-- continuation hole, by which case-floats are scaled, because they now +-- scope over that continuation: see Note [Scaling in case-of-case]. +-- Let floats do not need this treatment +addFloatBinds scaling fbs thing_inside + | isEmptyFloatBinds fbs -- Short cut + = thing_inside + | otherwise + = do { (floats, res) <- thing_inside + ; return (fmap scale_float fbs `addFloatBindsF` floats, res) } + where + scale_float (FloatCase scrut b con vars) + = FloatCase scrut (scale_id b) con (map scale_id vars) + scale_float flt = flt + + scale_id id = scaleVarBy scaling id knownCon :: SimplEnv -> OutExpr -- The scrutinee ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -632,19 +632,24 @@ contOutArgs env cont -- No more arguments go _ = [] -splitContArgs :: SimplCont -> Maybe (SimplCont, SimplCont) --- Splits `cont` into (inner, outer), where `inner` has only --- applications and casts, and `outer` is non-trivial -splitContArgs cont@(ApplyToTy { sc_cont = cont1 }) - = do { (inner, outer) <- splitContArgs cont1 +splitContArgs :: Bool -> SimplCont -> Maybe (SimplCont, SimplCont) +-- (splitContArgs push_casts cont) splits `cont` into (inner, outer), where +-- `inner` has only applications, and casts if `push_casts` is True; +-- and `outer` is non-trivial. +-- The caller sets `push_casts` to False if `inner` will be pushed into many +-- case alternatives: pushing a cast into each of them duplicates the +-- coercion, which can be big (T5642) +splitContArgs push_casts cont@(ApplyToTy { sc_cont = cont1 }) + = do { (inner, outer) <- splitContArgs push_casts cont1 ; return (cont { sc_cont = inner }, outer) } -splitContArgs cont@(ApplyToVal { sc_cont = cont1 }) - = do { (inner, outer) <- splitContArgs cont1 +splitContArgs push_casts cont@(ApplyToVal { sc_cont = cont1 }) + = do { (inner, outer) <- splitContArgs push_casts cont1 ; return (cont { sc_cont = inner }, outer) } -splitContArgs cont@(CastIt { sc_cont = cont1 }) - = do { (inner, outer) <- splitContArgs cont1 +splitContArgs push_casts cont@(CastIt { sc_cont = cont1 }) + | push_casts + = do { (inner, outer) <- splitContArgs push_casts cont1 ; return (cont { sc_cont = inner }, outer) } -splitContArgs outer +splitContArgs _ outer | contIsStop outer = Nothing | otherwise = -- pprTrace "splitContHoleType" (ppr hole_ty) $ return (mkBoringStop hole_ty, outer) ===================================== testsuite/tests/dmdanal/should_compile/T20510.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Exitification transformation ==================== Result size of Exitification transformation - = {terms: 50, types: 22, coercions: 0, joins: 2/2} + = {terms: 33, types: 15, coercions: 0, joins: 2/2} -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} lvl :: Int @@ -11,7 +11,7 @@ lvl :: Int Guidance=IF_ARGS [] 10 10}] lvl = GHC.Internal.Types.I# 0# --- RHS size: {terms: 32, types: 14, coercions: 0, joins: 2/2} +-- RHS size: {terms: 29, types: 12, coercions: 0, joins: 2/2} small :: Int -> Int [LclIdX, Arity=1, @@ -22,7 +22,7 @@ small :: Int -> Int Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (x [Dmd=S!P(SL)] :: Int) -> joinrec { - go [InlPrag=[2], Occ=T[2], Dmd=LC(S,C(1,!P(L)))] + go [InlPrag=[2], Occ=Many(T[2]), Dmd=LC(S,C(1,!P(L)))] :: Int -> Int -> Int [LclId[JoinId(2)(Nothing)], Arity=2, @@ -54,11 +54,11 @@ small :: Int -> Int Guidance=IF_ARGS [0 51] 63 10}] $wgo (ww [Occ=Once2] :: GHC.Internal.Prim.Int#) (ww [Occ=Once1!, Dmd=SL] :: GHC.Internal.Prim.Int#) - = case ww of ds { + = case ww of wild { __DEFAULT -> jump go - (GHC.Internal.Types.I# (GHC.Internal.Prim.+# ww ds)) - (GHC.Internal.Types.I# (GHC.Internal.Prim.-# ds 1#)); + (GHC.Internal.Types.I# (GHC.Internal.Prim.+# ww wild)) + (GHC.Internal.Types.I# (GHC.Internal.Prim.-# wild 1#)); 0# -> case x of { GHC.Internal.Types.I# y [Occ=Once1] -> GHC.Internal.Types.I# (GHC.Internal.Prim.*# ww y) @@ -67,13 +67,12 @@ small :: Int -> Int jump go lvl x}] small = \ (x [Dmd=S!P(SL)] :: Int) -> + case x of { GHC.Internal.Types.I# ww [Dmd=SL] -> join { exit :: GHC.Internal.Prim.Int# -> Int [LclId[JoinId(1)(Nothing)]] exit (ww :: GHC.Internal.Prim.Int#) - = case x of { GHC.Internal.Types.I# y -> - GHC.Internal.Types.I# (GHC.Internal.Prim.*# ww y) - } } in + = GHC.Internal.Types.I# (GHC.Internal.Prim.*# ww ww) } in joinrec { $wgo [InlPrag=[2], Occ=LoopBreaker] :: GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Int @@ -82,56 +81,17 @@ small Str=<L><SL>, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [0 32] 43 10}] + Guidance=IF_ARGS [0 32] 33 10}] $wgo (ww :: GHC.Internal.Prim.Int#) (ww [Dmd=SL] :: GHC.Internal.Prim.Int#) - = case ww of ds { + = case ww of wild { __DEFAULT -> jump $wgo - (GHC.Internal.Prim.+# ww ds) (GHC.Internal.Prim.-# ds 1#); + (GHC.Internal.Prim.+# ww wild) (GHC.Internal.Prim.-# wild 1#); 0# -> jump exit ww }; } in - case x of { GHC.Internal.Types.I# ww [Dmd=SL] -> jump $wgo 0# ww } - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$trModule :: GHC.Internal.Prim.Addr# -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -$trModule = "main"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$trModule :: GHC.Internal.Types.TrName -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -$trModule = GHC.Internal.Types.TrNameS $trModule - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$trModule :: GHC.Internal.Prim.Addr# -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -$trModule = "T20510"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$trModule :: GHC.Internal.Types.TrName -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -$trModule = GHC.Internal.Types.TrNameS $trModule - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T20510.$trModule :: GHC.Internal.Types.Module -[LclIdX, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T20510.$trModule = GHC.Internal.Types.Module $trModule $trModule + jump $wgo 0# ww + } ===================================== testsuite/tests/show-bytecode/show-bytecode-hpc.stdout ===================================== @@ -59,135 +59,133 @@ objects: arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: named item ‘primes’ - object ‘primes2_@name_suffix@’: + object ‘primes’: arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: - object ‘primes2_sat_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: - object ‘primes2_sat_@name_suffix@’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - word 3 - info table of ‘IS’ - used items: - named item ‘$fNumNatural’ - named item ‘fromInteger’ - named item ‘$fEnumNatural’ - named item ‘enumFrom’ - object ‘primes2_sat_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: named item ‘isPrime_@name_suffix@’ - named item ‘filter’ - object ‘isPrime_@name_suffix@’: - arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ + info table of ‘(:)’ used items: - object ‘isPrime_sat_@name_suffix@’: + object ‘isPrime_@name_suffix@’: arity: 1 - literals: label ‘_hpc_tickboxes_Example_hpc’ + literals: + label ‘_hpc_tickboxes_Example_hpc’ used items: - object ‘isPrime_sat_@name_suffix@’: + object ‘isPrime_primes_sat_@name_suffix@’: arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: - object ‘isPrime_sat_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: named item ‘primes’ - object ‘isPrime_sat_@name_suffix@’: + object ‘isPrime_primes_sat_@name_suffix@’: arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: - object ‘isPrime_sat_@name_suffix@’: + object ‘isPrime_primes_sat_@name_suffix@’: arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: - object ‘v_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: - named item ‘$fIntegralInteger’ - named item ‘$fNumNatural’ - named item ‘(^)’ - object ‘v1_@name_suffix@’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - word 2 - info table of ‘IS’ - used items: <none> - object ‘pap_@name_suffix@’: - arity: 3 - literals: <none> - used items: <none> - object ‘isPrime_sat_@name_suffix@’: + used items: named item ‘primes’ + object ‘isPrime_primes_sat_@name_suffix@’: arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: - object ‘v_@name_suffix@’: + object ‘isPrime_primes_sat_@name_suffix@’: arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: - named item ‘$fOrdNatural’ - named item ‘(<=)’ - object ‘v1_@name_suffix@’: + object ‘v_@name_suffix@’: + arity: 0 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + named item ‘$fIntegralInteger’ + named item ‘$fNumNatural’ + named item ‘(^)’ + object ‘v1_@name_suffix@’: + arity: 0 + literals: + label ‘_hpc_tickboxes_Example_hpc’ + word 2 + info table of ‘IS’ + used items: <none> + object ‘pap_@name_suffix@’: + arity: 3 + literals: <none> + used items: <none> + object ‘isPrime_primes_sat_@name_suffix@’: arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: <none> + used items: + object ‘v_@name_suffix@’: + arity: 0 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + named item ‘$fOrdNatural’ + named item ‘(<=)’ + object ‘v1_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: <none> + object ‘pap_@name_suffix@’: + arity: 3 + literals: <none> + used items: <none> + named item ‘(.)’ + named item ‘takeWhile’ + object ‘isPrime_primes_sat_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + object ‘v_@name_suffix@’: + arity: 0 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: object ‘pap_@name_suffix@’: - arity: 3 + arity: 2 literals: <none> - used items: <none> - named item ‘(.)’ - named item ‘takeWhile’ - object ‘isPrime_sat_@name_suffix@’: - arity: 1 + used items: + named item ‘$fIntegralNatural’ + named item ‘divides’ + object ‘v1_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: <none> + object ‘pap_@name_suffix@’: + arity: 3 + literals: <none> + used items: <none> + named item ‘$fFoldableList’ + named item ‘any’ + named item ‘not’ + object ‘primes_sat_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + object ‘primes_sat_@name_suffix@’: + arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: - object ‘v_@name_suffix@’: + object ‘primes_sat_@name_suffix@’: arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ + literals: + label ‘_hpc_tickboxes_Example_hpc’ + word 3 + info table of ‘IS’ used items: - object ‘pap_@name_suffix@’: - arity: 2 - literals: <none> - used items: - named item ‘$fIntegralNatural’ - named item ‘divides’ - object ‘v1_@name_suffix@’: - arity: 1 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: <none> - object ‘pap_@name_suffix@’: - arity: 3 - literals: <none> - used items: <none> - named item ‘$fFoldableList’ - named item ‘any’ - named item ‘not’ - object ‘primes’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - info table of ‘(:)’ - used items: - named item ‘primes2_@name_suffix@’ - named item ‘primes1_@name_suffix@’ - object ‘primes1_@name_suffix@’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - word 2 - info table of ‘IS’ - used items: - named item ‘$fNumNatural’ - named item ‘fromInteger’ + named item ‘$fNumNatural’ + named item ‘fromInteger’ + named item ‘$fEnumNatural’ + named item ‘enumFrom’ + object ‘primes_sat_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: <none> + named item ‘filter’ + object ‘primes_sat_@name_suffix@’: + arity: 0 + literals: + label ‘_hpc_tickboxes_Example_hpc’ + word 2 + info table of ‘IS’ + used items: + named item ‘$fNumNatural’ + named item ‘fromInteger’ object ‘fibonaccisPtr’: arity: 0 literals: @@ -245,63 +243,59 @@ objects: arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ used items: named item ‘fibonaccis’ - object ‘positiveFibonaccis1_@name_suffix@’: + object ‘fibonaccis’: arity: 0 literals: label ‘_hpc_tickboxes_Example_hpc’ info table of ‘(:)’ used items: - named item ‘positiveFibonaccis2_@name_suffix@’ - named item ‘positiveFibonaccis_@name_suffix@’ - object ‘positiveFibonaccis2_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: - object ‘positiveFibonaccis2_sat_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: named item ‘positiveFibonaccis1_@name_suffix@’ - object ‘positiveFibonaccis2_sat_@name_suffix@’: - arity: 0 + object ‘positiveFibonaccis_@name_suffix@’: + arity: 1 + literals: + label ‘_hpc_tickboxes_Example_hpc’ + info table of ‘(:)’ + used items: + object ‘positiveFibonaccis_fibonaccis_sat_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + object ‘positiveFibonaccis_fibonaccis_sat_@name_suffix@’: + arity: 1 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: <none> + object ‘positiveFibonaccis_fibonaccis_sat_@name_suffix@’: + arity: 0 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: named item ‘fibonaccis’ + object ‘positiveFibonaccis_fibonaccis_sat_@name_suffix@’: + arity: 0 + literals: label ‘_hpc_tickboxes_Example_hpc’ + used items: + named item ‘$fNumNatural’ + named item ‘(+)’ + named item ‘zipWith’ + object ‘positiveFibonaccis_fibonaccis_sat_@name_suffix@’: + arity: 0 + literals: + label ‘_hpc_tickboxes_Example_hpc’ + word 1 + info table of ‘IS’ + used items: + named item ‘$fNumNatural’ + named item ‘fromInteger’ + object ‘fibonaccis_sat_@name_suffix@’: + arity: 1 literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: named item ‘fibonaccis’ - object ‘positiveFibonaccis2_sat_@name_suffix@’: + used items: <none> + object ‘fibonaccis_sat_@name_suffix@’: arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ + literals: + label ‘_hpc_tickboxes_Example_hpc’ + word 0 + info table of ‘IS’ used items: named item ‘$fNumNatural’ - named item ‘(+)’ - named item ‘zipWith’ - object ‘fibonaccis’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - info table of ‘(:)’ - used items: - named item ‘fibonaccis2_@name_suffix@’ - named item ‘fibonaccis1_@name_suffix@’ - object ‘fibonaccis2_@name_suffix@’: - arity: 0 - literals: label ‘_hpc_tickboxes_Example_hpc’ - used items: named item ‘positiveFibonaccis1_@name_suffix@’ - object ‘positiveFibonaccis_@name_suffix@’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - word 1 - info table of ‘IS’ - used items: - named item ‘$fNumNatural’ - named item ‘fromInteger’ - object ‘fibonaccis1_@name_suffix@’: - arity: 0 - literals: - label ‘_hpc_tickboxes_Example_hpc’ - word 0 - info table of ‘IS’ - used items: - named item ‘$fNumNatural’ - named item ‘fromInteger’ + named item ‘fromInteger’ object ‘$dTypeable2_@name_suffix@’: arity: 0 literals: <none> View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9fdc56f3402665cecde73d79d6ae05… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9fdc56f3402665cecde73d79d6ae05… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/davide/windows-dlls_sysm-test_master] Add golden test for rts/RtsSymbols.c
by David Eichmann (＠DavidEichmann) 09 Oct '26

09 Oct '26

David Eichmann pushed to branch wip/davide/windows-dlls_sysm-test_master at Glasgow Haskell Compiler / GHC Commits: 31a14e51 by David Eichmann at 2026-10-09T17:33:28+01:00 Add golden test for rts/RtsSymbols.c The test compares declared symbols against symbols observed in the rts DSO (dll/so) by the llvm-readobj tool. - - - - - 7 changed files: - testsuite/driver/runtests.py - + testsuite/tests/rts/symbols/Main.hs - + testsuite/tests/rts/symbols/Makefile - + testsuite/tests/rts/symbols/all.T - + testsuite/tests/rts/symbols/dumpDeclaredSymbols.c - + testsuite/tests/rts/symbols/rts-check-symbols.sh - + testsuite/tests/rts/symbols/rts-check-symbols.stdout Changes: ===================================== testsuite/driver/runtests.py ===================================== @@ -284,32 +284,36 @@ def format_path(path): # On Windows we need to set $PATH to include the paths to all the DLLs # in order for the dynamic library tests to work. if windows: + # Add mingw to PATH + topdir = config.libdir + mingw = os.path.abspath(os.path.join(topdir, '../mingw/bin')) + mingw = format_path(mingw) + ghc_env['PATH'] = os.pathsep.join([ghc_env.get("PATH", ""), mingw]) + + # Add ghc packages to PATH try: - pkginfo = getStdout([config.ghc_pkg, 'dump']) + pkgs = getStdout([config.ghc_pkg, '--simple-output', 'list']) except FileNotFoundError as err: # This can happen when we are only running tests which don't depend on ghc (ie linters) # In that case we probably haven't built ghc-pkg yet so this query will fail. print (err) print ("Failed to call ghc-pkg for windows path modification... some tests might fail") - pkginfo = "" - topdir = config.libdir - mingw = os.path.abspath(os.path.join(topdir, '../mingw/bin')) - mingw = format_path(mingw) - ghc_env['PATH'] = os.pathsep.join([ghc_env.get("PATH", ""), mingw]) - for line in pkginfo.split('\n'): - if line.startswith('library-dirs:'): - path = line.rstrip() - path = str_removeprefix(path, 'library-dirs: ') - # Use string.replace instead of re.sub, because re.sub - # interprets backslashes in the replacement string as - # escape sequences. - path = path.replace('$topdir', topdir) + pkgs = "" + + newPaths = set() + pkgs = pkgs.split(' ') + for pkg in pkgs: + for field in ['library-dirs', 'dynamic-library-dirs']: + path = getStdout([config.ghc_pkg, '--simple-output', 'field', pkg, field]) + path = path.strip() if path.startswith('"'): path = re.sub('^"(.*)"$', '\\1', path) path = re.sub('\\\\(.)', '\\1', path) + path = format_path(path) + newPaths.add(path) - path = format_path(path) - ghc_env['PATH'] = os.pathsep.join([path, ghc_env.get("PATH", "")]) + for path in newPaths: + ghc_env['PATH'] = os.pathsep.join([path, ghc_env.get("PATH", "")]) testopts_ctx_var.set(TestOptions()) ===================================== testsuite/tests/rts/symbols/Main.hs ===================================== @@ -0,0 +1,124 @@ +import qualified Data.Map.Lazy as M +import qualified Data.Set as S +import Data.List (isSuffixOf, stripPrefix) +import Data.Maybe (mapMaybe) +import System.Environment (getArgs) + +main :: IO () +main = do + args <- getArgs + case args of + ["dump"] -> dumpDeclaredSymbols + ["diff", objType, declaredSymbolsFile, observedSymbolsFile] -> do + parseObserved <- case objType of + "elf" -> return elfSymbols + "windows" -> return importLibSymbols + _ -> fail ("Unknown object type: " ++ objType) + diffStr <- diff + <$> (readCodeOrData <$$> linePairs <$> readFile declaredSymbolsFile) + <*> (parseObserved <$> readFile observedSymbolsFile) + -- writeFile "<ghc root>/testsuite/tests/rts/symbols/rts-check-symbols.stdout" + putStrLn diffStr + _ -> fail ("Unexpected arguments: " ++ show args) + where + (<$$>) = fmap . fmap + +foreign import ccall "dumpDeclaredSymbols" + dumpDeclaredSymbols :: IO () + +data CodeOrData = Code | Data + deriving (Show, Eq) + +-- Compare observedSymbols (symbols observed in the DSO) to declaredSymbols +-- (symbols declared in RtsSymbols.c) +diff :: M.Map String CodeOrData -> M.Map String CodeOrData -> String +diff declaredSymbols observedSymbols = unlines $ + [ "Symbols declared in RtsSymbols.c but not observed in the DSO:" ] + ++ [ "Declared> " ++ k ++ " " ++ show v | (k, v) <- M.toList diffInDeclaredSymbols ] + ++ [ "" ] + ++ [ "Symbols observed in the DSO but not declared in RtsSymbols.c:" ] + ++ [ "Observed> " ++ k ++ " " ++ show v | (k, v) <- M.toList diffInObservedSymbols ] + ++ [ "" ] + ++ [ "Symbols observed in the DSO and declared in RtsSymbols.c but with conflicting type:" ] + ++ [ "WrongType> " ++ k ++ " (declared, observed): (" ++ show declared ++ ", " ++ show observed ++ ")" + | (k, (declared, observed)) <- M.toList diffOnType ] + where + -- Undeclared observed symbols + diffInObservedSymbols :: M.Map String CodeOrData + diffInObservedSymbols = observedSymbols M.\\ declaredSymbols + + -- Declared unobserved symbols + diffInDeclaredSymbols :: M.Map String CodeOrData + diffInDeclaredSymbols = declaredSymbols M.\\ observedSymbols + + -- Declared observed symbols with conflicting type + diffOnType :: M.Map String (CodeOrData, CodeOrData) + diffOnType = M.filter (\(a, b) -> a /= b) $ M.intersectionWith (,) declaredSymbols observedSymbols + +linePairs :: String -> M.Map String String +linePairs = M.fromList . map (\str -> let [a,b] = words str in (a,b)) . filter (/= "") . lines + +readCodeOrData :: String -> CodeOrData +readCodeOrData s = case s of + "code" -> Code + "data" -> Data + _ -> error ("Unknown symbol type: " ++ show s) + +-- | Parse the output of @readelf -W --dyn-syms@ of an ELF shared object. +-- +-- Symbol lines look like: +-- +-- > Num: Value Size Type Bind Vis Ndx Name +-- > 2: 0000000000000000 0 FUNC GLOBAL DEFAULT UND tcsetattr@GLIBC_2.2.5 (2) +-- > 1149: 000000000006d020 190 OBJECT GLOBAL DEFAULT 12 stg_AP_info +-- +-- Note that Vis may be followed by extra annotations on some platforms (e.g. +-- @[<localentry>: 8]@ on ppc64le), so Ndx and Name are taken from the end of +-- the line. +elfSymbols :: String -> M.Map String CodeOrData +elfSymbols = M.fromList . mapMaybe parseLine . lines + where + parseLine l = case words l of + (num : _value : _size : ty : bind : rest) + | ":" `isSuffixOf` num + , name : ndx : _ <- reverse (dropVersionIndex rest) + , bind == "GLOBAL" + , ndx /= "UND" -- Imports + -> (,) name <$> typeToCodeOrData ty + _ -> Nothing + + -- Drop the trailing version index e.g. "(2)" + dropVersionIndex ws = case reverse ws of + ('(' : _) : ws' -> reverse ws' + _ -> ws + + -- Returns Nothing if the symbol should be ignored + typeToCodeOrData :: String -> Maybe CodeOrData + typeToCodeOrData ty = case ty of + "FILE" -> Nothing + "NOTYPE" -> Nothing + "FUNC" -> Just Code + "OBJECT" -> Just Data + _ -> error ("Unknown symbol type: " ++ show ty) + +-- | Parse the output of @nm -P@ into (name, type letter) pairs. Lines that are +-- not symbols (e.g. the archive member headers printed for import libraries) +-- are ignored. +parseNm :: String -> [(String, Char)] +parseNm = mapMaybe parseLine . lines + where + parseLine l = case words l of + (name : [ty] : _) -> Just (name, ty) + _ -> Nothing + +-- | Interpret the symbols of a windows import library. Every export @foo@ has +-- an import address table entry @__imp_foo@, but only code exports also have +-- a @foo@ thunk. +importLibSymbols :: String -> M.Map String CodeOrData +importLibSymbols nmOutput = M.fromList + [ (name, if name `S.member` defined then Code else Data) + | name <- mapMaybe (stripPrefix "__imp_") (S.toList defined) + ] + where + defined :: S.Set String + defined = S.fromList [ name | (name, ty) <- parseNm nmOutput, ty /= 'U' ] ===================================== testsuite/tests/rts/symbols/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# This makefile rule only exists because TEST_HC is set in boilerplate.mk +# and otherwise the TEST_HC variable wouldn't be set in the context of the bash script +rts-check-symbols: + '$(TEST_HC)' $(TEST_HC_OPTS) -package containers -dynamic dumpDeclaredSymbols.c Main.hs -o Main > /dev/null + GHC_PKG="$(GHC_PKG)" GHC="$(TEST_HC)" ./rts-check-symbols.sh ===================================== testsuite/tests/rts/symbols/all.T ===================================== @@ -0,0 +1,6 @@ +test('rts-check-symbols', [ + unless(have_dynamic(), skip), + extra_files(['rts-check-symbols.sh', 'dumpDeclaredSymbols.c', 'Main.hs'])], + makefile_test, + [] +) ===================================== testsuite/tests/rts/symbols/dumpDeclaredSymbols.c ===================================== @@ -0,0 +1,26 @@ + +#include "Rts.h" +#include "rts/RtsSymbols.h" + +#include <stdio.h> + +void dumpDeclaredSymbols(void); + +void dumpDeclaredSymbols(void) { + const RtsSymbolVal * declaredSyms = getRtsSymbols(); + for (const RtsSymbolVal * sym = &declaredSyms[0]; sym->lbl; sym++) { + // Ignore hidden + if (sym->type & SYM_TYPE_HIDDEN) continue; + + char * type = NULL; + if (sym->type & SYM_TYPE_CODE) { + type = "code"; + } else if (sym->type & (SYM_TYPE_DATA | SYM_TYPE_INDIRECT_DATA)) { + type = "data"; + } + + if (type) { + printf("%s %s\n", sym->lbl, type); + } + } +} ===================================== testsuite/tests/rts/symbols/rts-check-symbols.sh ===================================== @@ -0,0 +1,60 @@ +#!/usr/bin/env bash + +# +# Check the diff between symbols exported from the RTS and those listed in RtsSymbols.c +# + +DECLARED_SYMBOLS=declared_symbols.txt +OBSERVED_SYMBOLS=observed_symbols.txt + +# Discover if we're on windows +case "$OSTYPE" in + "cygwin") + TYPE="windows" + ;; + + *) + TYPE="elf" + ;; +esac + +# Get rts Symbols listed in RtsSymbols.c +./Main dump | sort > $DECLARED_SYMBOLS + +# Get rts DLL exports from the DLL +# Match e.g.: +# libHSrts-1.0.3-ghc9.15.20260710.dll => /home/alice/s p a c e/myApp/bin/libHSrts-1.0.3-ghc9.15.20260710.dll (0x7ffebc9a0000) +RTS_DYLIB_PATH=$(ldd ./Main | awk '/^[[:space:]]*libHSrts-.* => .+$/ { + sub(/^[[:space:]]*libHSrts-.* => /, "") + sub(/ $[^(]*$$/, "") + print +}') + +if [ -z "$RTS_DYLIB_PATH" -o "$RTS_DYLIB_PATH" = "not found"]; then + echo "Could not find path to RTS DSO: \"$RTS_DYLIB_PATH\"" 1>&2 + exit 1 +fi + +# Dump the exported symbols. Main.hs is responsible for parsing the output. +case "$TYPE" in + "elf") + # The dynamic symbol table of the shared object. We use readelf rather + # than nm as nm classifies symbols by section rather than by symbol + # type, and with tables next to code info tables (objects) live in the + # .text section. + readelf -W "$RTS_DYLIB_PATH" > $OBSERVED_SYMBOLS + ;; + + "windows") + # On windows we inspect the import library (*.dll.a) instead of the dll directly. This is important to get the correct type of info table symbols. + # Dump the external symbols in POSIX format (one "name type [value [size]]" per line). + nm -g -P "${RTS_DYLIB_PATH}.a" > $OBSERVED_SYMBOLS + ;; + + *) + echo "Unknown TYPE=$TYPE" 1>&2 + exit 1 + ;; +esac + +./Main diff "$TYPE" $DECLARED_SYMBOLS $OBSERVED_SYMBOLS ===================================== testsuite/tests/rts/symbols/rts-check-symbols.stdout ===================================== @@ -0,0 +1,762 @@ +Symbols declared in RtsSymbols.c but not observed in the DSO: +Declared> StgReturn Code +Declared> __udivti3 Code +Declared> __umodti3 Code +Declared> atomic_dec Code +Declared> dirty_TVAR Code +Declared> ffi_call Code +Declared> ffi_prep_cif Code +Declared> ffi_type_double Data +Declared> ffi_type_float Data +Declared> ffi_type_pointer Data +Declared> ffi_type_sint16 Data +Declared> ffi_type_sint32 Data +Declared> ffi_type_sint64 Data +Declared> ffi_type_sint8 Data +Declared> ffi_type_uint16 Data +Declared> ffi_type_uint32 Data +Declared> ffi_type_uint64 Data +Declared> ffi_type_uint8 Data +Declared> ffi_type_void Data +Declared> signal_handlers Code +Declared> updateRemembSetPushThunk Code + +Symbols observed in the DSO but not declared in RtsSymbols.c: +Observed> AP_STACK_sizeW Code +Observed> AP_sizeW Code +Observed> BLACKHOLE_sizeW Code +Observed> Bdescr Code +Observed> CHARLIKE_CLOSURE Code +Observed> CONSTR_sizeW Code +Observed> CONTINUATION_sizeW Code +Observed> CON_INFO_PTR_TO_STRUCT Code +Observed> FUN_INFO_PTR_TO_STRUCT Code +Observed> FileEventLogWriter Data +Observed> GET_CLOSURE_TAG Code +Observed> GET_INFO Code +Observed> GET_TAG Code +Observed> INFO_PTR_TO_STRUCT Code +Observed> INTLIKE_CLOSURE Code +Observed> LOOKS_LIKE_CLOSURE_PTR Code +Observed> LOOKS_LIKE_INFO_PTR Code +Observed> LOOKS_LIKE_INFO_PTR_NOT_NULL Code +Observed> LOOKS_LIKE_PTR Code +Observed> NullEventLogWriter Data +Observed> OS_TRY_ACQUIRE_LOCK Code +Observed> PAP_sizeW Code +Observed> RET_INFO_PTR_TO_STRUCT Code +Observed> SET_INFO Code +Observed> SET_INFO_RELAXED Code +Observed> SET_INFO_RELEASE Code +Observed> STATIC_LINK Code +Observed> TAG_CLOSURE Code +Observed> THUNK_INFO_PTR_TO_STRUCT Code +Observed> THUNK_SELECTOR_sizeW Code +Observed> UNTAG_CLOSURE Code +Observed> UNTAG_CONST_CLOSURE Code +Observed> UPD_BH_UPDATABLE_ctr Data +Observed> __rts_fopen Code +Observed> _warnFail Code +Observed> addInitFini Code +Observed> addProddableBlock Code +Observed> allocAlignedGroupOnNode Code +Observed> allocBlock Code +Observed> allocBlockOnNode Code +Observed> allocBlockOnNode_lock Code +Observed> allocBlock_lock Code +Observed> allocGroup Code +Observed> allocGroupOnNode Code +Observed> allocGroupOnNode_lock Code +Observed> allocGroup_lock Code +Observed> allocLimitKill Data +Observed> allocLimitRunHook Data +Observed> allocMBlockAlignedGroupOnNode Code +Observed> allocateMightFail Code +Observed> allocatePinned Code +Observed> allocated_bytes_at_heapoverflow Data +Observed> ap_sizeW Code +Observed> ap_stack_sizeW Code +Observed> arr_words_sizeW Code +Observed> arr_words_words Code +Observed> bco_sizeW Code +Observed> broadcastCondition Code +Observed> cas_word8 Code +Observed> checkProddableBlock Code +Observed> checkVectorSupport Code +Observed> clearImportSymbol Code +Observed> closeCondition Code +Observed> closeMutex Code +Observed> closure_sizeW Code +Observed> collect_pointers Code +Observed> compact_nfdata_full_sizeW Code +Observed> complex_ccall_adjustor_template Data +Observed> containsSpan Code +Observed> continuation_sizeW Code +Observed> createAttachedOSThread Code +Observed> createGenThread Code +Observed> createIOThread Code +Observed> createOSThread Code +Observed> createStrictIOThread Code +Observed> createThread Code +Observed> currentWorkerCount Data +Observed> debugMsgFn Data +Observed> dequeElements Code +Observed> dirty_STACK Code +Observed> dirty_TSO Code +Observed> discardElements Code +Observed> era Data +Observed> errorMsgFn Data +Observed> eventLogStatus Code +Observed> eventTypes Data +Observed> exitFn Data +Observed> exitHeapOverflow Code +Observed> exitHpc Code +Observed> fatalInternalErrorFn Data +Observed> fillGot Code +Observed> findSymbol Code +Observed> findSymbolTable Code +Observed> flushExec Code +Observed> formatClosureDescIpe Code +Observed> freeAllMBlocks Code +Observed> freeChain Code +Observed> freeChain_lock Code +Observed> freeGot Code +Observed> freeGroup Code +Observed> freeGroup_lock Code +Observed> freeInitFiniList Code +Observed> freeMBlocks Code +Observed> freeProddableBlocks Code +Observed> freeThreadingResources Code +Observed> freeWSDeque Code +Observed> full_prog_argc Data +Observed> full_prog_argv Data +Observed> generations Data +Observed> getFirstMBlock Code +Observed> getMBlock Code +Observed> getMBlockOnNode Code +Observed> getMBlocks Code +Observed> getMBlocksOnNode Code +Observed> getNextMBlock Code +Observed> getObjectLoadStatus Code +Observed> get_con_itbl Code +Observed> get_fun_itbl Code +Observed> get_itbl Code +Observed> get_itbl_acquire Code +Observed> get_ret_itbl Code +Observed> get_thunk_itbl Code +Observed> heap_view_closurePtrs Code +Observed> heap_view_closureSize Code +Observed> heap_view_closure_ptrs_in_pap_payload Code +Observed> highMemDynamic Data +Observed> hs_main Code +Observed> initAdjustors Code +Observed> initBlockAllocator Code +Observed> initCondition Code +Observed> initGenerationStats Code +Observed> initMBlocks Code +Observed> initMutex Code +Observed> initProddableBlockSet Code +Observed> interp_shutdown Code +Observed> interp_startup Code +Observed> interruptOSThread Code +Observed> isSymbolImport Code +Observed> isSymbolWeak Code +Observed> itbl_to_con_itbl Code +Observed> itbl_to_fun_itbl Code +Observed> itbl_to_ret_itbl Code +Observed> itbl_to_thunk_itbl Code +Observed> joinOSThread Code +Observed> kernelThreadId Code +Observed> listAllBlocks Code +Observed> listThreads Code +Observed> looksEmptyWSDeque Code +Observed> lookupIPEId Code +Observed> m32_free_page_pool Data +Observed> m32_free_page_pool_size Data +Observed> makeGot Code +Observed> mblock_address_space Data +Observed> mblocks_allocated Data +Observed> modules Data +Observed> mpc_misses Data +Observed> mutArrPtrsCard Code +Observed> mutArrPtrsCardTableSize Code +Observed> mutArrPtrsCards Code +Observed> mut_arr_ptrs_sizeW Code +Observed> n_alloc_blocks_by_node Data +Observed> needGotSlot Code +Observed> newCAF Code +Observed> newGCdCAF Code +Observed> newRetainedCAF Code +Observed> newWSDeque Code +Observed> next_nursery Data +Observed> no_break_on_exception Data +Observed> nonmovingAllocatorCensus Code +Observed> nonmovingAllocatorCensusWithWords Code +Observed> nonmovingPrintAllocatorCensus Code +Observed> nonmovingSweep Code +Observed> nonmovingSweepCompactObjects Code +Observed> nonmovingSweepLargeObjects Code +Observed> nonmovingSweepMutLists Code +Observed> nonmovingSweepStableNameTable Code +Observed> nonmovingTraceAllocatorCensus Code +Observed> oldest_gen Data +Observed> osThreadId Code +Observed> osThreadIsAlive Code +Observed> pap_sizeW Code +Observed> pauseTokenCapability Code +Observed> pbarf Code +Observed> peak_mblocks_allocated Data +Observed> poolFlush Code +Observed> poolFree Code +Observed> poolGetDesiredSize Code +Observed> poolGetMaxSize Code +Observed> poolInit Code +Observed> poolRelease Code +Observed> poolSetDesiredSize Code +Observed> poolSetMaxSize Code +Observed> poolTake Code +Observed> poolTryTake Code +Observed> popWSDeque Code +Observed> printLoadedObjects Code +Observed> prog_name Data +Observed> pushWSDeque Code +Observed> re_invalid Data +Observed> re_realso Data +Observed> releaseFreeMemory Code +Observed> releaseThreadNode Code +Observed> reportMemoryMap Code +Observed> rtsDebugMsgFn Code +Observed> rtsErrorMsgFn Code +Observed> rtsFatalInternalErrorFn Code +Observed> rtsSysErrorMsgFn Code +Observed> rts_argc Data +Observed> rts_argv Data +Observed> rts_argv_size Data +Observed> rts_done Code +Observed> rts_evalLazyIO_ Code +Observed> rts_getSchedStatus Code +Observed> rts_isPaused Code +Observed> rts_listMiscRoots Code +Observed> rts_listThreads Code +Observed> rts_pause Code +Observed> rts_pinThreadToNumaNode Code +Observed> rts_resume Code +Observed> runFini Code +Observed> runInit Code +Observed> sbarf Code +Observed> scheduleWaitThread Code +Observed> setHighMemDynamic Code +Observed> setImportSymbol Code +Observed> setSymbolInfo Code +Observed> setTSOLink Code +Observed> setTSOPrev Code +Observed> setThreadAffinity Code +Observed> setThreadNode Code +Observed> setVectorSupport Code +Observed> setWeakSymbol Code +Observed> shndx_table_uninit_label Data +Observed> shouldCompact Code +Observed> shutdownThread Code +Observed> signalCondition Code +Observed> simple_ccall_adjustor_template Data +Observed> sizeW_fromITBL Code +Observed> small_mut_arr_ptrs_sizeW Code +Observed> ssbarf Code +Observed> stack_frame_sizeW Code +Observed> stack_sizeW Code +Observed> state_change_mutex Data +Observed> stealWSDeque Code +Observed> stealWSDeque_ Code +Observed> stg_AP_NOUPD_info Data +Observed> stg_AP_STACK_NOUPD_info Data +Observed> stg_AP_STACK_info Data +Observed> stg_AP_info Data +Observed> stg_ASYNCIOOP_info Data +Observed> stg_ASYNCIO_LIVE0_closure Data +Observed> stg_ASYNCIO_LIVE0_info Data +Observed> stg_BCO_info Data +Observed> stg_CLOSURE_TABLE_NULL_closure Data +Observed> stg_CLOSURE_TABLE_NULL_info Data +Observed> stg_COMPACT_NFDATA_CLEAN_info Data +Observed> stg_COMPACT_NFDATA_DIRTY_info Data +Observed> stg_CONTINUATION_apply Code +Observed> stg_CONTINUATION_info Data +Observed> stg_C_FINALIZER_LIST_info Data +Observed> stg_DEAD_SLOT_closure Data +Observed> stg_DEAD_SLOT_info Data +Observed> stg_DEAD_WEAK_info Data +Observed> stg_END_STM_CHUNK_LIST_closure Data +Observed> stg_END_STM_CHUNK_LIST_info Data +Observed> stg_END_STM_WATCH_QUEUE_closure Data +Observed> stg_END_STM_WATCH_QUEUE_info Data +Observed> stg_END_TSO_QUEUE_closure Data +Observed> stg_END_TSO_QUEUE_info Data +Observed> stg_GCD_CAF_info Data +Observed> stg_IND_info Data +Observed> stg_MSG_BLACKHOLE_info Data +Observed> stg_MSG_CLONE_STACK_info Data +Observed> stg_MSG_NULL_info Data +Observed> stg_MSG_THROWTO_info Data +Observed> stg_MSG_TRY_WAKEUP_info Data +Observed> stg_MSG_UPD_TSO_FLAG_info Data +Observed> stg_MUT_ARR_PTRS_CLEAN_info Data +Observed> stg_MVAR_TSO_QUEUE_info Data +Observed> stg_NO_FINALIZER_closure Data +Observed> stg_NO_FINALIZER_info Data +Observed> stg_NO_TREC_closure Data +Observed> stg_NO_TREC_info Data +Observed> stg_PAP_apply Code +Observed> stg_PAP_info Data +Observed> stg_PROMPT_TAG_info Data +Observed> stg_SMALL_MUT_ARR_PTRS_CLEAN_info Data +Observed> stg_STABLE_NAME_info Data +Observed> stg_STACK_info Data +Observed> stg_TIMEOUT_QUEUE_EMPTY_closure Data +Observed> stg_TIMEOUT_QUEUE_EMPTY_info Data +Observed> stg_TIMEOUT_QUEUE_info Data +Observed> stg_TREC_CHUNK_info Data +Observed> stg_TREC_HEADER_info Data +Observed> stg_TSO_info Data +Observed> stg_TVAR_WATCH_QUEUE_info Data +Observed> stg_WHITEHOLE_info Data +Observed> stg_abort Code +Observed> stg_ann_frame_info Data +Observed> stg_ap_0_ret_str Data +Observed> stg_ap_stack_entries Data +Observed> stg_ap_stk_ Code +Observed> stg_ap_stk_d Code +Observed> stg_ap_stk_f Code +Observed> stg_ap_stk_l Code +Observed> stg_ap_stk_n Code +Observed> stg_ap_stk_nn Code +Observed> stg_ap_stk_nnn Code +Observed> stg_ap_stk_nnp Code +Observed> stg_ap_stk_np Code +Observed> stg_ap_stk_npn Code +Observed> stg_ap_stk_npp Code +Observed> stg_ap_stk_p Code +Observed> stg_ap_stk_pn Code +Observed> stg_ap_stk_pnn Code +Observed> stg_ap_stk_pnp Code +Observed> stg_ap_stk_pp Code +Observed> stg_ap_stk_ppn Code +Observed> stg_ap_stk_ppp Code +Observed> stg_ap_stk_pppp Code +Observed> stg_ap_stk_ppppp Code +Observed> stg_ap_stk_pppppp Code +Observed> stg_ap_stk_ppppppp Code +Observed> stg_ap_stk_pppppppp Code +Observed> stg_ap_stk_v16 Code +Observed> stg_ap_stk_v32 Code +Observed> stg_ap_stk_v64 Code +Observed> stg_apply_interp_info Data +Observed> stg_atomically_frame_info Data +Observed> stg_atomically_info Data +Observed> stg_atomically_waiting_frame_info Data +Observed> stg_block_blackhole Code +Observed> stg_block_io_int Code +Observed> stg_block_io_int_info Data +Observed> stg_block_io_unit Code +Observed> stg_block_io_unit_info Data +Observed> stg_block_putmvar_finally Code +Observed> stg_block_putmvar_info Data +Observed> stg_block_readmvar_finally Code +Observed> stg_block_readmvar_info Data +Observed> stg_block_stmwait Code +Observed> stg_block_takemvar_finally Code +Observed> stg_block_takemvar_info Data +Observed> stg_block_throwto Code +Observed> stg_block_throwto_finally Code +Observed> stg_block_throwto_info Data +Observed> stg_catch_frame_info Data +Observed> stg_catch_retry_frame_info Data +Observed> stg_catch_stm_frame_info Data +Observed> stg_compactAddWorkerzh Code +Observed> stg_control0zh_ll Code +Observed> stg_ctoi_D1_info Data +Observed> stg_ctoi_F1_info Data +Observed> stg_ctoi_L1_info Data +Observed> stg_ctoi_R1n_info Data +Observed> stg_ctoi_R1p_info Data +Observed> stg_ctoi_V_info Data +Observed> stg_dead_thread_info Data +Observed> stg_do_unpack_cstring Code +Observed> stg_do_unpack_cstring_utf8 Code +Observed> stg_dummy_ret_closure Data +Observed> stg_dummy_ret_info Data +Observed> stg_forceIO_info Data +Observed> stg_gc_prim Code +Observed> stg_gc_prim_p_ll Code +Observed> stg_gc_prim_p_ll_info Data +Observed> stg_gc_prim_pp_ll Code +Observed> stg_gc_prim_pp_ll_info Data +Observed> stg_handleIOSubmitResult Code +Observed> stg_keepAlive_frame_info Data +Observed> stg_killMyself Code +Observed> stg_marked_upd_frame_info Data +Observed> stg_maskAsyncExceptionszh_ret_info Data +Observed> stg_maskUninterruptiblezh_ret_info Data +Observed> stg_noDuplicate_info Data +Observed> stg_overwritingClosure Code +Observed> stg_overwritingClosureSize Code +Observed> stg_prompt_frame_info Data +Observed> stg_raise_info Data +Observed> stg_raise_ret_info Data +Observed> stg_restore_cccs_d_info Data +Observed> stg_restore_cccs_eval_info Data +Observed> stg_restore_cccs_v16_info Data +Observed> stg_restore_cccs_v32_info Data +Observed> stg_restore_cccs_v64_info Data +Observed> stg_returnToSched Code +Observed> stg_returnToSchedButFirst Code +Observed> stg_returnToSchedNotPaused Code +Observed> stg_returnToStackTop Code +Observed> stg_stack_save_entries Data +Observed> stg_stack_underflow_frame_d_info Data +Observed> stg_stack_underflow_frame_v16_info Data +Observed> stg_stack_underflow_frame_v32_info Data +Observed> stg_stack_underflow_frame_v64_info Data +Observed> stg_stk_save_ Code +Observed> stg_stk_save_d Code +Observed> stg_stk_save_f Code +Observed> stg_stk_save_l Code +Observed> stg_stk_save_n Code +Observed> stg_stk_save_nn Code +Observed> stg_stk_save_nnn Code +Observed> stg_stk_save_nnp Code +Observed> stg_stk_save_np Code +Observed> stg_stk_save_npn Code +Observed> stg_stk_save_npp Code +Observed> stg_stk_save_p Code +Observed> stg_stk_save_pn Code +Observed> stg_stk_save_pnn Code +Observed> stg_stk_save_pnp Code +Observed> stg_stk_save_pp Code +Observed> stg_stk_save_ppn Code +Observed> stg_stk_save_ppp Code +Observed> stg_stk_save_pppp Code +Observed> stg_stk_save_ppppp Code +Observed> stg_stk_save_pppppp Code +Observed> stg_stk_save_ppppppp Code +Observed> stg_stk_save_pppppppp Code +Observed> stg_stk_save_v16 Code +Observed> stg_stk_save_v32 Code +Observed> stg_stk_save_v64 Code +Observed> stg_stop_thread_info Data +Observed> stg_threadFinished Code +Observed> stg_unmaskAsyncExceptionszh_ret_info Data +Observed> stg_writeSlopMarker Code +Observed> sync_phase_marking_budget Data +Observed> sysErrorMsgFn Data +Observed> tagConstr Code +Observed> thunk_sizeW_fromITBL Code +Observed> timedWaitCondition Code +Observed> totalArgumentSize Code +Observed> total_ticks Data +Observed> unloadNativeObj Code +Observed> user_era Data +Observed> validate_trec_optimistic Code +Observed> vbarf Code +Observed> vdebugBelch Code +Observed> vectorSupportGlobalVar Data +Observed> verifyGot Code +Observed> verrorBelch Code +Observed> vsysErrorBelch Code +Observed> waitCondition Code +Observed> warnMissingKBLibraryPaths Code +Observed> yieldThread Code + +Symbols observed in the DSO and declared in RtsSymbols.c but with conflicting type: +WrongType> ALLOC_BH_adm (declared, observed): (Code, Data) +WrongType> ALLOC_BH_ctr (declared, observed): (Code, Data) +WrongType> ALLOC_BH_gds (declared, observed): (Code, Data) +WrongType> ALLOC_BH_slp (declared, observed): (Code, Data) +WrongType> ALLOC_CON_adm (declared, observed): (Code, Data) +WrongType> ALLOC_CON_ctr (declared, observed): (Code, Data) +WrongType> ALLOC_CON_gds (declared, observed): (Code, Data) +WrongType> ALLOC_CON_slp (declared, observed): (Code, Data) +WrongType> ALLOC_FUN_adm (declared, observed): (Code, Data) +WrongType> ALLOC_FUN_ctr (declared, observed): (Code, Data) +WrongType> ALLOC_FUN_gds (declared, observed): (Code, Data) +WrongType> ALLOC_FUN_slp (declared, observed): (Code, Data) +WrongType> ALLOC_HEAP_ctr (declared, observed): (Code, Data) +WrongType> ALLOC_HEAP_tot (declared, observed): (Code, Data) +WrongType> ALLOC_PAP_adm (declared, observed): (Code, Data) +WrongType> ALLOC_PAP_ctr (declared, observed): (Code, Data) +WrongType> ALLOC_PAP_gds (declared, observed): (Code, Data) +WrongType> ALLOC_PAP_slp (declared, observed): (Code, Data) +WrongType> ALLOC_PRIM_adm (declared, observed): (Code, Data) +WrongType> ALLOC_PRIM_ctr (declared, observed): (Code, Data) +WrongType> ALLOC_PRIM_gds (declared, observed): (Code, Data) +WrongType> ALLOC_PRIM_slp (declared, observed): (Code, Data) +WrongType> ALLOC_RTS_ctr (declared, observed): (Code, Data) +WrongType> ALLOC_RTS_tot (declared, observed): (Code, Data) +WrongType> ALLOC_SE_THK_ctr (declared, observed): (Code, Data) +WrongType> ALLOC_STACK_ctr (declared, observed): (Code, Data) +WrongType> ALLOC_STACK_tot (declared, observed): (Code, Data) +WrongType> ALLOC_THK_adm (declared, observed): (Code, Data) +WrongType> ALLOC_THK_gds (declared, observed): (Code, Data) +WrongType> ALLOC_THK_slp (declared, observed): (Code, Data) +WrongType> ALLOC_TSO_ctr (declared, observed): (Code, Data) +WrongType> ALLOC_TSO_tot (declared, observed): (Code, Data) +WrongType> ALLOC_TUP_adm (declared, observed): (Code, Data) +WrongType> ALLOC_TUP_ctr (declared, observed): (Code, Data) +WrongType> ALLOC_TUP_gds (declared, observed): (Code, Data) +WrongType> ALLOC_TUP_slp (declared, observed): (Code, Data) +WrongType> ALLOC_UP_THK_ctr (declared, observed): (Code, Data) +WrongType> CATCHF_PUSHED_ctr (declared, observed): (Code, Data) +WrongType> ENT_AP_STACK_ctr (declared, observed): (Code, Data) +WrongType> ENT_AP_ctr (declared, observed): (Code, Data) +WrongType> ENT_BH_ctr (declared, observed): (Code, Data) +WrongType> ENT_CONTINUATION_ctr (declared, observed): (Code, Data) +WrongType> ENT_DYN_CON_ctr (declared, observed): (Code, Data) +WrongType> ENT_DYN_FUN_DIRECT_ctr (declared, observed): (Code, Data) +WrongType> ENT_DYN_IND_ctr (declared, observed): (Code, Data) +WrongType> ENT_DYN_THK_MANY_ctr (declared, observed): (Code, Data) +WrongType> ENT_DYN_THK_SINGLE_ctr (declared, observed): (Code, Data) +WrongType> ENT_LNE_ctr (declared, observed): (Code, Data) +WrongType> ENT_PAP_ctr (declared, observed): (Code, Data) +WrongType> ENT_PERM_IND_ctr (declared, observed): (Code, Data) +WrongType> ENT_STATIC_CON_ctr (declared, observed): (Code, Data) +WrongType> ENT_STATIC_FUN_DIRECT_ctr (declared, observed): (Code, Data) +WrongType> ENT_STATIC_IND_ctr (declared, observed): (Code, Data) +WrongType> ENT_STATIC_THK_MANY_ctr (declared, observed): (Code, Data) +WrongType> ENT_STATIC_THK_SINGLE_ctr (declared, observed): (Code, Data) +WrongType> ENT_VIA_NODE_ctr (declared, observed): (Code, Data) +WrongType> GC_FAILED_PROMOTION_ctr (declared, observed): (Code, Data) +WrongType> GC_SEL_ABANDONED_ctr (declared, observed): (Code, Data) +WrongType> GC_SEL_MAJOR_ctr (declared, observed): (Code, Data) +WrongType> GC_SEL_MINOR_ctr (declared, observed): (Code, Data) +WrongType> HEAP_CHK_ctr (declared, observed): (Code, Data) +WrongType> KNOWN_CALL_EXTRA_ARGS_ctr (declared, observed): (Code, Data) +WrongType> KNOWN_CALL_TOO_FEW_ARGS_ctr (declared, observed): (Code, Data) +WrongType> KNOWN_CALL_ctr (declared, observed): (Code, Data) +WrongType> MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr (declared, observed): (Code, Data) +WrongType> MULTI_CHUNK_SLOW_CALL_ctr (declared, observed): (Code, Data) +WrongType> MainCapability (declared, observed): (Code, Data) +WrongType> RET_NEW_ctr (declared, observed): (Code, Data) +WrongType> RET_NEW_hst (declared, observed): (Code, Data) +WrongType> RET_OLD_ctr (declared, observed): (Code, Data) +WrongType> RET_OLD_hst (declared, observed): (Code, Data) +WrongType> RET_SEMI_loads_avoided (declared, observed): (Code, Data) +WrongType> RET_UNBOXED_TUP_ctr (declared, observed): (Code, Data) +WrongType> RET_UNBOXED_TUP_hst (declared, observed): (Code, Data) +WrongType> SLOW_CALL_FUN_CORRECT_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_FUN_TOO_FEW_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_FUN_TOO_MANY_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_PAP_CORRECT_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_PAP_TOO_FEW_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_PAP_TOO_MANY_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_UNEVALD_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_d_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_f_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_l_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_n_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_p_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_pp_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_ppp_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_pppp_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_ppppp_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_pppppp_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_pppv_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_ppv_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_pv_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_v16_ctr (declared, observed): (Code, Data) +WrongType> SLOW_CALL_fast_v_ctr (declared, observed): (Code, Data) +WrongType> STK_CHK_ctr (declared, observed): (Code, Data) +WrongType> TAG_TAGGED_miss (declared, observed): (Code, Data) +WrongType> TAG_TAGGED_pred (declared, observed): (Code, Data) +WrongType> TAG_UNTAGGED_miss (declared, observed): (Code, Data) +WrongType> TAG_UNTAGGED_pred (declared, observed): (Code, Data) +WrongType> UNKNOWN_CALL_ctr (declared, observed): (Code, Data) +WrongType> UPDF_OMITTED_ctr (declared, observed): (Code, Data) +WrongType> UPDF_PUSHED_ctr (declared, observed): (Code, Data) +WrongType> UPDF_RCC_OMITTED_ctr (declared, observed): (Code, Data) +WrongType> UPDF_RCC_PUSHED_ctr (declared, observed): (Code, Data) +WrongType> UPD_CAF_BH_SINGLE_ENTRY_ctr (declared, observed): (Code, Data) +WrongType> UPD_CAF_BH_UPDATABLE_ctr (declared, observed): (Code, Data) +WrongType> UPD_CON_IN_NEW_ctr (declared, observed): (Code, Data) +WrongType> UPD_CON_IN_PLACE_ctr (declared, observed): (Code, Data) +WrongType> UPD_NEW_IND_ctr (declared, observed): (Code, Data) +WrongType> UPD_NEW_PERM_IND_ctr (declared, observed): (Code, Data) +WrongType> UPD_OLD_IND_ctr (declared, observed): (Code, Data) +WrongType> UPD_OLD_PERM_IND_ctr (declared, observed): (Code, Data) +WrongType> UPD_PAP_IN_NEW_ctr (declared, observed): (Code, Data) +WrongType> UPD_PAP_IN_PLACE_ctr (declared, observed): (Code, Data) +WrongType> UPD_SQUEEZED_ctr (declared, observed): (Code, Data) +WrongType> VERY_SLOW_CALL_ctr (declared, observed): (Code, Data) +WrongType> __stg_gc_enter_1 (declared, observed): (Data, Code) +WrongType> __stg_gc_fun (declared, observed): (Data, Code) +WrongType> closure_flags (declared, observed): (Code, Data) +WrongType> defaultRtsConfig (declared, observed): (Code, Data) +WrongType> g0 (declared, observed): (Code, Data) +WrongType> ghc_unique_counter64 (declared, observed): (Code, Data) +WrongType> ghc_unique_inc (declared, observed): (Code, Data) +WrongType> keepCAFs (declared, observed): (Code, Data) +WrongType> large_alloc_lim (declared, observed): (Code, Data) +WrongType> prog_argc (declared, observed): (Code, Data) +WrongType> prog_argv (declared, observed): (Code, Data) +WrongType> stable_name_table (declared, observed): (Code, Data) +WrongType> stable_ptr_table (declared, observed): (Code, Data) +WrongType> stg_CHARLIKE_closure (declared, observed): (Code, Data) +WrongType> stg_INTLIKE_closure (declared, observed): (Code, Data) +WrongType> stg_absentErrorzh (declared, observed): (Data, Code) +WrongType> stg_annotateStackzh (declared, observed): (Data, Code) +WrongType> stg_ap_0_fast (declared, observed): (Data, Code) +WrongType> stg_ap_d_fast (declared, observed): (Data, Code) +WrongType> stg_ap_f_fast (declared, observed): (Data, Code) +WrongType> stg_ap_l_fast (declared, observed): (Data, Code) +WrongType> stg_ap_n_fast (declared, observed): (Data, Code) +WrongType> stg_ap_p_fast (declared, observed): (Data, Code) +WrongType> stg_ap_pp_fast (declared, observed): (Data, Code) +WrongType> stg_ap_ppp_fast (declared, observed): (Data, Code) +WrongType> stg_ap_pppp_fast (declared, observed): (Data, Code) +WrongType> stg_ap_ppppp_fast (declared, observed): (Data, Code) +WrongType> stg_ap_pppppp_fast (declared, observed): (Data, Code) +WrongType> stg_ap_pppv_fast (declared, observed): (Data, Code) +WrongType> stg_ap_ppv_fast (declared, observed): (Data, Code) +WrongType> stg_ap_pv_fast (declared, observed): (Data, Code) +WrongType> stg_ap_v16_fast (declared, observed): (Data, Code) +WrongType> stg_ap_v32_fast (declared, observed): (Data, Code) +WrongType> stg_ap_v64_fast (declared, observed): (Data, Code) +WrongType> stg_ap_v_fast (declared, observed): (Data, Code) +WrongType> stg_atomicModifyMutVar2zh (declared, observed): (Data, Code) +WrongType> stg_atomicModifyMutVarzuzh (declared, observed): (Data, Code) +WrongType> stg_atomicallyzh (declared, observed): (Data, Code) +WrongType> stg_block_noregs (declared, observed): (Data, Code) +WrongType> stg_block_putmvar (declared, observed): (Data, Code) +WrongType> stg_block_readmvar (declared, observed): (Data, Code) +WrongType> stg_block_takemvar (declared, observed): (Data, Code) +WrongType> stg_casArrayzh (declared, observed): (Data, Code) +WrongType> stg_casInt16Arrayzh (declared, observed): (Data, Code) +WrongType> stg_casInt32Arrayzh (declared, observed): (Data, Code) +WrongType> stg_casInt64Arrayzh (declared, observed): (Data, Code) +WrongType> stg_casInt8Arrayzh (declared, observed): (Data, Code) +WrongType> stg_casIntArrayzh (declared, observed): (Data, Code) +WrongType> stg_casMutVarzh (declared, observed): (Data, Code) +WrongType> stg_casSmallArrayzh (declared, observed): (Data, Code) +WrongType> stg_castDoubleToWord64zh (declared, observed): (Data, Code) +WrongType> stg_castFloatToWord32zh (declared, observed): (Data, Code) +WrongType> stg_castWord32ToFloatzh (declared, observed): (Data, Code) +WrongType> stg_castWord64ToDoublezh (declared, observed): (Data, Code) +WrongType> stg_catchRetryzh (declared, observed): (Data, Code) +WrongType> stg_catchSTMzh (declared, observed): (Data, Code) +WrongType> stg_catchzh (declared, observed): (Data, Code) +WrongType> stg_clearCCSzh (declared, observed): (Data, Code) +WrongType> stg_cloneArrayzh (declared, observed): (Data, Code) +WrongType> stg_cloneMutableArrayzh (declared, observed): (Data, Code) +WrongType> stg_cloneSmallArrayzh (declared, observed): (Data, Code) +WrongType> stg_cloneSmallMutableArrayzh (declared, observed): (Data, Code) +WrongType> stg_closureSizzezh (declared, observed): (Data, Code) +WrongType> stg_compactAddWithSharingzh (declared, observed): (Data, Code) +WrongType> stg_compactAddzh (declared, observed): (Data, Code) +WrongType> stg_compactAllocateBlockzh (declared, observed): (Data, Code) +WrongType> stg_compactContainsAnyzh (declared, observed): (Data, Code) +WrongType> stg_compactContainszh (declared, observed): (Data, Code) +WrongType> stg_compactFixupPointerszh (declared, observed): (Data, Code) +WrongType> stg_compactGetFirstBlockzh (declared, observed): (Data, Code) +WrongType> stg_compactGetNextBlockzh (declared, observed): (Data, Code) +WrongType> stg_compactNewzh (declared, observed): (Data, Code) +WrongType> stg_compactResizzezh (declared, observed): (Data, Code) +WrongType> stg_compactSizzezh (declared, observed): (Data, Code) +WrongType> stg_copyArray_barrier (declared, observed): (Data, Code) +WrongType> stg_copyArrayzh (declared, observed): (Data, Code) +WrongType> stg_copyMutableArrayzh (declared, observed): (Data, Code) +WrongType> stg_copySmallArrayzh (declared, observed): (Data, Code) +WrongType> stg_copySmallMutableArrayzh (declared, observed): (Data, Code) +WrongType> stg_deRefStablePtrzh (declared, observed): (Data, Code) +WrongType> stg_deRefWeakzh (declared, observed): (Data, Code) +WrongType> stg_decodeDoublezu2Intzh (declared, observed): (Data, Code) +WrongType> stg_decodeDoublezuInt64zh (declared, observed): (Data, Code) +WrongType> stg_decodeFloatzuIntzh (declared, observed): (Data, Code) +WrongType> stg_delayzh (declared, observed): (Data, Code) +WrongType> stg_exit (declared, observed): (Data, Code) +WrongType> stg_freezzeArrayzh (declared, observed): (Data, Code) +WrongType> stg_freezzeSmallArrayzh (declared, observed): (Data, Code) +WrongType> stg_gc_bpp (declared, observed): (Data, Code) +WrongType> stg_gc_d1 (declared, observed): (Data, Code) +WrongType> stg_gc_f1 (declared, observed): (Data, Code) +WrongType> stg_gc_ii (declared, observed): (Data, Code) +WrongType> stg_gc_ip (declared, observed): (Data, Code) +WrongType> stg_gc_l1 (declared, observed): (Data, Code) +WrongType> stg_gc_noregs (declared, observed): (Data, Code) +WrongType> stg_gc_pi (declared, observed): (Data, Code) +WrongType> stg_gc_pp (declared, observed): (Data, Code) +WrongType> stg_gc_ppp (declared, observed): (Data, Code) +WrongType> stg_gc_pppp (declared, observed): (Data, Code) +WrongType> stg_gc_ppppp (declared, observed): (Data, Code) +WrongType> stg_gc_prim_n (declared, observed): (Data, Code) +WrongType> stg_gc_prim_p (declared, observed): (Data, Code) +WrongType> stg_gc_prim_pp (declared, observed): (Data, Code) +WrongType> stg_gc_unbx_r1 (declared, observed): (Data, Code) +WrongType> stg_gc_unpt_r1 (declared, observed): (Data, Code) +WrongType> stg_getApStackValzh (declared, observed): (Data, Code) +WrongType> stg_getMaskingStatezh (declared, observed): (Data, Code) +WrongType> stg_getOtherThreadAllocationCounterzh (declared, observed): (Data, Code) +WrongType> stg_getSparkzh (declared, observed): (Data, Code) +WrongType> stg_getThreadAllocationCounterzh (declared, observed): (Data, Code) +WrongType> stg_isByteArrayPinnedzh (declared, observed): (Data, Code) +WrongType> stg_isByteArrayWeaklyPinnedzh (declared, observed): (Data, Code) +WrongType> stg_isCurrentThreadBoundzh (declared, observed): (Data, Code) +WrongType> stg_isEmptyMVarzh (declared, observed): (Data, Code) +WrongType> stg_isMutableByteArrayPinnedzh (declared, observed): (Data, Code) +WrongType> stg_isMutableByteArrayWeaklyPinnedzh (declared, observed): (Data, Code) +WrongType> stg_keepAlivezh (declared, observed): (Data, Code) +WrongType> stg_killThreadzh (declared, observed): (Data, Code) +WrongType> stg_labelThreadzh (declared, observed): (Data, Code) +WrongType> stg_listThreadszh (declared, observed): (Data, Code) +WrongType> stg_makeStablePtrzh (declared, observed): (Data, Code) +WrongType> stg_maskAsyncExceptionszh (declared, observed): (Data, Code) +WrongType> stg_maskUninterruptiblezh (declared, observed): (Data, Code) +WrongType> stg_mkApUpd0zh (declared, observed): (Data, Code) +WrongType> stg_newAlignedPinnedByteArrayzh (declared, observed): (Data, Code) +WrongType> stg_newArrayzh (declared, observed): (Data, Code) +WrongType> stg_newBCOzh (declared, observed): (Data, Code) +WrongType> stg_newByteArrayzh (declared, observed): (Data, Code) +WrongType> stg_newConAppObjzh (declared, observed): (Data, Code) +WrongType> stg_newMVarzh (declared, observed): (Data, Code) +WrongType> stg_newMutVarzh (declared, observed): (Data, Code) +WrongType> stg_newPinnedByteArrayzh (declared, observed): (Data, Code) +WrongType> stg_newSmallArrayzh (declared, observed): (Data, Code) +WrongType> stg_newTVarzh (declared, observed): (Data, Code) +WrongType> stg_noDuplicatezh (declared, observed): (Data, Code) +WrongType> stg_numSparkszh (declared, observed): (Data, Code) +WrongType> stg_paniczh (declared, observed): (Data, Code) +WrongType> stg_putMVarzh (declared, observed): (Data, Code) +WrongType> stg_raiseDivZZerozh (declared, observed): (Data, Code) +WrongType> stg_raiseIOzh (declared, observed): (Data, Code) +WrongType> stg_raiseOverflowzh (declared, observed): (Data, Code) +WrongType> stg_raiseUnderflowzh (declared, observed): (Data, Code) +WrongType> stg_raisezh (declared, observed): (Data, Code) +WrongType> stg_readMVarzh (declared, observed): (Data, Code) +WrongType> stg_readTVarIOzh (declared, observed): (Data, Code) +WrongType> stg_readTVarzh (declared, observed): (Data, Code) +WrongType> stg_resizzeMutableByteArrayzh (declared, observed): (Data, Code) +WrongType> stg_retryzh (declared, observed): (Data, Code) +WrongType> stg_setOtherThreadAllocationCounterzh (declared, observed): (Data, Code) +WrongType> stg_setThreadAllocationCounterzh (declared, observed): (Data, Code) +WrongType> stg_shrinkMutableByteArrayzh (declared, observed): (Data, Code) +WrongType> stg_shrinkSmallMutableArrayzh (declared, observed): (Data, Code) +WrongType> stg_takeMVarzh (declared, observed): (Data, Code) +WrongType> stg_thawArrayzh (declared, observed): (Data, Code) +WrongType> stg_thawSmallArrayzh (declared, observed): (Data, Code) +WrongType> stg_threadLabelzh (declared, observed): (Data, Code) +WrongType> stg_threadStatuszh (declared, observed): (Data, Code) +WrongType> stg_traceBinaryEventzh (declared, observed): (Data, Code) +WrongType> stg_traceEventzh (declared, observed): (Data, Code) +WrongType> stg_traceMarkerzh (declared, observed): (Data, Code) +WrongType> stg_tryReadMVarzh (declared, observed): (Data, Code) +WrongType> stg_tryTakeMVarzh (declared, observed): (Data, Code) +WrongType> stg_unmaskAsyncExceptionszh (declared, observed): (Data, Code) +WrongType> stg_unpackClosurezh (declared, observed): (Data, Code) +WrongType> stg_unsafeThawArrayzh (declared, observed): (Data, Code) +WrongType> stg_unsafeThawSmallArrayzh (declared, observed): (Data, Code) +WrongType> stg_waitReadzh (declared, observed): (Data, Code) +WrongType> stg_waitWritezh (declared, observed): (Data, Code) +WrongType> stg_whereFromzh (declared, observed): (Data, Code) +WrongType> stg_writeTVarzh (declared, observed): (Data, Code) +WrongType> stg_yield_noregs (declared, observed): (Data, Code) +WrongType> stg_yield_to_interpreter (declared, observed): (Data, Code) +WrongType> stg_yieldzh (declared, observed): (Data, Code) +WrongType> ticky_slow_call_unevald (declared, observed): (Code, Data) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/31a14e51312755fadc1d66ea94634fe… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/31a14e51312755fadc1d66ea94634fe… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/T26543b] Wibbles [skip ci]
by Simon Peyton Jones (＠simonpj) 09 Oct '26

09 Oct '26

Simon Peyton Jones pushed to branch wip/T26543b at Glasgow Haskell Compiler / GHC Commits: 785d28a0 by Simon Peyton Jones at 2026-10-09T17:29:42+01:00 Wibbles [skip ci] - - - - - 3 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/typecheck/should_fail/T26543a.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -2156,8 +2156,7 @@ foldQLInstVars check_tv ty qlUnify :: TcType -> TcType -> TcM () -- Unify ty1 with ty2: --- * It can unify both instantiation variables (possibly with polytypes), --- and ordinary unification variables (but only with monotypes) +-- * It unifies /only/ instantiation variables (see (UQL6)), hopefully with polytypes -- * It does not return a coercion (unlike unifyType); it is called -- for the sole purpose of unifying instantiation variables, although it -- may also (opportunistically) unify regular unification variables. @@ -2264,11 +2263,11 @@ In qlUnify, if we find (kappa ~ ty), we are going to update kappa := ty. That is the entire point of qlUnify! Wrinkles: (UQL1) Before unifying an instantiation variable in `go_flexi`, we must check - the usual unification conditions, by calling `GHC.Tc.Utils.Unify.simpleUnifyCheck`. - For example that checks for + the usual unification conditions. In particular: * An occurs-check - * Level mis-match * An attempt to unify a concrete type variable with a non-concrete type. + We don't need a level-check because the level of an instantiation variable + is infinity -- see (UQL3). (UQL2) What if kappa and ty have different kinds? We simply call the ordinary unifier and use the coercion to connect the two. @@ -2350,6 +2349,9 @@ That is the entire point of qlUnify! Wrinkles: The simplest thing is to say that `qlUnify` unifies /only/ instantiation variables (see calls to `isQLInstTyVar`). We could be more ambitious, perhaps, in future. + Remember, though, that the /only/ reason for QuickLoook is to unify instantiation variables + with polytypes; anything else is optional, and will be picked up with later "ordinary" + typechecking. So unifing only instantiation variables is enough. (UQL7) If `qlUnify` sees a concrete `kaapa`, thus kappa[conc] ~ some-type ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -3631,7 +3631,6 @@ simpleUnifyCheck :: UnifyCheckCaller -> TcLevel -> TcTyVar -> TcType -> SimpleUn -- * Rejects if lhs_tv occurs in rhs_ty (occurs check) -- * Rejects foralls unless -- lhs_tv is RuntimeUnk (used by GHCi debugger) --- or is a QL instantiation variable -- * Rejects a non-concrete type if lhs_tv is concrete -- * Rejects type families unless fam_ok=True -- * Does a level-check for type variables, to avoid skolem escape @@ -3664,11 +3663,10 @@ simpleUnifyCheck caller given_eq_lvl lhs_tv rhs | isCoVar tcv = occ_check | tcTyVarLevel tcv `strictlyDeeperThan` lhs_tv_lvl = True | lhs_tv_is_concrete, not (isConcreteTyVar tcv) = True - | lhs_tv_nm == getName tcv = True | occ_check = True | otherwise = False where - occ_check = anyFreeVarsOfType rhs_tcv_is_bad (varType tcv) + occ_check = simpleOccursCheck lhs_tv_nm tcv rhs_is_bad (TyVarTy tv) = rhs_tcv_is_bad tv @@ -3693,7 +3691,7 @@ simpleUnifyCheck caller given_eq_lvl lhs_tv rhs rhs_is_bad (CoercionTy co) = co_is_bad co rhs_is_bad (LitTy {}) = False - -- Coercions: see (SUC1) in Note [simpleUnifyCheck] + -- Coercions: see Note [Occurs check and coercions] co_is_bad co = anyFreeVarsOfCo rhs_tcv_is_bad co {- Note [simpleUnifyCheck] @@ -3703,41 +3701,28 @@ It can return a definite decision (SUC_CannotUnify of SUC_CanUnify), or uncertai (SUC_NotSure). In the latter case we will later use `checkTyEqRhs` to resolve. In particular, `simpleUnifyCheck`: -* Rejects if lhs_tv occurs in rhs_ty (occurs check) +* Rejects if lhs_tv occurs in rhs_ty (see Note [Simple occurs check]) * Rejects foralls unless lhs_tv is RuntimeUnk (used by GHCi debugger) - or is a QL instantiation variable * Rejects a non-concrete type if lhs_tv is concrete * Rejects type families unless fam_ok=True * Does a level-check for type variables, to avoid skolem escape This function is pretty heavily used, so it's optimised not to allocate. -(SUC1) `simpleUnifyCheck` used by QuickLook's `qlUnify`, and anything other than - SUC_CanUnify will tell `qlUnify` not to proceed. That makes QuickLook depend - (regrettably, delicately) on the exact choices made by `simpleUnifyCheck`. - - A case in point: in #26543. In the repro case in the Descriptions, `qlUnify` failed - because there was a coercion /hole/ in the RHS; but one that was ultimately Refl. - - So in `simpleUnifyCheck` we only look at the /kind/ of a coercion, not the - evidence itself. I'm a bit worried about building a loop, if the evidence - mentions the LHS unification variable; but I can't see how that can happen, and - I /really/ don't want to be super-conservative for coercion holes (#26543). So, - for now at least, we look just at the kind of the coercion. - - Note that this (unsatisfactorily) differs from the choice in `checkCo`, but - changing that too is an unforced change so I have left the inconsistency. +Note [Occurs check and coercions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +What if we have + alpha ~ Int |> (CoHole ch :: Type ~ blah) -(SUC2) When we come across a type variable, we use `simple_occurs_check`, as also - does `checkTyEqRhs`. That `simple_occurs_check` checks for occurrences in the - /kind/ if the type variable, using `anyFreeVarsOfType`. And that /does/ look - inside coercions; while for coercion holes it just looks in the type of the - coercion hole. +Clearly we want to check that `alpha` doesn't appear free in `blah`. But even if +it doesn't, what if `ch` is later filled in with a coercion mentioning `alpha`? +Tht would be bad: we'd get an infinite structure. - This is all sadly inconsistent with (SUC1), but it's not currently causing - problems, so I am just leaving breadcrumbs (this Note) to point this out for - now. +The right thing to do is to check for a loop when (later) filling in `ch`. +We don't do that right now, and it's very obscure. But in `simpleUnifyCheck` +we just look in the free vars of the /kind/ of the hole, which is what +`anyFreeVarsOfCo` does. -} {- ********************************************************************* @@ -4371,9 +4356,8 @@ checkCo flags co = , LC_Promote { lc_lvlp = lhs_tv_lvl } <- lc -> do { reason <- checkPromoteFreeVars occ_prob lhs_tv lhs_tv_lvl $ tyCoVarsOfCo co - -- Maybe we should just check the free vars of the - -- /type/ of the coercion, to line up with - -- (SUC1) in Note [simpleUnifyCheck] + -- See Note [Occurs check and coercions] + -- and Note [checkCo] (2) ; return $ if cterHasNoProblem reason then pure co @@ -4670,7 +4654,7 @@ checkTyVar flags occ_tv -- so the only reason for a filled meta-tyvar is promotion else do_rhs_checks - [ simpleOccursCheck occ occ_tv + [ tyVarOccursCheck occ occ_tv , tyVarLevelCheck lc occ_tv , tyVarConcretenessCheck conc occ_tv ] } @@ -4728,20 +4712,25 @@ promotionDone occ_tv _ (CC_Promote {}) = isFilledMetaTyVar occ_tv promotionDone _ _ _ = return False --------------------- -simpleOccursCheck :: OccursCheck -> TcTyVar -> TyVarCheckResult m +tyVarOccursCheck :: OccursCheck -> TcTyCoVar -> TyVarCheckResult m -- ^ The "interpreter" for 'OccursCheck' --- Check for an occurrence of lhs_tv in occ_tv or its kind -simpleOccursCheck OC_None _ +-- Check for an occurrence of lhs_tv in occ_tv /or/ its kind +tyVarOccursCheck OC_None _ = TyVarCheck_Success -simpleOccursCheck (OC_Check lhs_tv occ_prob) occ_tv - | is_bad occ_tv = TyVarCheck_Error (cteProblem occ_prob) - | otherwise = TyVarCheck_Success +tyVarOccursCheck (OC_Check { occurs_tv_name = lhs_tv, occurs_problem = prob }) occ_tcv + | simpleOccursCheck lhs_tv occ_tcv = TyVarCheck_Error (cteProblem prob) + | otherwise = TyVarCheck_Success + +simpleOccursCheck :: Name -> TyCoVar -> Bool +-- Check for an occurrence of lhs_tv in occ_tv /or/ its kind +-- True <=> occurs check fires +simpleOccursCheck lhs_tv occ_tcv + = is_bad occ_tcv where - -- See (SUC2) in Note [simpleUnifyCheck] is_bad :: TyCoVar -> Bool - is_bad occ_tv | lhs_tv == tyVarName occ_tv = True - | anyFreeVarsOfType is_bad $! (tyVarKind occ_tv) = True - | otherwise = False + is_bad occ_tcv | lhs_tv == tyVarName occ_tcv = True + | anyFreeVarsOfType is_bad $! (varType occ_tcv) = True + | otherwise = False ------------------------- tyVarLevelCheck :: LevelCheck m -> TcTyVar -> TyVarCheckResult m ===================================== testsuite/tests/typecheck/should_fail/T26543a.hs ===================================== @@ -4,7 +4,7 @@ -- but was erroneously accpeted with ImpredicativeTypes -- See !16566 -module T26543 where +module T26543a where import Data.Kind import Data.Proxy View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/785d28a06410e31d9f0e15e5f2ca6cd… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/785d28a06410e31d9f0e15e5f2ca6cd… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/T27731] Simplify the error-suppression mechanism in GHC.Tc.Errors
by Simon Peyton Jones (＠simonpj) 09 Oct '26

09 Oct '26

Simon Peyton Jones pushed to branch wip/T27731 at Glasgow Haskell Compiler / GHC Commits: a9864e81 by Simon Peyton Jones at 2026-10-09T17:21:11+01:00 Simplify the error-suppression mechanism in GHC.Tc.Errors In `GHC.Tc.Errors.reportWanteds` we suppress some errors in favour of others. But the mechanism had grown crufty, and #27331 exposed a bug. This MR makes it simpler and more uniform, by doing everything via the `ei_suppress` field of the ErrorItem. Claude then found another closely-related bug (see the review linked on !16564). That bug is immortalised in new test T18851d. I'm still not happy with `ignoreConstraint` but we can worry about that another day; I have not touched it. Main changes * Instead of /predicting/ when an error will be reported, we set `cec_error_reported` when an error is /actually/ reported. (I renamed it from `cec_suppress` to reflect this change.) Now errors are suppressed only when a preceding error has actually been reported. Simpler and more robust. See `Note [cec_error_reported: suppressing less-serious errors]` The big changes are in `reportWanteds` which looks very different. * New `Note [ei_suppress: suppressing confusing errors]` describes the (quite separate) `ei_suppress` mechanism for suppressing confusing errors, mainly arising from non-empty rewriter sets * In `tryTypeClassDefaulting`, instead of switching off type-class defaulting if there is an insoluble /anywhere/, we just switch it off locally when we find an insoluble sub-tree. See Note [When to do type-class defaulting] and (W5) in Note [ApproximateWC] * Greatly simplify `insolubleWantedCt`. * I made type-class-defaulting be a bit more eager, only switched off when a peer or ancestor (but not child) constraint is insoluble. See Note [When to do type-class defaulting]. Small refactorings * Rename `askNoErrs` to `askErrsFound` and flip its polarity * The code for "check if ei_suppress is true of all items" code is moved to `mkErrorItems` rather than in the large `reportWanteds`. * Code for `has_gadt_match` moves to `mkGivenErrorReporter`, rather than polluting the large `reportWanteds`. * Many tests with `-fdefer-type-errors` get more warnings, especially about ambiguous (Num a) constraints. This is by-design: see Note [Always warn with -fdefer-type-errors]. Previously GHC was not honouring this Note but now it is, hence the extra errors. - - - - - 53 changed files: - + changelog.d/T27731 - compiler/GHC/Builtin/WiredIn/Ids.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - testsuite/tests/ghci/prog020/ghci.prog020a.stderr - testsuite/tests/ghci/prog020/ghci.prog020b.stderr - testsuite/tests/ghci/prog021/prog021a.stderr - testsuite/tests/ghci/prog021/prog021b.stderr - testsuite/tests/ghci/prog022/ghci.prog022a.stderr - testsuite/tests/ghci/prog022/ghci.prog022b.stderr - testsuite/tests/ghci/prog022/ghci.prog022c.stderr - testsuite/tests/ghci/prog022/ghci.prog022d.stderr - testsuite/tests/ghci/prog022/ghci.prog022e.stderr - testsuite/tests/ghci/prog022/ghci.prog022f.stderr - testsuite/tests/ghci/scripts/Defer02.stderr - testsuite/tests/module/mod130.stderr - testsuite/tests/overloadedstrings/should_fail/T25926.stderr - testsuite/tests/overloadedstrings/should_fail/T27124.stderr - testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr - testsuite/tests/printer/T17697.stderr - testsuite/tests/rename/should_fail/T15607.stderr - testsuite/tests/rename/should_fail/T19843b.stderr - testsuite/tests/safeHaskell/ghci/p4.stderr - testsuite/tests/safeHaskell/ghci/p6.stderr - testsuite/tests/typecheck/should_compile/T11254.stderr - testsuite/tests/typecheck/should_compile/T15370.stderr - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - testsuite/tests/typecheck/should_fail/ClassOperator.stderr - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - testsuite/tests/typecheck/should_fail/DoExpansion3.stderr - testsuite/tests/typecheck/should_fail/FunDepOrigin1b.hs - testsuite/tests/typecheck/should_fail/T18851.stderr - + testsuite/tests/typecheck/should_fail/T18851e.hs - + testsuite/tests/typecheck/should_fail/T18851e.stderr - + testsuite/tests/typecheck/should_fail/T18851f.hs - + testsuite/tests/typecheck/should_fail/T18851f.stderr - testsuite/tests/typecheck/should_fail/T22940.stderr - testsuite/tests/typecheck/should_fail/T26823.stderr - + testsuite/tests/typecheck/should_fail/T27731.hs - + testsuite/tests/typecheck/should_fail/T27731.stderr - testsuite/tests/typecheck/should_fail/T5691.stderr - testsuite/tests/typecheck/should_fail/T7437.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/mc24.stderr - testsuite/tests/typecheck/should_fail/tcfail019.stderr - testsuite/tests/typecheck/should_fail/tcfail189.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9864e810be17e7f2b76637438a7e60… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9864e810be17e7f2b76637438a7e60… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Pushed new branch wip/romes/async-rpc
by Rodrigo Mesquita (＠alt-romes) 09 Oct '26

09 Oct '26

Rodrigo Mesquita pushed new branch wip/romes/async-rpc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/async-rpc You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/substitution-via-mapper] 2 commits: Remove the Eq and Ord instances for ForAllTyFlag
by Simon Peyton Jones (＠simonpj) 09 Oct '26

09 Oct '26

Simon Peyton Jones pushed to branch wip/substitution-via-mapper at Glasgow Haskell Compiler / GHC Commits: 966da29b by Simon Peyton Jones at 2026-10-09T15:44:32+01:00 Remove the Eq and Ord instances for ForAllTyFlag In Note [Comparing visibility] in GHC.Core.TyCo.Compare we read that "we always compare ForAllTyFlags with `eqForAllVis` or `cmpForAllVis`" But alas there was an Eq and Ord instance for ForAllTyFlag, which made it impossible to check this claim. So I made these changes: * Move the definition of ForAllTyFlag and its related functions from L.H.S.Specificity (where it did not belong, since L.H.S didn't use it) into GHC.Types.Var. * Remove the Eq and Ord instances for ForAllTyFlag * Deal with the fallout, by using `eqForAllVis` or related functions. * In interface files we use IfaceType as a key for a de-deduplication map See Note [Deduplication during iface binary serialisation] in GHC.Iface.Binary. For this we need /exact/ comparison, so we use a newtype wrapper for IfaceForAllTyFlag, and give use `cmpForAllTyFlagExactly` to implement its Ord instance. Tiresome but easy. * Rename `toIfaceForAllBndrs` to `toIfaceForAllTyBndrs` - - - - - 18828859 by Simon Peyton Jones at 2026-10-09T15:44:32+01:00 Refactor type and coercion substitution This MR refactors type and coercion substitution so that they use TyCoMapper, rather than hand-rolled code. Fundamentally it's a simple idea, but I had to do quite a bit of refactoring to make it fly. I got Claude to help me this this refactoring, but I paid careful attention to every line of code. Main changes: * New module GHC.Core.TyCo.Make which defines TyCoMapper, and a bunch of other simple "smart constructors" for types and coercions. See GHC.Core.TyCo.Rep Note [The Type-related module hierarchy], esp (TRM1) * The new TyCoMapper has new fields `tcm_tcapp_ty` and `tcm_tcapp_co` to handle type-constructor applications. These replace `tcm_tycon`. * Rewrite GHC.Core.TyCo.Subst to use TyCoMapper * Rewrite GHC.Core.Type.expandTypeSynonyms to use TyCoMapper. * Implement `seqType` and `seqCo` with TyCoFolder. To to this I had to add a `tcf_lit` field to TyCoFolder. * A new module GHC.Utils.StrictIdentity to define a strict identity monad, which itself is used for substTyCoMapper :: TyCoMapper Subst StrictIdentity * I removed an apparently-unused Binary instance for Levity Refactoring `seq` functions * In GHC.Core.Seq, redefine `seqOneShot`, `seqRuleInfo`, and friends to return `SeqResult`, a new type defined in GHC.Types.Basic, rather than `()`. We can define a Monoid instance for `SeqResult` that does the right thing. * This has knock-on effects across the compiler. - - - - - 58 changed files: - compiler/GHC/Builtin/WiredIn/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - + compiler/GHC/Core/TyCo/Make.hs - + compiler/GHC/Core/TyCo/Make.hs-boot - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToIface.hs-boot - compiler/GHC/Driver/Main/Compile.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Iface/Type.hs-boot - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/EnforceEpt/TagSig.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Cpr.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Map.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Types/Var.hs-boot - compiler/GHC/Types/Var/Set.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - + compiler/GHC/Utils/StrictIdentity.hs - compiler/Language/Haskell/Syntax/Specificity.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsParser.stdout - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f3936973889f93d19eddda69d5fda… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f3936973889f93d19eddda69d5fda… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/romes/async-rpc] more things in GHCi.Message
by Rodrigo Mesquita (＠alt-romes) 09 Oct '26

09 Oct '26

Rodrigo Mesquita pushed to branch wip/romes/async-rpc at Glasgow Haskell Compiler / GHC Commits: bd510cf1 by Rodrigo Mesquita at 2026-10-09T15:22:04+01:00 more things in GHCi.Message - - - - - 1 changed file: - libraries/ghci/GHCi/Message.hs Changes: ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -34,8 +34,10 @@ module GHCi.Message -- * Consume `reply` exactly once , WriteReply -- abstract , writeReply - -- , thenLinearly - -- , forkIOLinearly + + -- * Low-level interface for async bidirectional RPC + , withAsyncReq + , withAsyncHandler ) where import Prelude -- See note [Why do we import Prelude here?] @@ -786,7 +788,11 @@ remoteTHCall pipe msg = bimap fromSerializableException id . runGet get <$> withAsyncReq pipe (putTHMessage msg) -- | Handle a 'THMessage' request on the host and reply to the interpreter --- handleRemoteTHCall = undefined +handleRemoteTHCall + :: Pipe -> (forall a. Binary a => WriteReply a %1 -> Message a -> IO r) -> IO r +handleRemoteTHCall pipe k = + withAsyncHandler pipe getMessage \(WriteReply reply) (Msg @a msg) -> do + k (WriteReply (reply . fmap (put @a))) msg -------------------------------------------------------------------------------- -- * Matching requests with async replies @@ -815,6 +821,10 @@ withAsyncReq pipe msg = do -- The handler receives as an argument the function to use to reply to the request. -- It must be used exactly once (all requests expect a reply, and you can't -- reply more than once). Linear types enforce this. +-- +-- TODO: list of @a -> Bool@s or other proxy for which the handler runs in a +-- forked thread? better than linear forkIO that can be misleading or used +-- improperly for other linear stuff withAsyncHandler :: Pipe -> Get a -> (WriteReply Put %1 -> a -> IO r) -> IO r withAsyncHandler pipe getit k = do ack <- newEmptyMVar View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd510cf1e2b276763fd9ac67128d03f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd510cf1e2b276763fd9ac67128d03f… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/romes/async-rpc] nvm: sendMessage doesn't shutdown interp. if you want to, catch RemoteCallFailed
by Rodrigo Mesquita (＠alt-romes) 09 Oct '26

09 Oct '26

Rodrigo Mesquita pushed to branch wip/romes/async-rpc at Glasgow Haskell Compiler / GHC Commits: fd8c7167 by Rodrigo Mesquita at 2026-10-09T15:14:49+01:00 nvm: sendMessage doesn't shutdown interp. if you want to, catch RemoteCallFailed - - - - - 1 changed file: - compiler/GHC/Runtime/Interpreter/Process.hs Changes: ===================================== compiler/GHC/Runtime/Interpreter/Process.hs ===================================== @@ -3,6 +3,7 @@ module GHC.Runtime.Interpreter.Process -- * Message API Message(..) , sendMessage + , RemoteCallFailed(..) ) where @@ -18,12 +19,14 @@ import GHC.Utils.Exception as Ex import Data.Binary import System.Exit import System.Process -import Data.Bifunctor -- ----------------------------------------------------------------------------- -- Top-level Message API -- | Send a message to the interpreter and expect a response, blocking until it arrives. +-- +-- Throws 'RemoteCallFailed' if the remote call threw an exception in the +-- external interpreter sendMessage :: Binary a => ExtInterpInstance d -> Message a -> IO a sendMessage i msg = unwrapRight =<< remoteCall (interpPipe proc) msg @@ -33,10 +36,7 @@ sendMessage i msg = unwrapRight =<< unwrapRight :: Either SomeException b -> IO b unwrapRight (Right a) = pure a unwrapRight (Left er) = do - let ex = RemoteCallFailed er - unwrapRight . bimap (addExceptionContext (WhileHandling (SomeException ex))) id - =<< remoteCall (interpPipe proc) Shutdown - throwIO ex + throwIO (RemoteCallFailed er) handleInterpProcessFailure :: InterpProcess -> SomeException -> IO a handleInterpProcessFailure i e = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd8c71678c0c21afe375bcec6e63e42… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd8c71678c0c21afe375bcec6e63e42… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0