- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/26543] Improve simpleUnifyCheck and coercion holes
by Simon Peyton Jones (＠simonpj) 03 Nov '25

03 Nov '25

Simon Peyton Jones pushed to branch wip/26543 at Glasgow Haskell Compiler / GHC Commits: 2d55348a by Simon Peyton Jones at 2025-11-03T23:40:29+00:00 Improve simpleUnifyCheck and coercion holes Fixes #26543. Rahter rejecting holes, look in the kind of the hole - - - - - 4 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Utils/Unify.hs - + testsuite/tests/impredicative/T26543.hs - testsuite/tests/impredicative/all.T Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -2057,6 +2057,7 @@ qlUnify ty1 ty2 -- Here we are in the TcM monad, which does not track enclosing -- Given equalities; so for quick-look unification we conservatively -- treat /any/ level outside this one as untouchable. Hence cur_lvl. + -- See (UQL5) in Note [QuickLook unification] ; case simpleUnifyCheck UC_QuickLook cur_lvl kappa ty2 of SUC_CanUnify -> do { co <- unifyKind (Just (TypeThing ty2)) ty2_kind kappa_kind @@ -2129,6 +2130,17 @@ That is the entire point of qlUnify! Wrinkles: It's just not worth the trouble, we think (for now at least). +(UQL5) We call `simpleUnifyCheck` for the occurs-check etc; see (UQL1). Usually it's fine + for `simpleUnifyCheck` to bale out saying `SUC_NotSure`, because usually we'll just generate + an equality we solve later. But in QuickLook, baling out may mean we don't find a good + type for an instantiation variable, which in turn may make the program fail to typecheck. + So `simpleUnifyCheck` is more than just an erfficiency thing. + Example (#26543): we get qlUnify( (Eq (alpha |> {co}) => beta) -> Int + , kappa1 -> Int ) + where `{co}` is a coercion hole. We want to unify + kappa1 := Eq (alpha |> {co}) => beta + Failing to do so rejects the program. To allow this, we just check the /kind/ of the + coercion hole {co}; see Sadly discarded design alternative ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -3194,6 +3194,8 @@ simpleUnifyCheck :: UnifyCheckCaller -> TcLevel -> TcTyVar -> TcType -> SimpleUn -- * Rejects type families unless fam_ok=True -- * Does a level-check for type variables, to avoid skolem escape -- +-- See also (UQL5) in Note [QuickLook unification] +-- -- This function is pretty heavily used, so it's optimised not to allocate simpleUnifyCheck caller given_eq_lvl lhs_tv rhs | not $ touchabilityTest given_eq_lvl lhs_tv @@ -3254,9 +3256,11 @@ simpleUnifyCheck caller given_eq_lvl lhs_tv rhs mkOccFolders :: Name -> (TcType -> Bool, TcCoercion -> Bool) --- These functions return True --- * if lhs_tv occurs (incl deeply, in the kind of variable) --- * if there is a coercion hole +-- These functions are used when doing an occurs check. +-- They return True if lhs_tv occurs in the type, or coercion resp, +-- including deeply, +-- - in the kind of type variable +-- - in the kind of a coercion hole -- No expansion of type synonyms mkOccFolders lhs_tv = (getAny . check_ty, getAny . check_co) where @@ -3270,7 +3274,14 @@ mkOccFolders lhs_tv = (getAny . check_ty, getAny . check_co) `mappend` check_ty (varType v) do_bndr is tcv _faf = extendVarSet is tcv - do_hole _is _hole = DM.Any True -- Reject coercion holes + + do_hole _is hole = check_ty (varType (coHoleCoVar hole)) + -- For coercion holes, look in the kind of the hole + -- I worry that the coercion hole could be filled with a coercion that + -- mentions `lhs_tv` in the coercion, but not in the /kind/ of that + -- coercion. But that seems remote; and it is the /same/ choice that is + -- made in `GHC.Tc.Utils.Unify.checkCo`. + -- See (UQL5) in Note [QuickLook unification] {- ********************************************************************* * * ===================================== testsuite/tests/impredicative/T26543.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE GHC2024, TypeAbstractions, AllowAmbiguousTypes, TypeFamilies #-} +module T26543 where + +import Data.Kind (Type) + +withObProd :: forall a r. ((Eq a) => r) -> r +withObProd = withObProd + +type Ap :: k -> Type +data Ap a where + Ap :: forall {k} (a :: k). Ap a + +type family Ap2 :: Type -> Type +type instance Ap2 = Ap + +f :: forall (a :: Type). Ap2 a -> Bool +f (Ap @x') = withObProd @x' $ True + + +-- ($) :: (p->q) -> p -> q +-- QL sees that: p = Eq a => Bool +-- q = Bool ===================================== testsuite/tests/impredicative/all.T ===================================== @@ -22,3 +22,4 @@ test('T17332', normal, compile_fail, ['']) test('expr-sig', normal, compile, ['']) test('Dict', normal, compile, ['']) test('T24676', normal, compile, ['']) +test('T26543', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2d55348a4607da243f90049201338f7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2d55348a4607da243f90049201338f7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/26543
by Simon Peyton Jones (＠simonpj) 03 Nov '25

03 Nov '25

Simon Peyton Jones pushed new branch wip/26543 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/26543 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: Supplant TcRnExportHiddenComponents with TcRnDodgyExports (#26534)
by Marge Bot (＠marge-bot) 03 Nov '25

03 Nov '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 86c82745 by Vladislav Zavialov at 2025-11-01T07:24:29-04:00 Supplant TcRnExportHiddenComponents with TcRnDodgyExports (#26534) Remove a bogus special case in lookup_ie_kids_all, making TcRnExportHiddenComponents obsolete. - - - - - fcf6331e by Richard Eisenberg at 2025-11-03T08:33:05+00:00 Refactor fundep solving This commit is a large-scale refactor of the increasingly-messy code that handles functional dependencies. It has virtually no effect on what compiles but improves error messages a bit. And it does the groundwork for #23162. The big picture is described in Note [Overview of functional dependencies in type inference] in GHC.Tc.Solver.FunDeps * New module GHC.Tc.Solver.FunDeps contains all the fundep-handling code for the constraint solver. * Fundep-equalities are solved in a nested scope; they may generate unifications but otherwise have no other effect. See GHC.Tc.Solver.FunDeps.solveFunDeps The nested needs to start from the Givens in the inert set, but not the Wanteds; hence a new function `resetInertCans`, used in `nestFunDepsTcS`. * That in turn means that fundep equalities never show up in error messages, so the complicated FunDepOrigin tracking can all disappear. * We need to be careful about tracking unifications, so we kick out constraints from the inert set after doing unifications. Unification tracking has been majorly reformed: see Note [WhatUnifications] in GHC.Tc.Utils.Unify. A good consequence is that the hard-to-grok `resetUnificationFlag` has been replaced with a simpler use of `reportCoarseGrainUnifications` Smaller things: * Rename `FunDepEqn` to `FunDepEqns` since it contains multiple type equalities. Some compile time improvement Metrics: compile_time/bytes allocated Baseline Test value New value Change ---------------------- -------------------------------------- T5030(normal) 173,839,232 148,115,248 -14.8% GOOD hard_hole_fits(normal) 286,768,048 284,015,416 -1.0% geo. mean -0.2% minimum -14.8% maximum +0.3% Metric Decrease: T5030 - - - - - 231adc30 by Simon Peyton Jones at 2025-11-03T08:33:05+00:00 QuickLook's tcInstFun should make instantiation variables directly tcInstFun must make "instantiation variables", not regular unification variables, when instantiating function types. That was previously implemented by a hack: set the /ambient/ level to QLInstTyVar. But the hack finally bit me, when I was refactoring WhatUnifications. And it was always wrong: see the now-expunged (TCAPP2) note. This commit does it right, by making tcInstFun call its own instantiation functions. That entails a small bit of duplication, but the result is much, much cleaner. - - - - - 39d4a24b by Simon Peyton Jones at 2025-11-03T08:33:05+00:00 Build implication for constraints from (static e) This commit addresses #26466, by buiding an implication for the constraints arising from a (static e) form. The implication has a special ic_info field of StaticFormSkol, which tells the constraint solver to use an empty set of Givens. See (SF3) in Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable This commit also reinstates an `assert` in GHC.Tc.Solver.Equality. The test `StaticPtrTypeFamily` was failing with an assertion failure, but it now works. - - - - - 2e2aec1e by Simon Peyton Jones at 2025-11-03T08:33:05+00:00 Comments about defaulting representation equalities - - - - - 52a4d1da by Simon Peyton Jones at 2025-11-03T08:33:05+00:00 Improve tracking of rewriter-sets This refactor substantially improves the treatment of so-called "rewriter-sets" in the constraint solver. The story is described in the rewritten Note [Wanteds rewrite Wanteds: rewriter-sets] in GHC.Tc.Types.Constraint Some highlights * Trace the free coercion holes of a filled CoercionHole, in CoercionPlusHoles. See Note [Coercion holes] (COH5) This avoids taking having to take the free coercion variables of a coercion when zonking a rewrriter-set * Many knock on changes * Make fillCoercionHole take CoercionPlusHoles as its argument rather than to separate arguments. * Similarly setEqIfWanted, setWantedE, wrapUnifierAndEmit. * Be more careful about passing the correct CoHoleSet to `rewriteEqEvidence` and friends * Make kickOurAfterFillingCoercionHole more clever. See new Note [Kick out after filling a coercion hole] Smaller matters * Rename RewriterSet to CoHoleSet * Add special-case helper `rewriteEqEvidenceSwapOnly` - - - - - 3e78e1ba by Simon Peyton Jones at 2025-11-03T08:33:05+00:00 Tidy up constraint solving for foralls * In `can_eq_nc_forall` make sure to track Givens that are used in the nested solve step. * Tiny missing-swap bug-fix in `lookup_eq_in_qcis` * Fix some leftover mess from commit 14123ee646f2b9738a917b7cec30f9d3941c13de Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com> Date: Wed Aug 20 00:35:48 2025 +0100 Solve forall-constraints via an implication, again Specifically, trySolveImplication is now dead. - - - - - 973f2c25 by Simon Peyton Jones at 2025-11-03T08:33:05+00:00 Do not treat CoercionHoles as free variables in coercions This fixes a long-standing wart in the free-variable finder; now CoercionHoles are no longer treated as a "free variable" of a coercion. I got big and unexpected performance regressions when making this change. Turned out that CallArity didn't discover that the free variable finder could be eta-expanded, which gave very poor code. So I re-used Note [The one-shot state monad trick] for Endo, resulting in GHC.Utils.EndoOS. Very simple, big win. - - - - - c2b8a0f9 by Simon Peyton Jones at 2025-11-03T08:33:05+00:00 Update debug-tracing in CallArity No effect on behaviour, and commented out anyway - - - - - 9aa5ee99 by Simon Peyton Jones at 2025-11-03T08:33:28+00:00 Comments only -- remove dangling Note references - - - - - 6683f183 by Simon Peyton Jones at 2025-11-03T08:33:28+00:00 Accept error message wibbles - - - - - dc7cff8b by Luite Stegeman at 2025-11-03T14:27:56-05:00 rts: fix eager black holes: record mutated closure and fix assertion This fixes two problems with handling eager black holes, introduced by a1de535f762bc23d4cf23a5b1853591dda12cdc9. - the closure mutation must be recorded even for eager black holes, since the mutator has mutated it before calling threadPaused - The assertion that an unmarked eager black hole must be owned by the TSO calling threadPaused is incorrect, since multiple threads can race to claim the black hole. fixes #26495 - - - - - 103 changed files: - compiler/GHC/Core/Opt/CallArity.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - + compiler/GHC/Tc/Solver/FunDeps.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Solver/Solve.hs-boot - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Unique/DSM.hs - + compiler/GHC/Utils/EndoOS.hs - compiler/ghc.cabal.in - rts/ThreadPaused.c - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/default/default-fail05.stderr - testsuite/tests/dependent/should_fail/T13135_simple.stderr - testsuite/tests/deriving/should_fail/T3621.stderr - testsuite/tests/diagnostic-codes/codes.stdout - testsuite/tests/indexed-types/should_fail/T14369.stderr - testsuite/tests/indexed-types/should_fail/T1897b.stderr - testsuite/tests/linters/notes.stdout - testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr - testsuite/tests/parser/should_fail/T20654a.stderr - testsuite/tests/partial-sigs/should_fail/T14584a.stderr - testsuite/tests/polykinds/T6068.stdout - testsuite/tests/quantified-constraints/T15359.hs - testsuite/tests/rep-poly/RepPolyNPlusK.stderr - testsuite/tests/rep-poly/RepPolyRightSection.stderr - testsuite/tests/rep-poly/T13233.stderr - testsuite/tests/rep-poly/T19709b.stderr - testsuite/tests/rep-poly/T23903.stderr - testsuite/tests/typecheck/no_skolem_info/T13499.stderr - testsuite/tests/typecheck/should_compile/T13651.hs - − testsuite/tests/typecheck/should_compile/T13651.stderr - + testsuite/tests/typecheck/should_compile/T14745.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/hole_constraints_nested.stderr - testsuite/tests/typecheck/should_compile/tc126.hs - testsuite/tests/typecheck/should_fail/AmbigFDs.hs - − testsuite/tests/typecheck/should_fail/AmbigFDs.stderr - testsuite/tests/typecheck/should_fail/FD3.stderr - testsuite/tests/typecheck/should_fail/FDsFromGivens2.stderr - testsuite/tests/typecheck/should_fail/T13506.stderr - testsuite/tests/typecheck/should_fail/T16512a.stderr - testsuite/tests/typecheck/should_fail/T18851b.hs - − testsuite/tests/typecheck/should_fail/T18851b.stderr - testsuite/tests/typecheck/should_fail/T18851c.hs - − testsuite/tests/typecheck/should_fail/T18851c.stderr - testsuite/tests/typecheck/should_fail/T19415.stderr - testsuite/tests/typecheck/should_fail/T19415b.stderr - testsuite/tests/typecheck/should_fail/T22684.stderr - + testsuite/tests/typecheck/should_fail/T23162a.hs - + testsuite/tests/typecheck/should_fail/T23162a.stderr - testsuite/tests/typecheck/should_fail/T25325.stderr - testsuite/tests/typecheck/should_fail/T5246.stderr - testsuite/tests/typecheck/should_fail/T5978.stderr - testsuite/tests/typecheck/should_fail/T7368a.stderr - testsuite/tests/typecheck/should_fail/T7696.stderr - testsuite/tests/typecheck/should_fail/T8603.stderr - testsuite/tests/typecheck/should_fail/T9612.stderr - testsuite/tests/typecheck/should_fail/TcStaticPointersFail03.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail122.stderr - testsuite/tests/typecheck/should_fail/tcfail143.stderr - + testsuite/tests/warnings/should_compile/DodgyExports02.hs - + testsuite/tests/warnings/should_compile/DodgyExports02.stderr - + testsuite/tests/warnings/should_compile/DodgyExports03.hs - + testsuite/tests/warnings/should_compile/DodgyExports03.stderr - testsuite/tests/warnings/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21d446c574d6c76f2e8499c4331cf0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21d446c574d6c76f2e8499c4331cf0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/ghc-stack-profiler] Sample Profiler commit
by Hannes Siebenhandl (＠fendor) 03 Nov '25

03 Nov '25

Hannes Siebenhandl pushed to branch wip/fendor/ghc-stack-profiler at Glasgow Haskell Compiler / GHC Commits: 816114dd by fendor at 2025-11-03T18:34:51+01:00 Sample Profiler commit - - - - - 7 changed files: - .gitmodules - + ghc-stack-profiler - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== .gitmodules ===================================== @@ -124,3 +124,6 @@ [submodule "libraries/template-haskell-quasiquoter"] path = libraries/template-haskell-quasiquoter url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git +[submodule "ghc-stack-profiler"] + path = ghc-stack-profiler + url = https://github.com/well-typed/ghc-stack-profiler ===================================== ghc-stack-profiler ===================================== @@ -0,0 +1 @@ +Subproject commit 1414932e5d3ad5faedd5e640ff6016dcdd83f40d ===================================== ghc/Main.hs ===================================== @@ -80,6 +80,7 @@ import GHC.Iface.Errors.Ppr import GHC.Driver.Session.Mode import GHC.Driver.Session.Lint import GHC.Driver.Session.Units +import GHC.Driver.Monad -- Standard Haskell libraries import System.IO @@ -91,6 +92,17 @@ import Control.Monad.Trans.Except (throwE, runExceptT) import Data.List ( isPrefixOf, partition, intercalate ) import Prelude import qualified Data.List.NonEmpty as NE +#if defined(SAMPLE_TRACER) +import qualified GHC.Stack.Profiler.Sampler as Sampler +#endif + +runWithStackProfiler :: IO () -> IO () +runWithStackProfiler = +#if defined(SAMPLE_TRACER) + Sampler.withStackProfiler (Sampler.SampleIntervalMs 10) +#else + id +#endif ----------------------------------------------------------------------------- -- ToDo: @@ -153,7 +165,8 @@ main = do ShowGhciUsage -> showGhciUsage dflags PrintWithDynFlags f -> putStrLn (f dflags) Right postLoadMode -> - main' postLoadMode units dflags argv3 flagWarnings + reifyGhc $ \session -> runWithStackProfiler $ + reflectGhc (main' postLoadMode units dflags argv3 flagWarnings) session main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn] -> Ghc () ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -27,6 +27,11 @@ Flag threaded Default: True Manual: True +Flag sampleTracer + Description: Whether we instrument the ghc binary with sample tracer when the eventlog is enabled + Default: False + Manual: True + Executable ghc Default-Language: GHC2021 @@ -45,6 +50,10 @@ Executable ghc ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ + if flag(sampleTracer) + build-depends: ghc-stack-profiler + CPP-OPTIONS: -DSAMPLE_TRACER + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -13,6 +13,7 @@ module Packages ( transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, + ghc_stack_profiler, ghc_stack_profiler_core, -- * Package information crossPrefix, programName, nonHsMainPackage, programPath, timeoutPath, @@ -43,7 +44,9 @@ ghcPackages = , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon - , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] + , ghc_stack_profiler_core + , ghc_stack_profiler + ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -135,6 +138,8 @@ unlit = util "unlit" unix = lib "unix" win32 = lib "Win32" xhtml = lib "xhtml" +ghc_stack_profiler = lib "ghc-stack-profiler" `setPath` "ghc-stack-profiler/ghc-stack-profiler" +ghc_stack_profiler_core = lib "ghc-stack-profiler-core" `setPath` "ghc-stack-profiler/ghc-stack-profiler-core" lintersCommon = lib "linters-common" `setPath` "linters/linters-common" lintNotes = linter "lint-notes" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -180,6 +180,8 @@ stage1Packages = do , unlit , xhtml , if winTarget then win32 else unix + , ghc_stack_profiler + , ghc_stack_profiler_core ] , when (not cross) [ hpcBin ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -108,6 +108,12 @@ packageArgs = do , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] + , package ghc_stack_profiler ? mconcat + [ builder (Cabal Flags) ? mconcat + [ arg "-use-ghc-trace-events" + ] + ] + ---------------------------------- ghc --------------------------------- , package ghc ? mconcat [ builder Ghc ? mconcat @@ -116,6 +122,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ (expr (ghcWithInterpreter stage)) `cabalFlag` "internal-interpreter" + , notStage0 `cabalFlag` "sampleTracer" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/816114ddcc2cf9c17805d105609a4ce… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/816114ddcc2cf9c17805d105609a4ce… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-apporv-Oct24] simplify addArgCtxt and push setSrcSpan inside addLExprCtxt. Make sure...
by Apoorv Ingle (＠ani) 03 Nov '25

03 Nov '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 1bf47a14 by Apoorv Ingle at 2025-11-03T11:15:02-06:00 simplify addArgCtxt and push setSrcSpan inside addLExprCtxt. Make sure addExprCtxt is not called by itself - - - - - 3 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -32,8 +32,7 @@ import GHC.Tc.Gen.HsType import GHC.Tc.Utils.Concrete ( unifyConcrete, idConcreteTvs ) import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Evidence -import GHC.Tc.Types.ErrCtxt ( FunAppCtxtFunArg(..), ErrCtxt (..), CodeSrcFlag (..)) -import GHC.Tc.Errors.Ppr (pprErrCtxtMsg) +import GHC.Tc.Types.ErrCtxt ( FunAppCtxtFunArg(..) ) import GHC.Tc.Types.Origin import GHC.Tc.Utils.TcType as TcType import GHC.Tc.Utils.Concrete( hasFixedRuntimeRep_syntactic ) @@ -939,43 +938,22 @@ looks_like_type_arg _ = False addArgCtxt :: Int -> (HsExpr GhcRn, SrcSpan) -> LHsExpr GhcRn -> TcM a -> TcM a -- There are 2 cases: --- 1. In the normal case, we add an informative context (<=> `inGeneratedCode` is `False`) +-- 1. In the normal case, we add an informative context +-- (<=> location span of f or head of application chain is user located) -- "In the third argument of f, namely blah" --- 2. If we are inside generated code (<=> `inGeneratedCode` is `True`) --- (i) If arg_loc is generated do nothing to to LclEnv/LclCtxt --- (ii) If arg_loc is Unhelpful UnhelpfulNoLocationInfo set `tcl_in_gen_code` to `True` --- (iii) if arg_loc is RealSrcLoc then update tcl_loc and add "In the expression: arg" to ErrCtxtStack +-- 2. If head of the application chain is generated +-- "In the expression: arg" + -- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr -- See Note [Expanding HsDo with XXExprGhcRn] in GHC.Tc.Gen.Do -addArgCtxt arg_no (fun, fun_lspan) (L arg_loc arg) thing_inside - = do { in_generated_code <- inGeneratedCode - ; err_ctx <- getErrCtxt - ; env0 <- liftZonkM tcInitTidyEnv - ; err_ctx_msg <- mkErrCtxt env0 err_ctx - ; traceTc "addArgCtxt" (vcat [ text "generated:" <+> ppr in_generated_code - , text "arg: " <+> ppr (arg, arg_no) - , text "arg_loc:" <+> ppr arg_loc - , text "fun:" <+> ppr fun - , text "fun_lspan" <+> ppr fun_lspan - , text "err_ctx" <+> vcat (fmap (\ (x, y) -> - case x of - MkErrCtxt (ExpansionCodeCtxt{}) _ -> text "<EXPN>" <+> pprErrCtxtMsg y - _ -> text "<USER>" <+> pprErrCtxtMsg y) - (take 4 (zip err_ctx err_ctx_msg))) - ]) - ; if not (isGeneratedSrcSpan fun_lspan) - then setSrcSpanA arg_loc $ - addErrCtxt (FunAppCtxt (FunAppCtxtExpr fun arg) arg_no) $ - thing_inside - else updCtxtForArg (L arg_loc arg) $ - thing_inside - } - where - updCtxtForArg :: LHsExpr GhcRn -> TcRn a -> TcRn a - updCtxtForArg e@(L lspan _) thing_inside - = do setSrcSpan (locA lspan) $ - addLExprCtxt e $ -- addLExpr is no op for non-user located exprs - thing_inside +addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside + | isGoodSrcSpan app_head_lspan + = setSrcSpanA arg_loc $ + addErrCtxt (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $ + thing_inside + | otherwise + = addLExprCtxt (locA arg_loc) arg $ + thing_inside ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -121,8 +121,7 @@ tcPolyLExpr, tcPolyLExprNC :: LHsExpr GhcRn -> ExpSigmaType -> TcM (LHsExpr GhcTc) tcPolyLExpr (L loc expr) res_ty - = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad - addLExprCtxt (L loc expr) $ -- Note [Error contexts in generated code] + = addLExprCtxt (locA loc) expr $ -- Note [Error contexts in generated code] do { expr' <- tcPolyExpr expr res_ty ; return (L loc expr') } @@ -240,8 +239,7 @@ tcInferRhoNC = tcInferExprNC IIF_DeepRho tcInferExpr, tcInferExprNC :: InferInstFlag -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType) tcInferExpr iif (L loc expr) - = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad - addLExprCtxt (L loc expr) $ -- Note [Error contexts in generated code] + = addLExprCtxt (locA loc) expr $ -- Note [Error contexts in generated code] do { (expr', rho) <- runInfer iif IFRR_Any (tcExpr expr) ; return (L loc expr', rho) } @@ -267,8 +265,7 @@ tcMonoLExpr, tcMonoLExprNC -> TcM (LHsExpr GhcTc) tcMonoLExpr (L loc expr) res_ty - = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad - addLExprCtxt (L loc expr) $ -- Note [Error contexts in generated code] + = addLExprCtxt (locA loc) expr $ -- Note [Error contexts in generated code] do { expr' <- tcExpr expr res_ty ; return (L loc expr') } ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -26,7 +26,7 @@ module GHC.Tc.Gen.Head , nonBidirectionalErr , pprArgInst - , addExprCtxt, addLExprCtxt, addFunResCtxt ) where + , addLExprCtxt, addFunResCtxt ) where import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckPolyExprNC, tcPolyLExprSig ) import {-# SOURCE #-} GHC.Tc.Gen.Splice( getUntypedSpliceBody ) @@ -1101,8 +1101,9 @@ mis-match in the number of value arguments. * * ********************************************************************* -} -addExprCtxt :: HsExpr GhcRn -> TcRn a -> TcRn a -addExprCtxt e thing_inside +-- | !Caution!: Users should not call add_expr_ctxt, they ought to use addLExprCtxt +add_expr_ctxt :: HsExpr GhcRn -> TcRn a -> TcRn a +add_expr_ctxt e thing_inside = case e of HsHole _ -> thing_inside -- The HsHole special case addresses situations like @@ -1117,12 +1118,12 @@ addExprCtxt e thing_inside _ -> addErrCtxt (ExprCtxt e) thing_inside -- no op in generated code -addLExprCtxt :: LHsExpr GhcRn -> TcRn a -> TcRn a -addLExprCtxt (L lspan e) thing_inside - | (RealSrcSpan{}) <- locA lspan +addLExprCtxt :: SrcSpan -> HsExpr GhcRn -> TcRn a -> TcRn a +addLExprCtxt lspan e thing_inside + | isGoodSrcSpan lspan , (HsPar _ e') <- e - = addExprCtxt (unLoc e') thing_inside - | (RealSrcSpan{}) <- locA lspan - = addExprCtxt e thing_inside + = setSrcSpan lspan $ add_expr_ctxt (unLoc e') thing_inside + | isGoodSrcSpan lspan + = setSrcSpan lspan $ add_expr_ctxt e thing_inside | otherwise = thing_inside View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bf47a14280055339c404f572cd5b0c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bf47a14280055339c404f572cd5b0c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/ghc-stack-profiler] Sample Profiler commit
by Hannes Siebenhandl (＠fendor) 03 Nov '25

03 Nov '25

Hannes Siebenhandl pushed to branch wip/fendor/ghc-stack-profiler at Glasgow Haskell Compiler / GHC Commits: f73bb784 by fendor at 2025-11-03T17:50:48+01:00 Sample Profiler commit - - - - - 7 changed files: - .gitmodules - + eventlog-live-profiling-prototype - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== .gitmodules ===================================== @@ -124,3 +124,6 @@ [submodule "libraries/template-haskell-quasiquoter"] path = libraries/template-haskell-quasiquoter url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git +[submodule "eventlog-live-profiling-prototype"] + path = eventlog-live-profiling-prototype + url = git@gitlab.well-typed.com:well-typed/eventlog-live-profiling-prototype.git ===================================== eventlog-live-profiling-prototype ===================================== @@ -0,0 +1 @@ +Subproject commit b575347b8d17703e9ab77cf998c680fc60039096 ===================================== ghc/Main.hs ===================================== @@ -80,6 +80,7 @@ import GHC.Iface.Errors.Ppr import GHC.Driver.Session.Mode import GHC.Driver.Session.Lint import GHC.Driver.Session.Units +import GHC.Driver.Monad -- Standard Haskell libraries import System.IO @@ -91,6 +92,17 @@ import Control.Monad.Trans.Except (throwE, runExceptT) import Data.List ( isPrefixOf, partition, intercalate ) import Prelude import qualified Data.List.NonEmpty as NE +#if defined(SAMPLE_TRACER) +import qualified GHC.Stack.Profiler.Sampler as Sampler +#endif + +runWithStackProfiler :: IO () -> IO () +runWithStackProfiler = +#if defined(SAMPLE_TRACER) + Sampler.withStackProfiler (Sampler.SampleIntervalMs 10) +#else + id +#endif ----------------------------------------------------------------------------- -- ToDo: @@ -153,7 +165,8 @@ main = do ShowGhciUsage -> showGhciUsage dflags PrintWithDynFlags f -> putStrLn (f dflags) Right postLoadMode -> - main' postLoadMode units dflags argv3 flagWarnings + reifyGhc $ \session -> runWithStackProfiler $ + reflectGhc (main' postLoadMode units dflags argv3 flagWarnings) session main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn] -> Ghc () ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -27,6 +27,11 @@ Flag threaded Default: True Manual: True +Flag sampleTracer + Description: Whether we instrument the ghc binary with sample tracer when the eventlog is enabled + Default: False + Manual: True + Executable ghc Default-Language: GHC2021 @@ -45,6 +50,10 @@ Executable ghc ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ + if flag(sampleTracer) + build-depends: ghc-stack-profiler + CPP-OPTIONS: -DSAMPLE_TRACER + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -13,6 +13,7 @@ module Packages ( transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, + ghc_stack_profiler, ghc_stack_profiler_core, -- * Package information crossPrefix, programName, nonHsMainPackage, programPath, timeoutPath, @@ -43,7 +44,9 @@ ghcPackages = , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon - , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] + , ghc_stack_profiler_core + , ghc_stack_profiler + ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -135,6 +138,8 @@ unlit = util "unlit" unix = lib "unix" win32 = lib "Win32" xhtml = lib "xhtml" +ghc_stack_profiler = lib "ghc-stack-profiler" `setPath` "eventlog-live-profiling-prototype/ghc-stack-profiler" +ghc_stack_profiler_core = lib "ghc-stack-profiler-core" `setPath` "eventlog-live-profiling-prototype/ghc-stack-profiler-core" lintersCommon = lib "linters-common" `setPath` "linters/linters-common" lintNotes = linter "lint-notes" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -180,6 +180,8 @@ stage1Packages = do , unlit , xhtml , if winTarget then win32 else unix + , ghc_stack_profiler + , ghc_stack_profiler_core ] , when (not cross) [ hpcBin ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -108,6 +108,12 @@ packageArgs = do , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] + , package ghc_stack_profiler ? mconcat + [ builder (Cabal Flags) ? mconcat + [ arg "-use-ghc-trace-events" + ] + ] + ---------------------------------- ghc --------------------------------- , package ghc ? mconcat [ builder Ghc ? mconcat @@ -116,6 +122,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ (expr (ghcWithInterpreter stage)) `cabalFlag` "internal-interpreter" + , notStage0 `cabalFlag` "sampleTracer" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f73bb7844a7cd7437ba2c92140aae6f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f73bb7844a7cd7437ba2c92140aae6f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/ghc-stack-profiler] Sample Profiler commit
by Hannes Siebenhandl (＠fendor) 03 Nov '25

03 Nov '25

Hannes Siebenhandl pushed to branch wip/fendor/ghc-stack-profiler at Glasgow Haskell Compiler / GHC Commits: 4e563a0e by fendor at 2025-11-03T17:50:22+01:00 Sample Profiler commit - - - - - 7 changed files: - .gitmodules - + eventlog-live-profiling-prototype - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== .gitmodules ===================================== @@ -124,3 +124,6 @@ [submodule "libraries/template-haskell-quasiquoter"] path = libraries/template-haskell-quasiquoter url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git +[submodule "eventlog-live-profiling-prototype"] + path = eventlog-live-profiling-prototype + url = git@gitlab.well-typed.com:well-typed/eventlog-live-profiling-prototype.git ===================================== eventlog-live-profiling-prototype ===================================== @@ -0,0 +1 @@ +Subproject commit b575347b8d17703e9ab77cf998c680fc60039096 ===================================== ghc/Main.hs ===================================== @@ -80,6 +80,7 @@ import GHC.Iface.Errors.Ppr import GHC.Driver.Session.Mode import GHC.Driver.Session.Lint import GHC.Driver.Session.Units +import GHC.Driver.Monad -- Standard Haskell libraries import System.IO @@ -91,6 +92,17 @@ import Control.Monad.Trans.Except (throwE, runExceptT) import Data.List ( isPrefixOf, partition, intercalate ) import Prelude import qualified Data.List.NonEmpty as NE +#if defined(SAMPLE_TRACER) +import qualified GHC.Stack.Profiler.Sampler as Sampler +#endif + +runWithStackProfiler :: IO () -> IO () +runWithStackProfiler = +#if defined(SAMPLE_TRACER) + Sampler.withStackProfiler (SampleIntervalMs 10) +#else + id +#endif ----------------------------------------------------------------------------- -- ToDo: @@ -153,7 +165,8 @@ main = do ShowGhciUsage -> showGhciUsage dflags PrintWithDynFlags f -> putStrLn (f dflags) Right postLoadMode -> - main' postLoadMode units dflags argv3 flagWarnings + reifyGhc $ \session -> runWithStackProfiler $ + reflectGhc (main' postLoadMode units dflags argv3 flagWarnings) session main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn] -> Ghc () ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -27,6 +27,11 @@ Flag threaded Default: True Manual: True +Flag sampleTracer + Description: Whether we instrument the ghc binary with sample tracer when the eventlog is enabled + Default: False + Manual: True + Executable ghc Default-Language: GHC2021 @@ -45,6 +50,10 @@ Executable ghc ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ + if flag(sampleTracer) + build-depends: ghc-stack-profiler + CPP-OPTIONS: -DSAMPLE_TRACER + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -13,6 +13,7 @@ module Packages ( transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, + ghc_stack_profiler, ghc_stack_profiler_core, -- * Package information crossPrefix, programName, nonHsMainPackage, programPath, timeoutPath, @@ -43,7 +44,9 @@ ghcPackages = , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon - , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] + , ghc_stack_profiler_core + , ghc_stack_profiler + ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -135,6 +138,8 @@ unlit = util "unlit" unix = lib "unix" win32 = lib "Win32" xhtml = lib "xhtml" +ghc_stack_profiler = lib "ghc-stack-profiler" `setPath` "eventlog-live-profiling-prototype/ghc-stack-profiler" +ghc_stack_profiler_core = lib "ghc-stack-profiler-core" `setPath` "eventlog-live-profiling-prototype/ghc-stack-profiler-core" lintersCommon = lib "linters-common" `setPath` "linters/linters-common" lintNotes = linter "lint-notes" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -180,6 +180,8 @@ stage1Packages = do , unlit , xhtml , if winTarget then win32 else unix + , ghc_stack_profiler + , ghc_stack_profiler_core ] , when (not cross) [ hpcBin ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -108,6 +108,12 @@ packageArgs = do , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] + , package ghc_stack_profiler ? mconcat + [ builder (Cabal Flags) ? mconcat + [ arg "-use-ghc-trace-events" + ] + ] + ---------------------------------- ghc --------------------------------- , package ghc ? mconcat [ builder Ghc ? mconcat @@ -116,6 +122,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ (expr (ghcWithInterpreter stage)) `cabalFlag` "internal-interpreter" + , notStage0 `cabalFlag` "sampleTracer" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e563a0e1f79d0b2fc0f85ea564e924… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e563a0e1f79d0b2fc0f85ea564e924… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/ghc-stack-profiler] Sample Profiler commit
by Hannes Siebenhandl (＠fendor) 03 Nov '25

03 Nov '25

Hannes Siebenhandl pushed to branch wip/fendor/ghc-stack-profiler at Glasgow Haskell Compiler / GHC Commits: b5dc992c by fendor at 2025-11-03T17:42:50+01:00 Sample Profiler commit - - - - - 7 changed files: - .gitmodules - + eventlog-live-profiling-prototype - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== .gitmodules ===================================== @@ -124,3 +124,6 @@ [submodule "libraries/template-haskell-quasiquoter"] path = libraries/template-haskell-quasiquoter url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git +[submodule "eventlog-live-profiling-prototype"] + path = eventlog-live-profiling-prototype + url = git@gitlab.well-typed.com:well-typed/eventlog-live-profiling-prototype.git ===================================== eventlog-live-profiling-prototype ===================================== @@ -0,0 +1 @@ +Subproject commit 67d128df85e0ebfac54e566e1cdb3bf5d5149031 ===================================== ghc/Main.hs ===================================== @@ -80,6 +80,7 @@ import GHC.Iface.Errors.Ppr import GHC.Driver.Session.Mode import GHC.Driver.Session.Lint import GHC.Driver.Session.Units +import GHC.Driver.Monad -- Standard Haskell libraries import System.IO @@ -91,6 +92,17 @@ import Control.Monad.Trans.Except (throwE, runExceptT) import Data.List ( isPrefixOf, partition, intercalate ) import Prelude import qualified Data.List.NonEmpty as NE +#if defined(SAMPLE_TRACER) +import qualified GHC.Stack.Profiler.Sampler as Sampler +#endif + +runWithSampleProfiler :: IO () -> IO () +runWithSampleProfiler = +#if defined(SAMPLE_TRACER) + Sampler.withSampleProfiler 10000 {- Every 10 ms -} +#else + id +#endif ----------------------------------------------------------------------------- -- ToDo: @@ -153,7 +165,8 @@ main = do ShowGhciUsage -> showGhciUsage dflags PrintWithDynFlags f -> putStrLn (f dflags) Right postLoadMode -> - main' postLoadMode units dflags argv3 flagWarnings + reifyGhc $ \session -> runWithSampleProfiler $ + reflectGhc (main' postLoadMode units dflags argv3 flagWarnings) session main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn] -> Ghc () ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -27,6 +27,11 @@ Flag threaded Default: True Manual: True +Flag sampleTracer + Description: Whether we instrument the ghc binary with sample tracer when the eventlog is enabled + Default: False + Manual: True + Executable ghc Default-Language: GHC2021 @@ -45,6 +50,10 @@ Executable ghc ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ + if flag(sampleTracer) + build-depends: ghc-stack-profiler + CPP-OPTIONS: -DSAMPLE_TRACER + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -13,6 +13,7 @@ module Packages ( transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, + ghc_stack_profiler, ghc_stack_profiler_core, -- * Package information crossPrefix, programName, nonHsMainPackage, programPath, timeoutPath, @@ -43,7 +44,9 @@ ghcPackages = , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon - , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] + , ghc_stack_profiler_core + , ghc_stack_profiler + ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -135,6 +138,8 @@ unlit = util "unlit" unix = lib "unix" win32 = lib "Win32" xhtml = lib "xhtml" +ghc_stack_profiler = lib "ghc-stack-profiler" `setPath` "eventlog-live-profiling-prototype/ghc-stack-profiler" +ghc_stack_profiler_core = lib "ghc-stack-profiler-core" `setPath` "eventlog-live-profiling-prototype/ghc-stack-profiler-core" lintersCommon = lib "linters-common" `setPath` "linters/linters-common" lintNotes = linter "lint-notes" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -180,6 +180,8 @@ stage1Packages = do , unlit , xhtml , if winTarget then win32 else unix + , ghc_stack_profiler + , ghc_stack_profiler_core ] , when (not cross) [ hpcBin ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -108,6 +108,12 @@ packageArgs = do , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] + , package ghc_stack_profiler ? mconcat + [ builder (Cabal Flags) ? mconcat + [ arg "-use-ghc-trace-events" + ] + ] + ---------------------------------- ghc --------------------------------- , package ghc ? mconcat [ builder Ghc ? mconcat @@ -116,6 +122,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ (expr (ghcWithInterpreter stage)) `cabalFlag` "internal-interpreter" + , notStage0 `cabalFlag` "sampleTracer" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5dc992c16b1edf1801f97d3d7be21f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5dc992c16b1edf1801f97d3d7be21f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/fendor/ghc-stack-profiler
by Hannes Siebenhandl (＠fendor) 03 Nov '25

03 Nov '25

Hannes Siebenhandl pushed new branch wip/fendor/ghc-stack-profiler at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/ghc-stack-profiler You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED] Increase timeout for emulators
by Sven Tennie (＠supersven) 03 Nov '25

03 Nov '25

Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED at Glasgow Haskell Compiler / GHC Commits: ca612978 by Sven Tennie at 2025-11-03T15:54:01+01:00 Increase timeout for emulators Test runs with emulators naturally take longer than on native machines. - - - - - 2 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -20,6 +20,7 @@ import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.Set as S import System.Environment import Data.List +import Data.Char (isSpace) {- Note [Generating the CI pipeline] @@ -885,14 +886,24 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } Emulator s -> "CROSS_EMULATOR" =: s NoEmulatorNeeded -> mempty , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty - , let runtestArgs = + , let testTimeoutArg = + case crossEmulator buildConfig of + -- Emulators are naturally slower than native machines. + -- Triple the default of 300. + Emulator _ -> "-e config.timeout=900" :: String + _ -> mempty + runtestArgs = + testTimeoutArg : [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" | validateNonmovingGc buildConfig ] - in "RUNTEST_ARGS" =: unwords runtestArgs + in "RUNTEST_ARGS" =: (trim . unwords) runtestArgs , if testsuiteUsePerf buildConfig then "RUNTEST_ARGS" =: "--config perf_path=perf" else mempty ] + trim :: String -> String + trim = dropWhileEnd isSpace . dropWhile isSpace + jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" ===================================== .gitlab/jobs.yaml ===================================== @@ -389,7 +389,7 @@ "OBJCOPY": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-objcopy", "OBJDUMP": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-objdump", "RANLIB": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-llvm-ranlib", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "SIZE": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-size", "STRINGS": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-strings", "STRIP": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-strip", @@ -471,7 +471,7 @@ "OBJCOPY": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-objcopy", "OBJDUMP": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-objdump", "RANLIB": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-llvm-ranlib", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "SIZE": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-size", "STRINGS": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-strings", "STRIP": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-strip", @@ -1060,7 +1060,7 @@ "OBJCOPY": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-objcopy", "OBJDUMP": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-objdump", "RANLIB": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-llvm-ranlib", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "SIZE": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-size", "STRINGS": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-strings", "STRIP": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-strip", @@ -1143,7 +1143,7 @@ "OBJCOPY": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-objcopy", "OBJDUMP": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-objdump", "RANLIB": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-llvm-ranlib", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "SIZE": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-size", "STRINGS": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-strings", "STRIP": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-strip", @@ -2055,7 +2055,7 @@ "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-linux-gnu", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -2122,7 +2122,7 @@ "CROSS_STAGE": "2", "CROSS_TARGET": "javascript-unknown-ghcjs", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -2504,7 +2504,7 @@ "CROSS_STAGE": "2", "CROSS_TARGET": "riscv64-linux-gnu", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -3518,7 +3518,7 @@ "CROSS_STAGE": "2", "CROSS_TARGET": "loongarch64-linux-gnu", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-ubuntu24_04-loongarch-cross_loongarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -6165,7 +6165,7 @@ "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-linux-gnu", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, @@ -6231,7 +6231,7 @@ "CROSS_STAGE": "2", "CROSS_TARGET": "javascript-unknown-ghcjs", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate" } }, @@ -6608,7 +6608,7 @@ "CROSS_STAGE": "2", "CROSS_TARGET": "riscv64-linux-gnu", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-validate" } }, @@ -7607,7 +7607,7 @@ "CROSS_STAGE": "2", "CROSS_TARGET": "loongarch64-linux-gnu", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "", + "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-ubuntu24_04-loongarch-cross_loongarch64-linux-gnu-validate" } }, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca6129780c811d78cfbc04fde5f1ac5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca6129780c811d78cfbc04fde5f1ac5… You're receiving this email because of your account on gitlab.haskell.org.

1 0