September 2026 - ghc-commits

[Git][ghc/ghc][wip/apk/expose-overloaded-unfoldings] Enable -fexpose-overloaded-unfoldings by default when optimizations are on.
by Andreas Klebinger (＠AndreasK) 16 Sep '26

16 Sep '26

Andreas Klebinger pushed to branch wip/apk/expose-overloaded-unfoldings at Glasgow Haskell Compiler / GHC Commits: b1eb8241 by Andreas Klebinger at 2026-09-15T14:53:55+02:00 Enable -fexpose-overloaded-unfoldings by default when optimizations are on. - - - - - 4 changed files: - + changelog.d/T13090-expose-overloaded-unfoldings - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Iface/Tidy.hs - docs/users_guide/using-optimisation.rst Changes: ===================================== changelog.d/T13090-expose-overloaded-unfoldings ===================================== @@ -0,0 +1,6 @@ +section: compiler +issues: #13090 +mrs: !16684 +synopsis: + Enable :ghc-flag:`-fexpose-overloaded-unfoldings` by default with :ghc-flag:`-O` or higher. + ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1337,6 +1337,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([1,2], Opt_Specialise) , ([1,2], Opt_PolymorphicSpecialisation) -- Now on by default (#23559) , ([1,2], Opt_CrossModuleSpecialise) + , ([1,2], Opt_ExposeOverloadedUnfoldings) -- See Note [Exposing overloaded functions] in GHC.Iface.Tidy , ([1,2], Opt_InlineGenerics) , ([1,2], Opt_Strictness) , ([1,2], Opt_UnboxSmallStrictFields) ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -806,8 +806,19 @@ anyway we allow for some false positives and simply expose all functions which have a constraint. This means we might expose more unhelpful unfoldings. But it seems like the better choice. -Currently this option is off by default and has to be enabled manually. But -we might change this in the future. +We enable the flag by default with -O/O2 to allow users to opt into specialization +at call sites. We do not enable -fspecialize-aggressively. See also #13090. + +In terms of performance impact the cost is very modest: +On GHC and it's boot libraries overall enabling this flag increases overall disk +space used by ~1%. With a highly variant distribution across various .hi files. +In terms of compile times the overhead is low enough to be hard to measure, but +seemed to be less than 0.2% if anything at all. + +It seems tempting to do the same for -fspecialize-aggressively, but that comes in +at a hefty 20% compile time overhead. So we only provide the unfoldings and leave +the choice of how much specialization to enable up to the user. + -} {- ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -624,10 +624,10 @@ as such you shouldn't need to set any of them explicitly. A flag :reverse: -fno-expose-overloaded-unfoldings :category: - :default: off + :default: -O and above :since: 9.12.1 - This experimental flag is a slightly less heavy weight alternative + This flag is a slightly less heavy weight alternative to :ghc-flag:`-fexpose-all-unfoldings`. Instead of exposing all functions it exposes only those functions which View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1eb8241e455377551bba1c3c889ae4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1eb8241e455377551bba1c3c889ae4… 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/T27724] Redesign the noinline magic
by Simon Peyton Jones (＠simonpj) 16 Sep '26

16 Sep '26

Simon Peyton Jones pushed to branch wip/T27724 at Glasgow Haskell Compiler / GHC Commits: dc55d4ce by Simon Peyton Jones at 2026-09-15T17:34:57+01:00 Redesign the noinline magic Main idea: * When simplifying `noinline (f e1 e2)`, switch off inlining when simplifying `f` * Mechanism: see `simplOutId`, the `noinlineIdKey` case * If we see `noinline (f e1) e2`, the simplifier moves the `e2` inside; see the `splitContArgs` call. This is important so you can write `noinliine f e1 e2` and have it mean the same as `noinline (f e1 e2)`. * Now `f` sees all its arguments, henc: * Fixes #27724 * Fixes #23911 * Also fixes #27803 where we were not respecting `noinline` if the RHS was trivial See Note [noinlineId magic] for lots of specifics. It's surprisingly tricky! For some reason a couple of perf tests allocate 1.2% less at compile time,n namely T29872 and T8095. Geom mean decease of 0.1% Metric Decrease: T9872d - - - - - 32 changed files: - + changelog.d/T27724 - compiler/GHC/Builtin/WiredIn/Ids.hs - compiler/GHC/Builtin/WiredIn/Prim.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Types/Origin.hs - libraries/ghc-internal/src/GHC/Internal/Magic.hs - testsuite/tests/corelint/LintEtaExpand.hs - + testsuite/tests/dmdanal/should_compile/T23911.hs - + testsuite/tests/dmdanal/should_compile/T23911.stderr - testsuite/tests/dmdanal/should_compile/all.T - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/simplCore/should_compile/T18995.stderr - + testsuite/tests/simplCore/should_compile/T27724a.hs - + testsuite/tests/simplCore/should_compile/T27724a.stderr - + testsuite/tests/simplCore/should_compile/T27803.hs - + testsuite/tests/simplCore/should_compile/T27803.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/typecheck/should_fail/T17940.stderr - utils/genprimopcode/Main.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc55d4ce900445241c228693fe3bc1a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc55d4ce900445241c228693fe3bc1a… 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/wip/27786] hadrian: pass transitive dependencies to haddock
by Zubin (＠wz1000) 15 Sep '26

15 Sep '26

Zubin pushed to branch wip/wip/27786 at Glasgow Haskell Compiler / GHC Commits: 8a368ffb by Zubin Duggal at 2026-09-15T17:18:26+05:30 hadrian: pass transitive dependencies to haddock Haddock looks up the docs of a reexported name in the interface of the package defining it, which may not be a direct dependency. Since base reexports ghc-internal, packages reexporting from base (e.g. stm) couldn't find docs from transitive dependencies. Fixes #25850 Fixes #27786 - - - - - 2 changed files: - + changelog.d/hadrian-haddock-transitive-deps-27786 - hadrian/src/Rules/Documentation.hs Changes: ===================================== changelog.d/hadrian-haddock-transitive-deps-27786 ===================================== @@ -0,0 +1,6 @@ +section: packaging +synopsis: Hadrian now passes the interfaces of all transitive dependencies to + Haddock, so documentation of entities reexported from ``ghc-internal`` via + ``base`` (e.g. in ``stm``) is no longer missing. +issues: #27786 #25850 +mrs: !16691 ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -422,9 +422,19 @@ buildManPage = do checkSphinxWarnings dir copyFileUntracked (dir -/- "ghc.1") file --- | Find the Haddock files for the dependencies of the current library. +-- | Find the Haddock files for the transitive dependencies of the current +-- library. Transitive because the package defining a reexported name may not be +-- a direct dependency (#27786). haddockDependencies :: Context -> Action [(Package, FilePath)] haddockDependencies context = do - depNames <- interpretInContext context (getContextData depNames) - sequence [ (,) <$> pure depPkg <*> (pkgHaddockFile $ vanillaContext (stage context) depPkg) - | Just depPkg <- map findPackageByName depNames, (pkgName depPkg) `notElem` haddockExclude ] + depPkgs <- go [] [Context.package context] + sequence [ (,) depPkg <$> pkgHaddockFile (vanillaContext (stage context) depPkg) + | depPkg <- depPkgs ] + where + go seen [] = return seen + go seen (pkg:pkgs) = do + names <- interpretInContext (context { Context.package = pkg }) (getContextData depNames) + let new = [ depPkg | Just depPkg <- map findPackageByName names + , pkgName depPkg `notElem` haddockExclude + , depPkg `notElem` seen ] + go (seen ++ new) (pkgs ++ new) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a368ffb00003902fc5d33291921431… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a368ffb00003902fc5d33291921431… 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/wip/27786] hadrian: pass transitive dependencies to haddock
by Zubin (＠wz1000) 15 Sep '26

15 Sep '26

Zubin pushed to branch wip/wip/27786 at Glasgow Haskell Compiler / GHC Commits: d49468d9 by Zubin Duggal at 2026-09-15T17:18:03+05:30 hadrian: pass transitive dependencies to haddock Haddock looks up the docs of a reexported name in the interface of the package defining it, which may not be a direct dependency. Since base reexports ghc-internal, packages reexporting from base (e.g. stm) couldn't find docs from transitive dependencies. Fixes #27786 - - - - - 2 changed files: - + changelog.d/hadrian-haddock-transitive-deps-27786 - hadrian/src/Rules/Documentation.hs Changes: ===================================== changelog.d/hadrian-haddock-transitive-deps-27786 ===================================== @@ -0,0 +1,6 @@ +section: packaging +synopsis: Hadrian now passes the interfaces of all transitive dependencies to + Haddock, so documentation of entities reexported from ``ghc-internal`` via + ``base`` (e.g. in ``stm``) is no longer missing. +issues: #27786 #25850 +mrs: !16691 ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -422,9 +422,19 @@ buildManPage = do checkSphinxWarnings dir copyFileUntracked (dir -/- "ghc.1") file --- | Find the Haddock files for the dependencies of the current library. +-- | Find the Haddock files for the transitive dependencies of the current +-- library. Transitive because the package defining a reexported name may not be +-- a direct dependency (#27786). haddockDependencies :: Context -> Action [(Package, FilePath)] haddockDependencies context = do - depNames <- interpretInContext context (getContextData depNames) - sequence [ (,) <$> pure depPkg <*> (pkgHaddockFile $ vanillaContext (stage context) depPkg) - | Just depPkg <- map findPackageByName depNames, (pkgName depPkg) `notElem` haddockExclude ] + depPkgs <- go [] [Context.package context] + sequence [ (,) depPkg <$> pkgHaddockFile (vanillaContext (stage context) depPkg) + | depPkg <- depPkgs ] + where + go seen [] = return seen + go seen (pkg:pkgs) = do + names <- interpretInContext (context { Context.package = pkg }) (getContextData depNames) + let new = [ depPkg | Just depPkg <- map findPackageByName names + , pkgName depPkg `notElem` haddockExclude + , depPkg `notElem` seen ] + go (seen ++ new) (pkgs ++ new) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d49468d97e7c3516c7497edf77bca2f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d49468d97e7c3516c7497edf77bca2f… 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/wip/27786] hadrian: pass transitive dependencies to haddock
by Zubin (＠wz1000) 15 Sep '26

15 Sep '26

Zubin pushed to branch wip/wip/27786 at Glasgow Haskell Compiler / GHC Commits: 37c4aee1 by Zubin Duggal at 2026-09-15T17:13:55+05:30 hadrian: pass transitive dependencies to haddock Haddock looks up the docs of a reexported name in the interface of the package defining it, which may not be a direct dependency. Since base reexports ghc-internal, packages reexporting from base (e.g. stm) couldn't find docs from transitive dependencies. Fixes #27786 - - - - - 2 changed files: - + changelog.d/hadrian-haddock-transitive-deps-27786 - hadrian/src/Rules/Documentation.hs Changes: ===================================== changelog.d/hadrian-haddock-transitive-deps-27786 ===================================== @@ -0,0 +1,6 @@ +section: packaging +synopsis: Hadrian now passes the interfaces of all transitive dependencies to + Haddock, so documentation of entities reexported from ``ghc-internal`` via + ``base`` (e.g. in ``stm``) is no longer missing. +issues: #27786 +mrs: !16691 ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -422,9 +422,19 @@ buildManPage = do checkSphinxWarnings dir copyFileUntracked (dir -/- "ghc.1") file --- | Find the Haddock files for the dependencies of the current library. +-- | Find the Haddock files for the transitive dependencies of the current +-- library. Transitive because the package defining a reexported name may not be +-- a direct dependency (#27786). haddockDependencies :: Context -> Action [(Package, FilePath)] haddockDependencies context = do - depNames <- interpretInContext context (getContextData depNames) - sequence [ (,) <$> pure depPkg <*> (pkgHaddockFile $ vanillaContext (stage context) depPkg) - | Just depPkg <- map findPackageByName depNames, (pkgName depPkg) `notElem` haddockExclude ] + depPkgs <- go [] [Context.package context] + sequence [ (,) depPkg <$> pkgHaddockFile (vanillaContext (stage context) depPkg) + | depPkg <- depPkgs ] + where + go seen [] = return seen + go seen (pkg:pkgs) = do + names <- interpretInContext (context { Context.package = pkg }) (getContextData depNames) + let new = [ depPkg | Just depPkg <- map findPackageByName names + , pkgName depPkg `notElem` haddockExclude + , depPkg `notElem` seen ] + go (seen ++ new) (pkgs ++ new) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37c4aee1c36919778f805dc1f46f7e0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37c4aee1c36919778f805dc1f46f7e0… 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] More simplification
by Simon Peyton Jones (＠simonpj) 15 Sep '26

15 Sep '26

Simon Peyton Jones pushed to branch wip/T27731 at Glasgow Haskell Compiler / GHC Commits: 71669d7e by Simon Peyton Jones at 2026-09-15T12:42:39+01:00 More simplification - - - - - 1 changed file: - compiler/GHC/Tc/Errors.hs Changes: ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -481,7 +481,8 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs ctxt' = ctxt1 { cec_tidy = env1 , cec_encl = implic' : cec_encl ctxt - , cec_suppress = insoluble || cec_suppress ctxt +-- NO LONGER NEEDED +-- , cec_suppress = cec_suppress ctxt -- Suppress inessential errors if there -- are insolubles anywhere in the -- tree rooted here, or we've come across @@ -572,8 +573,9 @@ mkErrorItem ct , ei_suppress = suppressCtError ev }} -- | Actually report this 'ErrorItem'. -unsuppressErrorItem :: ErrorItem -> ErrorItem -unsuppressErrorItem ei = ei { ei_suppress = False } +-- NOT NEEDED ANY MORE +--unsuppressErrorItem :: ErrorItem -> ErrorItem +-- unsuppressErrorItem ei = ei { ei_suppress = False } -- | Should we completely ignore this constraint in error reporting? -- It *must* be the case that any constraint for which this returns True @@ -647,19 +649,23 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics | isEmptyWC wc = traceTc "reportWanteds empty WC" empty | otherwise - = do { tidy_items1 <- mapMaybeM mkErrorItem tidy_cts + = do { let tidy_cts = bagToList (mapBag (tidyCt env) simples) + tidy_errs = bagToList (mapBag (tidyDelayedError env) errs) + + ; tidy_items1 <- mapMaybeM mkErrorItem tidy_cts -- Catch an awkward (and probably rare) case in which /all/ errors are -- suppressed: see (SCE3) in Note [ei_suppress: suppressing confusing errors] - ; errs_already <- ifErrsM (return True) (return False) +-- ; errs_already <- ifErrsM (return True) (return False) ; let tidy_items - | not errs_already -- Have not already reported an error (perhaps - -- from an outer implication); see #21405 - , not (any ignoreConstraint simples) -- No error is ignorable (is reported elsewhere) - , all ei_suppress tidy_items1 -- All errors are suppressed - = map unsuppressErrorItem tidy_items1 - - | otherwise +-- NO LONGER NEEDED +-- | not errs_already -- Have not already reported an error (perhaps +-- -- from an outer implication); see #21405 +-- , not (any ignoreConstraint simples) -- No error is ignorable (is reported elsewhere) +-- , all ei_suppress tidy_items1 -- All errors are suppressed +-- = map unsuppressErrorItem tidy_items1 +-- +-- | otherwise = tidy_items1 ; traceTc "reportWanteds 1" (vcat [ text "Simples =" <+> ppr simples @@ -668,23 +674,20 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics , text "tidy_items1 =" <+> ppr tidy_items1 , text "tidy_errs =" <+> ppr tidy_errs ]) - -- First, deal with any out-of-scope errors: - ; let (out_of_scope, other_holes, not_conc_errs, mult_co_errs) = partition_errors tidy_errs + ; let (out_of_scope, other_holes, not_conc_errs, mult_co_errs) + = partition_errors tidy_errs + -- Don't suppress out-of-scope errors -- See (SLIE0) in Note [cec_suppress: suppressing less-important error messages] - ctxt_for_scope_errs = ctxt { cec_suppress = False } - ; (_, no_out_of_scope) <- askNoErrs $ - reportHoles tidy_items ctxt_for_scope_errs out_of_scope +-- ctxt_for_scope_errs = ctxt { cec_suppress = False } - -- Next, deal with things that are utterly wrong - -- These should not be suppressed by the incoming context - -- (but should be suppressed by out-of-scope errors) - -- See (SLIE0) in Note [cec_suppress: suppressing less-important error messages] - ; let ctxt_for_insols = ctxt { cec_suppress = not no_out_of_scope } + -- First, deal with any out-of-scope errors: + ; (_, no_out_of_scope) <- askNoErrs $ + reportHoles ctxt tidy_items out_of_scope - -- Don't suppress holes or concreteness errors unless we have scope errors - ; reportHoles tidy_items ctxt_for_insols other_holes - ; reportNotConcreteErrs ctxt_for_insols not_conc_errs + -- Don't suppress holes or concreteness errors, ever + ; reportHoles ctxt tidy_items other_holes + ; reportNotConcreteErrs ctxt not_conc_errs -- We only want to report multiplicity coercion errors for multiplicity -- constraints which are /solved/ with a non-reflexivity coercion. We @@ -692,29 +695,45 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics -- when /all/ other constraints are solved. -- See wrinkle (DME1) in Note [Coercion errors in tcSubMult] in GHC.Tc.Utils.Unify. ; when (null simples) $ - reportMultiplicityCoercionErrs ctxt_for_insols mult_co_errs + reportMultiplicityCoercionErrs ctxt mult_co_errs -- Now the constraints that give serious errors -- Like Int ~ Bool (incl nullary TyCons) -- or Int ~ t a (AppTy on one side) - ; (items1, no_serious_errs) + -- + -- First visible ones, then invisible ones; but all serious + ; let suppress_insols = not no_out_of_scope + -- Serious errors are not suppressed by cec_suppress, + -- hence not including cec_suppress in suppress_insols + -- See (SLIE0) in Note [cec_suppress: suppressing less-important + -- error messages] + (vis_items, invis_items) + = partition (isVisibleOrigin . errorItemOrigin) tidy_items + + ; (vis_items1, no_vis_serious_errs) <- askNoErrs $ - tryReporters ctxt_for_insols serious_reporters tidy_items + tryReporters ctxt suppress_insols serious_reporters vis_items + + ; let suppress_invis = suppress_insols || not no_vis_serious_errs + ; (invis_items1, no_invis_serious_errs) + <- askNoErrs $ + tryReporters ctxt suppress_invis serious_reporters invis_items -- Now take account of the inherited cec_suppress, and augment it -- to suppress further errors if we have found any serious errors locally - ; let suppress_for_rest = cec_suppress ctxt - || not no_out_of_scope - || not no_serious_errs - ctxt_for_rest = ctxt { cec_suppress = suppress_for_rest } + ; let suppress_rest = cec_suppress ctxt + || suppress_invis + || not no_invis_serious_errs -- Next, deal with the less-serious constraints - ; leftovers <- tryReporters ctxt_for_rest less_serious_reporters items1 + ; leftovers <- tryReporters ctxt suppress_rest less_serious_reporters $ + (vis_items1 ++ invis_items1) ; massertPpr (null leftovers) (text "The following unsolved Wanted constraints \ \have not been reported to the user:" $$ ppr leftovers) + ; let ctxt_for_rest = ctxt { cec_suppress = suppress_rest } ; mapBagM_ (reportImplic ctxt_for_rest) implics -- NB ctxt2: don't suppress inner insolubles if there's only a -- wanted insoluble here; but do suppress inner insolubles @@ -722,8 +741,6 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics } where env = cec_tidy ctxt - tidy_cts = bagToList (mapBag (tidyCt env) simples) - tidy_errs = bagToList (mapBag (tidyDelayedError env) errs) partition_errors :: [DelayedError] -> ([Hole], [Hole], [NotConcreteError], [(TcCoercion, CtLoc)]) partition_errors [] @@ -747,14 +764,14 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics = [ -- We put implicit lifting errors first, because are solid errors -- See "Implicit lifting" in GHC.Tc.Gen.Splice -- Note [Lifecycle of an untyped splice, and PendingRnSplice] - ("implicit lifting", is_implicit_lifting, True, mkImplicitLiftingReporter) + ("implicit lifting", is_implicit_lifting, mkImplicitLiftingReporter) -- Next, solid equality errors - , given_eq_spec - , ("insoluble2", utterly_wrong, True, mkGroupReporter mkEqErr) - , ("skolem eq1", very_wrong, True, mkSkolReporter) - , ("FixedRuntimeRep", is_FRR, True, mkGroupReporter mkFRRErr) - , ("skolem eq2", skolem_eq, True, mkSkolReporter) + , ("given_eq", is_given_eq, mkGivenErrorReporter) + , ("insoluble2", utterly_wrong, mkGroupReporter mkEqErr) + , ("skolem eq1", very_wrong, mkSkolReporter) + , ("FixedRuntimeRep", is_FRR, mkGroupReporter mkFRRErr) + , ("skolem eq2", skolem_eq, mkSkolReporter) -- Next, custom type errors -- See Note [Custom type errors in constraints] in GHC.Tc.Types.Constraint @@ -770,29 +787,29 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics -- we want to report it as a custom error, /not/ as a mis-match -- between TypeError and ()! Also see the Assert example -- in Note [Custom type errors in constraints] - , ("custom_error", is_user_type_error, True, mkUserTypeErrorReporter) + , ("custom_error", is_user_type_error, mkUserTypeErrorReporter) -- (Handles TypeError and Unsatisfiable) -- "non-tv-eq": equalities (ty1 ~ ty2) where ty1 is not a tyvar - , ("non-tv eq", non_tv_eq, True, mkSkolReporter) + , ("non-tv eq", non_tv_eq, mkSkolReporter) -- The only remaining equalities are alpha ~ ty, -- where alpha is untouchable; and representational equalities -- Prefer homogeneous equalities over hetero, because the -- former might be holding up the latter. -- See Note [Equalities with heterogeneous kinds] in GHC.Tc.Solver.Equality - , ("Homo eqs", is_homo_equality, True, mkGroupReporter mkEqErr) - , ("Other eqs", is_equality, True, mkGroupReporter mkEqErr) + , ("Homo eqs", is_homo_equality, mkGroupReporter mkEqErr) + , ("Other eqs", is_equality, mkGroupReporter mkEqErr) - , ("Insoluble fundeps", is_insoluble, True, mkGroupReporter mkDictErr) + , ("Insoluble fundeps", is_insoluble, mkGroupReporter mkDictErr) ] -- less_serious_reporters: we suppress these if have already -- reported a serious error, higher in the tree less_serious_reporters - = [ ("Irreds", is_irred, False, mkGroupReporter mkIrredErr) - , ("Dicts", is_dict, False, mkGroupReporter mkDictErr) - , ("Quantified", is_qc, False, mkGroupReporter mkQCErr) ] + = [ ("Irreds", is_irred, mkGroupReporter mkIrredErr) + , ("Dicts", is_dict, mkGroupReporter mkDictErr) + , ("Quantified", is_qc, mkGroupReporter mkQCErr) ] -- rigid_nom_eq, rigid_nom_tv_eq, is_dict, is_equality, is_FRR, is_irred :: ErrorItem -> Pred -> Bool @@ -857,30 +874,6 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics is_qc _ (ForAllPred {}) = True is_qc _ _ = False - given_eq_spec -- See Note [Given errors] - | has_gadt_match_here - = ("insoluble1a", is_given_eq, True, mkGivenErrorReporter) - | otherwise - = ("insoluble1b", is_given_eq, False, ignoreErrorReporter) - -- False means don't suppress subsequent errors - -- Reason: we don't report all given errors - -- (see mkGivenErrorReporter), and we should only suppress - -- subsequent errors if we actually report this one! - -- #13446 is an example - - -- See Note [Given errors] - has_gadt_match_here = has_gadt_match (cec_encl ctxt) - has_gadt_match [] = False - has_gadt_match (implic : implics) - | PatSkol {} <- ic_info implic - , ic_given_eqs implic /= NoGivenEqs - , ic_warn_inaccessible implic - -- Don't bother doing this if -Winaccessible-code isn't enabled. - -- See Note [Avoid -Winaccessible-code when deriving] in GHC.Tc.TyCl.Instance. - = True - | otherwise - = has_gadt_match implics - --------------- isSkolemTy :: TcLevel -> Type -> Bool -- The type is a skolem tyvar @@ -1039,7 +1032,6 @@ type Reporter type ReporterSpec = ( String -- Name , ErrorItem -> Pred -> Bool -- Pick these ones - , Bool -- True <=> suppress subsequent reporters , Reporter) -- The reporter itself mkSkolReporter :: Reporter @@ -1058,9 +1050,12 @@ mkSkolReporter ctxt items | eq_lhs_type item1 item2 = True | otherwise = False -reportHoles :: [ErrorItem] -- other (tidied) constraints - -> SolverReportErrCtxt -> [Hole] -> TcM () -reportHoles tidy_items ctxt holes +reportHoles :: SolverReportErrCtxt + -> [ErrorItem] -- Other (tidied) constraints + -> [Hole] -- Holes to report + -> TcM () +-- Ignores cec_suppress +reportHoles ctxt tidy_items holes = do diag_opts <- initDiagOpts <$> getDynFlags let severity = diagReasonSeverity diag_opts (cec_type_holes ctxt) @@ -1115,6 +1110,7 @@ zonkTidyTcLclEnvs tidy_env lcls = foldM go (tidy_env, emptyNameEnv) (concatMap c return (tidy_env', extendNameEnv name_env name tidy_ty) reportNotConcreteErrs :: SolverReportErrCtxt -> [NotConcreteError] -> TcM () +-- Ignores cec_suppress reportNotConcreteErrs _ [] = return () reportNotConcreteErrs ctxt errs@(err0:_) = do { msg <- mkErrorReport (ctLocEnv (nce_loc err0)) diag (Just ctxt) [] [] @@ -1218,15 +1214,10 @@ mkImplicitLiftingReporter ctxt mkGivenErrorReporter :: Reporter -- See Note [Given errors] -mkGivenErrorReporter ctxt (item:|_) +mkGivenErrorReporter ctxt items@(item:|_) + | Just implic <- has_gadt_match (cec_encl ctxt) = do { (ctxt, relevant_binds, item) <- relevantBindings True ctxt item - ; let implic = - case cec_encl ctxt of - -- cec_encl is always non-empty when mkGivenErrorReporter is called - outer_implic:_ -> outer_implic - _ -> pprPanic "mkGivenErrorReporter" (ppr item) - - loc' = setCtLocEnv (ei_loc item) (ic_env implic) + ; let loc' = setCtLocEnv (ei_loc item) (ic_env implic) item' = item { ei_loc = loc' } -- For given constraints we overwrite the env (and hence src-loc) -- with one from the immediately-enclosing implication. @@ -1234,18 +1225,29 @@ mkGivenErrorReporter ctxt (item:|_) ; eq_err_msg <- mkEqErr_help ctxt item' ty1 ty2 ; let msg = TcRnInaccessibleCode implic (SolverReportWithCtxt ctxt eq_err_msg) - ; msg <- mkErrorReport (ctLocEnv loc') msg (Just ctxt) [SupplementaryBindings relevant_binds] [] + ; msg <- mkErrorReport (ctLocEnv loc') msg (Just ctxt) + [SupplementaryBindings relevant_binds] [] ; reportDiagnostic msg } - where - (ty1, ty2) = getEqPredTys (errorItemPred item) -ignoreErrorReporter :: Reporter --- Discard Given errors that don't come from --- a pattern match; maybe we should warn instead? -ignoreErrorReporter ctxt items + | otherwise -- Discard Given errors that don't come from + -- a pattern match; maybe we should warn instead? = do { traceTc "mkGivenErrorReporter no" (ppr items $$ ppr (cec_encl ctxt)) ; return () } + where + (ty1, ty2) = getEqPredTys (errorItemPred item) + + has_gadt_match :: [Implication] -> Maybe Implication + has_gadt_match [] = Nothing + has_gadt_match (implic : implics) + | PatSkol {} <- ic_info implic + , ic_given_eqs implic /= NoGivenEqs + , ic_warn_inaccessible implic + -- Don't bother doing this if -Winaccessible-code isn't enabled. + -- See Note [Avoid -Winaccessible-code when deriving] in GHC.Tc.TyCl.Instance. + = Just implic + | otherwise + = has_gadt_match implics {- Note [Given errors] ~~~~~~~~~~~~~~~~~~~~~~ @@ -1427,31 +1429,29 @@ mkErrorTerm ct_loc ty ctxt msg supp hints ; return $ evDelayedError ty err_str } -tryReporters :: SolverReportErrCtxt -> [ReporterSpec] -> [ErrorItem] +tryReporters :: SolverReportErrCtxt + -> Bool -- Suppress errors if this is True + -- (over-riding cec_suppress) + -> [ReporterSpec] + -> [ErrorItem] -> TcM [ErrorItem] -- Use the first reporter in the list whose predicate says True -tryReporters ctxt reporters items - = do { let (vis_items, invis_items) = partition (isVisibleOrigin . errorItemOrigin) items - ; traceTc "tryReporters {" (ppr vis_items $$ ppr invis_items) - ; items' <- go reporters vis_items invis_items +tryReporters ctxt suppress reporters items + = do { traceTc "tryReporters {" (ppr items) + ; items' <- go reporters items ; traceTc "tryReporters }" (ppr items') ; return items' } where - go [] vis_items invis_items - = return (vis_items ++ invis_items) - - go (r : rs) vis_items invis_items - -- Always look at *visible* Origins before invisible ones - -- this is the whole point of isVisibleOrigin - = do { vis_items' <- tryReporter ctxt r vis_items - ; invis_items' <- tryReporter ctxt r invis_items - ; go rs vis_items' invis_items' } - -- Carry on with the rest, because we must make - -- deferred bindings for them if we have -fdefer-type-errors - -- But suppress their error messages + -- Use `suppress` to set the `cec_supress` flag for these items + ctxt_w_suppress = ctxt { cec_suppress = suppress } + go [] items = return items + go (r:rs) items = do { items' <- tryReporter ctxt_w_suppress r items + ; go rs items' } + -- Carry on with the rest, because we must make + -- deferred bindings for them if we have -fdefer-type-errors tryReporter :: SolverReportErrCtxt -> ReporterSpec -> [ErrorItem] -> TcM [ErrorItem] -tryReporter ctxt (str, keep_me, _, reporter) items = case nonEmpty yeses of +tryReporter ctxt (str, keep_me, reporter) items = case nonEmpty yeses of Nothing -> return items Just yeses -> do { traceTc "tryReporter{ " (text str <+> ppr yeses) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/71669d7e82a45e2a2f2f3eb1b45dbc4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/71669d7e82a45e2a2f2f3eb1b45dbc4… 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/apk/unfold-dicts] 3 commits: Tweak inlining discout for unary class ops.
by Andreas Klebinger (＠AndreasK) 15 Sep '26

15 Sep '26

Andreas Klebinger pushed to branch wip/apk/unfold-dicts at Glasgow Haskell Compiler / GHC Commits: 001da929 by Andreas Klebinger at 2026-09-11T20:01:15+02:00 Tweak inlining discout for unary class ops. Consider the number of arguments applied to a unary class op, not just it'S unary-ness when computing class op application size. Fixes #27802 - - - - - 658c5cc9 by Andreas Klebinger at 2026-09-15T06:13:00+00:00 Try discounting args applied to a result of a class op - - - - - 697dddd3 by Andreas Klebinger at 2026-09-15T11:31:11+00:00 Generalize to the unknown call case - - - - - 5 changed files: - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold.hs-boot - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - docs/users_guide/using-optimisation.rst Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -30,6 +30,7 @@ module GHC.Core.Unfold ( updateFunAppDiscount, updateDictDiscount, updateVeryAggressive, updateCaseScaling, updateCaseThreshold, updateReportPrefix, + updateUnknownCallArg, inlineBoringOk, calcUnfoldingGuidance, uncondInlineJoin @@ -87,6 +88,9 @@ data UnfoldingOpts = UnfoldingOpts , unfoldingCaseScaling :: !Int -- ^ Penalize depth with 1/x + , unfoldingUnknownCallArg :: !Int + -- ^ Penalize depth with 1/x + , unfoldingReportPrefix :: !(Maybe String) -- ^ Only report inlining decisions for names with this prefix } @@ -121,6 +125,11 @@ defaultUnfoldingOpts = UnfoldingOpts -- Penalize depth with (size*depth)/scaling , unfoldingCaseScaling = 30 + -- Makes functions more likely to inline if they apply + -- a function argument to interesting arguments. + -- See Note [Discounting for known-at-callsite function calls] + , unfoldingUnknownCallArg = 10 + -- Don't filter inlining decision reports , unfoldingReportPrefix = Nothing } @@ -149,6 +158,11 @@ updateCaseThreshold n opts = opts { unfoldingCaseThreshold = n } updateCaseScaling :: Int -> UnfoldingOpts -> UnfoldingOpts updateCaseScaling n opts = opts { unfoldingCaseScaling = n } +updateUnknownCallArg :: Int -> UnfoldingOpts -> UnfoldingOpts +updateUnknownCallArg n opts = opts { unfoldingUnknownCallArg = n } + + + updateReportPrefix :: Maybe String -> UnfoldingOpts -> UnfoldingOpts updateReportPrefix n opts = opts { unfoldingReportPrefix = n } @@ -335,6 +349,8 @@ isValFun :: CoreExpr -> Bool -- one top-level value lambda isValFun (Lam b e) | isRuntimeVar b = True | otherwise = isValFun e +isValFun (Cast e _c) = isValFun e +isValFun (Tick _t e) = isValFun e isValFun _ = False calcUnfoldingGuidance @@ -709,10 +725,10 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr FCallId _ -> sizeN (callSize (length val_args) voids) DataConWorkId dc -> conSize dc (length val_args) PrimOpId op _ -> primOpSize op (length val_args) - ClassOpId cls _ -> classOpSize opts cls top_args val_args + ClassOpId cls _ -> classOpSize opts cls top_args val_args voids _ | fun `hasKey` buildIdKey -> buildSize | fun `hasKey` augmentIdKey -> augmentSize - | otherwise -> funSize opts top_args fun (length val_args) voids + | otherwise -> funSize opts top_args fun val_args voids ------------ size_up_alt (Alt _con _bndrs rhs) = size_up rhs `addSizeN` 10 @@ -777,21 +793,29 @@ litSize _other = 0 -- Must match size of nullary constructors -- Key point: if x |-> 4, then x must inline unconditionally -- (eg via case binding) -classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> ExprSize +classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> Int -> ExprSize -- See (IA1) in Note [Interesting arguments] in GHC.Core.Opt.Simplify.Utils -classOpSize _opts _cls _top_args [] +classOpSize _opts _cls _top_args [] _voids = sizeZero -- A non-applied classop -classOpSize opts cls top_args (dict_arg:other_val_args) - = SizeIs size (arg_discount dict_arg) 0 +classOpSize opts cls top_args (dict_arg:other_val_args) voids + = SizeIs size dict_arg_discount 0 where - size | isUnaryClass cls = 0 -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon - | otherwise = 20 + (10 * length other_val_args) + -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon + op_app_size = if isUnaryClass cls then 0 else 20 + + -- Size penalty for applying the extracted class method to it's + -- arguments. + method_app_size = callSize (length other_val_args) voids + + size = op_app_size + method_app_size -- If the class op is scrutinising a lambda bound dictionary then -- give it a discount, to encourage the inlining of this function - arg_discount (Cast arg _co) = arg_discount arg - arg_discount (Var dict) | dict `elem` top_args = unitBag (dict, dict_discount) - arg_discount _ = emptyBag + dict_arg_discount = case getIdFromTrivialExpr_maybe dict_arg of + Nothing -> emptyBag + Just dict + | dict `elem` top_args -> unitBag (dict, dict_discount) + | otherwise -> emptyBag -- If we have (class-op d arg1 .. argn) then it's super-good to inline -- to expose `d`; not only can we do the dictionary selection @@ -800,7 +824,9 @@ classOpSize opts cls top_args (dict_arg:other_val_args) -- See the discussion on #26831, esp "Delicate inlining". dict_discount | null other_val_args = unfoldingDictDiscount opts - | otherwise = unfoldingDictDiscount opts + unfoldingFunAppDiscount opts + | otherwise = unfoldingDictDiscount opts + unfoldingFunAppDiscount opts + + -- See Note [Discounting for known-at-callsite function calls] + unknownFunArgDiscount opts top_args other_val_args -- | The size of a function call callSize @@ -826,12 +852,13 @@ jumpSize _n_val_args _voids = 0 -- Jumps are small, and we don't want penalise -- spectral/puzzle. TODO Perhaps adjusting the default threshold would be a -- better solution? -funSize :: UnfoldingOpts -> [Id] -> Id -> Int -> Int -> ExprSize +funSize :: UnfoldingOpts -> [Id] -> Id -> [CoreExpr] -> Int -> ExprSize -- Size for function calls where the function is not a constructor or primops -- Note [Function applications] -funSize opts top_args fun n_val_args voids +funSize opts top_args fun val_args voids | otherwise = SizeIs size arg_discount res_discount where + n_val_args = length val_args some_val_args = n_val_args > 0 is_join = isJoinId fun @@ -839,10 +866,14 @@ funSize opts top_args fun n_val_args voids | not some_val_args = 0 | otherwise = callSize n_val_args voids + fun_discount + | fun `elem` top_args = unfoldingFunAppDiscount opts + unknownFunArgDiscount opts top_args val_args + | otherwise = unfoldingFunAppDiscount opts + -- DISCOUNTS -- See Note [Function and non-function discounts] arg_discount | some_val_args && fun `elem` top_args - = unitBag (fun, unfoldingFunAppDiscount opts) + = unitBag (fun, fun_discount) | otherwise = emptyBag -- If the function is an argument and is applied -- to some values, give it an arg-discount @@ -864,7 +895,64 @@ conSize dc n_val_args -- See Note [Constructor size and result discount] | otherwise = SizeIs 10 emptyBag 10 -{- Note [Constructor size and result discount] +-- See Note [Discounting for known-at-callsite function calls] +unknownFunArgDiscount :: UnfoldingOpts -> [Id] -> [CoreExpr] -> Int +unknownFunArgDiscount opts top_args args = sum (map arg_discount args) + where + arg_discount arg + | interestingArg arg = unfoldingUnknownCallArg opts + | otherwise = 0 + + -- Little brother to the simplifier's interestingArg. + -- Use trivial_expr_fold to look through casts, ticks and type applications, + -- in a principled manner. + interestingVar v = v `elem` top_args || exprIsConLike (Var v) + interestingArg = trivial_expr_fold interestingVar (const True) False True + +{- +Note [Discounting for known-at-callsite function calls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A regular unknown function call `f x y` inside some function `foo` provides no +optimization opportunities to improve `foo` no matter what shape x and y have. + +However we might have a pattern where a function argument is applied to +interesting arguments like: + + foo f g x = ... f x ... g g ... + bar = foo snd snd (1,2) + +Here we really want to inline `foo`, as it will expose `snd` to the tuple, causing +it to inline and eliminating the tuple allocation completely. + +Note that this doesn't always require the function argument itself to be inlined. +Inlining `foo` will also expose the strictness and W/W properties of foos function +arguments and allows specConstr to fire on them. There is simple a large number of +optimizations that can happen for known functions that are impossible for unknown +calls. + +So here is the plan: Whenever the argument to `f` could be useful for optimizing +`foo` if `f` is a known call we give `f` a discount. + +This includes: + +* The argument is a top_arg itself. (Think `f id 1` with `f g = g`) +* The argument is con like: This can help rules, W/W, SpecConstr, further inlining. +* The argument is a literal: Rules/Inlining +* The argument is non-trivial: + + If it's a thunk strictness might allow eager evaluationg + + If it's a pap/lambda we might be able to eta-expand it, removing an intermediate pap + or even removing the PAP fully. + +However we have to be careful. It's *not* a given that we actually +get a benefit from inlining such a call into it's context. It fully +depends on the specific arguments. So we simply make those interesting +arguments "free" rather charging the usual cost of 10 per applied arg. + +Similarly we *only* should give this discount to a unknown call. If the function +`f` being called inside `foo` is a known function all those optimizations can +happen inside foo without inlining it into it's call sites. + +Note [Constructor size and result discount] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Treat a constructors application as size 10, regardless of how many arguments it has; we are keen to expose them (and we charge separately ===================================== compiler/GHC/Core/Unfold.hs-boot ===================================== @@ -13,3 +13,4 @@ updateDictDiscount :: Int -> UnfoldingOpts -> UnfoldingOpts updateVeryAggressive :: Bool -> UnfoldingOpts -> UnfoldingOpts updateCaseThreshold :: Int -> UnfoldingOpts -> UnfoldingOpts updateCaseScaling :: Int -> UnfoldingOpts -> UnfoldingOpts +updateUnknownCallArg :: Int -> UnfoldingOpts -> UnfoldingOpts ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1654,7 +1654,9 @@ it off at source. {-# INLINE trivial_expr_fold #-} trivial_expr_fold :: (Id -> r) -> (Literal -> r) -> r -> r -> CoreExpr -> r --- ^ The worker function for Note [exprIsTrivial] and Note [getIdFromTrivialExpr] +-- ^ k_id k_lit k_triv k_not_triv +-- +-- The worker function for Note [exprIsTrivial] and Note [getIdFromTrivialExpr] -- This is meant to have the code of both functions in one place and make it -- easy to derive custom predicates. -- ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1881,6 +1881,8 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { unfoldingOpts = updateCaseThreshold n (unfoldingOpts d)})) , make_ord_flag defFlag "funfolding-case-scaling" (intSuffix (\n d -> d { unfoldingOpts = updateCaseScaling n (unfoldingOpts d)})) + , make_ord_flag defFlag "funfolding-unknown-call-arg-discount" + (intSuffix (\n d -> d { unfoldingOpts = updateUnknownCallArg n (unfoldingOpts d)})) , make_dep_flag defFlag "funfolding-keeness-factor" (floatSuffix (\_ d -> d)) ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1902,6 +1902,26 @@ as such you shouldn't need to set any of them explicitly. A flag recommended. Values in the range 10 <= n <= 20 allow some inlining to take place while still allowing GHC to compile modules containing such inlining loops. +.. ghc-flag:: -funfolding-unknown-call-arg-discount=⟨n⟩ + :shortdesc: *default: 10.* Discount for each interesting arg applied to a unknown function. + :type: dynamic + :category: + + :default: 10 + + .. index:: + single: inlining, controlling + single: unfolding, controlling + + Typically a function like ``foo f x`` is not much more likely to inline if + ``f`` is a known argument. + + With this discount being given we make GHC more eager to inline ``foo`` + if ``f`` is applied to interesting arguments inside the RHS of ``foo``. + + This optimizes cases where other optimizations can fire on the call to ``f`` + after it has been made a known call by inlining ``foo`` into it's call site. + .. ghc-flag:: -fworker-wrapper :shortdesc: Enable the worker/wrapper transformation. Implied by :ghc-flag:`-O` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3520030fa377abd59eaca4a61d16f3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3520030fa377abd59eaca4a61d16f3… 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/wip/27786
by Zubin (＠wz1000) 15 Sep '26

15 Sep '26

Zubin pushed new branch wip/wip/27786 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/wip/27786 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/10.0.1-backports] 4 commits: haddock: Bump version to 2.34.0
by Zubin (＠wz1000) 15 Sep '26

15 Sep '26

Zubin pushed to branch wip/10.0.1-backports at Glasgow Haskell Compiler / GHC Commits: 5a9e2598 by Zubin Duggal at 2026-09-15T15:46:47+05:30 haddock: Bump version to 2.34.0 - - - - - a92da7b2 by Zubin Duggal at 2026-09-15T15:50:06+05:30 Bump libffi-clib submodule to 3.6.0 - - - - - a31e70d0 by Zubin Duggal at 2026-09-15T16:01:04+05:30 hadrian: update bootstrap plans and add a plan for 9.12.4 - - - - - d99cbb9f by Zubin Duggal at 2026-09-15T16:50:19+05:30 Prepare 10.0.1-alpha1 - - - - - 91 changed files: - − changelog.d/27532 - − changelog.d/27626 - − changelog.d/27627 - − changelog.d/27703 - − changelog.d/27704 - − changelog.d/27717 - − changelog.d/T25636 - − changelog.d/T26423 - − changelog.d/T26716 - − changelog.d/T26978 - − changelog.d/T26979 - − changelog.d/T27046 - − changelog.d/T27047 - − changelog.d/T27121.md - − changelog.d/T27123.md - − changelog.d/T27124.md - − changelog.d/T27131 - − changelog.d/T27182.md - − changelog.d/T27202 - − changelog.d/T27225 - − changelog.d/T27308 - − changelog.d/T27314.md - − changelog.d/T27359 - − changelog.d/T27360 - − changelog.d/T27386 - − changelog.d/T27440 - − changelog.d/T27455 - − changelog.d/T27456 - − changelog.d/T27583 - − changelog.d/T27586 - − changelog.d/T27639 - − changelog.d/T27705 - − changelog.d/T27749 - − changelog.d/T27764 - − changelog.d/arm_ncg_fixes_T27430 - − changelog.d/bump-process - − changelog.d/dynamic-trace-flags - − changelog.d/fix-absent-dict-projection - − changelog.d/fix-blackhole-handling - − changelog.d/fix-cmm-atomic-load-store - − changelog.d/fix-compacting-gc-ap-27434 - − changelog.d/fix-exponential-case-desugar-27383 - − changelog.d/fix-finalizers-27072 - − changelog.d/fix-layout-stack-fcall - − changelog.d/fix-parallel-gc-selector-race-27477 - − changelog.d/fix-peekitbl-no-tntc - − changelog.d/fix-use-std-ap-thunk - − changelog.d/ghc-pkg-faster-closure - − changelog.d/hadrian-stale-package-confs-26661 - − changelog.d/ipe-event-class - − changelog.d/jobserver-leak-fix - − changelog.d/link-deterministic-order - − changelog.d/llvm-22 - − changelog.d/llvm-23 - − changelog.d/more-efficient-home-unit-imports-finding - − changelog.d/reexported-module-errors - − changelog.d/semaphore-v2 - − changelog.d/tag-inference-27005 - − changelog.d/tcplugin_init.md - − changelog.d/tcplugins-pmc.md - − changelog.d/typecheckModule-API.md - − changelog.d/unit-index - − changelog.d/unused-type - − changelog.d/wasm-fix-serviceworker - − changelog.d/windows-rethrow-overlapped-exception - − changelog.d/withTcPlugins.md - docs/users_guide/10.0.1-notes.rst - docs/users_guide/exts/static_pointers.rst - docs/users_guide/runtime_control.rst - hadrian/bootstrap/plan-9_10_1.json - hadrian/bootstrap/plan-9_10_2.json - hadrian/bootstrap/plan-9_10_3.json - hadrian/bootstrap/plan-9_12_1.json - hadrian/bootstrap/plan-9_12_2.json - + hadrian/bootstrap/plan-9_12_4.json - hadrian/bootstrap/plan-9_14_1.json - hadrian/bootstrap/plan-bootstrap-9_10_1.json - hadrian/bootstrap/plan-bootstrap-9_10_2.json - hadrian/bootstrap/plan-bootstrap-9_10_3.json - + hadrian/bootstrap/plan-bootstrap-9_12_4.json - libraries/base/changelog.md - libraries/ghc-experimental/CHANGELOG.md - libraries/ghc-internal/CHANGELOG.md - libraries/libffi-clib - testsuite/tests/ghci/T27532/Makefile - − testsuite/tests/ghci/T27532/T27532.stdout - − testsuite/tests/ghci/T27532/a.script - testsuite/tests/ghci/T27532/all.T - − testsuite/tests/ghci/T27532/b.script - utils/haddock/haddock-api/haddock-api.cabal - utils/haddock/haddock.cabal The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d4cfcd13291182e55fa13a140aef89… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d4cfcd13291182e55fa13a140aef89… 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/marge_bot_batch_merge_job] 4 commits: rts: handle large CONSTR closures in compacting GC
by Marge Bot (＠marge-bot) 15 Sep '26

15 Sep '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f422f793 by Luite Stegeman at 2026-09-15T07:26:15-04:00 rts: handle large CONSTR closures in compacting GC The function update_fwd_large in the compacting GC could run into an unexpected object with the following error: internal error: update_fwd_large: unknown/strange object 1 Closure type 1 is CONSTR. This patch adds cases for CONSTR and CONSTR_NOCAF. This is the same problem as #27434 (large AP closures, fixed by cca0d58963), which missed this case. Fixes #27649 - - - - - fc0ef58a by Luite Stegeman at 2026-09-15T07:26:15-04:00 testsuite: fix T27434 test with compacting GC Ensure that the interpreter is actually run with the compacting GC - - - - - 9c5fac53 by Luite Stegeman at 2026-09-15T07:26:19-04:00 rts: initialise the stack frame header for mask_frame and apply_mask_frame We must leave the stack in consistent state before jumping to mask_frame or apply_mask_frame because they may result. Failing to do so could lead to a crash if there were waiting exceptions. Fixes #27651 - - - - - b1e7f826 by Simon Peyton Jones at 2026-09-15T07:26:27-04:00 Re-introduce the "weird SpecDict" case In this commit commit f80375dd4945350a1d784e436975b48b9c736eaf Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com> Date: Sun Jun 29 15:26:58 2025 +0100 Refactor of Specialise.hs I removed a test for a dictionary with unbound type variables. This turned out to be wrong; see #27629. So this MR re-introduces it. - - - - - 17 changed files: - + changelog.d/T27629 - + changelog.d/fix-compacting-gc-constr-27649 - + changelog.d/fix-control0-mask-trampoline - compiler/GHC/Core/Opt/Specialise.hs - rts/ContinuationOps.cmm - rts/sm/Compact.c - + testsuite/tests/rts/T27649.hs - + testsuite/tests/rts/T27649.stdout - testsuite/tests/rts/all.T - + testsuite/tests/rts/continuations/T27651.hs - + testsuite/tests/rts/continuations/T27651.stdout - testsuite/tests/rts/continuations/all.T - testsuite/tests/simplCore/should_compile/Makefile - + testsuite/tests/simplCore/should_compile/T27629.hs - + testsuite/tests/simplCore/should_compile/T27629.stderr - + testsuite/tests/simplCore/should_compile/T27629Plugin.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== changelog.d/T27629 ===================================== @@ -0,0 +1,6 @@ +section: compiler +synopsis: Fix a scoping bug in the type-class specialiser +description: We don't know of any user programs that can trigger this bug + (the repro involves a plugin), so there is no user-visible effect. +mrs: !16603 +issues: #27629 ===================================== changelog.d/fix-compacting-gc-constr-27649 ===================================== @@ -0,0 +1,14 @@ +section: rts +synopsis: Fix "unknown/strange object 1" crash in compacting GC +issues: #27649 +mrs: !16482 + +description { +Fix a crash in the compacting garbage collector when collecting large +data constructor closures, as allocated by the bytecode interpreter for +constructors with several hundred fields. Affected programs (run in GHCi, +or via ``ghc -e`` or ``runghc``) crashed with an internal error of the +form "update_fwd_large: unknown/strange object 1" when run with the +compacting GC (``+RTS -c``, or compaction enabled automatically by a +``-M`` heap limit). +} ===================================== changelog.d/fix-control0-mask-trampoline ===================================== @@ -0,0 +1,13 @@ +section: rts +synopsis: Fix a crash when capturing or resuming a delimited continuation that adjusts the async exception masking state +issues: #27651 +mrs: !16484 + +description: { +Capturing a continuation with ``control0#`` from inside ``mask`` or +``uninterruptibleMask`` left an uninitialised word on the stack while +restoring the masking state. When the thread had a pending asynchronous +exception (e.g. from ``throwTo``), raising it walked over that word and +crashed with a segmentation fault. Resuming such a continuation had the +same defect. +} ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1713,9 +1713,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs ; let spec_rhs_bndrs = spec_bndrs ++ inner_rhs_bndrs' (rhs_uds2, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs $ dx_binds `consDictBinds` rhs_uds - -- dx_binds comes from the arguments to the call, - -- and so can mention poly_qvars but no other local binders - spec_rhs = mkLams spec_rhs_bndrs $ + spec_rhs = mkLams spec_rhs_bndrs $ wrapDictBindsE inner_dumped_dbs rhs_body' rule_rhs_args = spec_bndrs @@ -1784,8 +1782,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs , text "rule_act" <+> ppr rule_act ] --- ; pprTrace "spec_call: rule" (vcat [ -- text "poly_qvars" <+> ppr poly_qvars --- text "rule_bndrs" <+> ppr rule_bndrs +-- ; pprTrace "spec_call: rule" (vcat [ text "rule_bndrs" <+> ppr rule_bndrs -- , text "rule_lhs_args" <+> ppr rule_lhs_args -- , text "all_call_args" <+> ppr all_call_args -- , ppr spec_rule ]) $ @@ -2611,6 +2608,17 @@ specHeader subst (bndr:bndrs) (UnspecType : args) -- a wildcard binder to match the dictionary (See Note [Specialising Calls] for -- the nitty-gritty), as a LHS rule and unfolding details. specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) + | let in_scope = getInScopeVars (substInScopeSet subst) + bad_dict_fv v = isLocalVar v && not (v `elemVarSet` in_scope) + , not $ isEmptyVarSet $ exprSomeFreeVars bad_dict_fv dict_arg + = -- Do not specialise if `dict_arg` has any free vars that are /not/ in scope + -- See Note [Weird special case for SpecDict] + -- We add a warnPprTrace because this should be super-rare, + -- so if it starts happening we'd like to know. + warnPprTrace True "Specialise: weird dictionary with free type variable" (ppr dict_arg) $ + specHeader subst (bndr:bndrs) (UnspecArg : args) + + | otherwise = do { -- Make up a fresh binder to use in the RULE -- It might turn into a dict binding (via bindAuxiliaryDict) which we -- then float, so we use cloneIdBndr to get a completely fresh binder @@ -2886,13 +2894,15 @@ We could zap `k` to (Any @Type) and `a` to (Any @(Any @Type)), but that is a lot of hard work for a very strange case. So we simply refrain from specialising in this case; hence the guard - allVarSet (`elemInScopeSet` in_scope) (exprFreeVars d) -in the SpecDict cased of specHeader. - -How did this strange polymorphic mkD arise in the first place? -From GHC.Core.Opt.Utils.abstractFloats, which was abstracting -over too many type variables. But that too is now fixed; -see Note [Which type variables to abstract over] in that module. + not $ isEmptyVarSet $ exprSomeFreeVars bad_dict_fv dict_arg +in the SpecDict case of `specHeader`. + +How did this strange polymorphic mkD arise in the first place? From +GHC.Core.Opt.Simplify.Utils.abstractFloats, which was abstracting over too many type +variables. But that too is now fixed; see Note [Which type variables to abstract +over] in that module. So we don't actually have a Haskell source program that +triggers it (see #27629) -- only test T27629 that uses a plugin to inject a strange +definition. -} instance Outputable DictBind where ===================================== rts/ContinuationOps.cmm ===================================== @@ -148,6 +148,7 @@ stg_control0zh_ll // explicit stack // and jump to the frame’s entry code. Sp_adj(-3); // Note -3, not -2, because `mask_frame` will // try to pop itself off the stack when it returns! + Sp(0) = mask_frame; // Can't be omitted, see #27651 Sp(1) = stg_ap_pv_info; Sp(2) = cont; R1 = f; @@ -230,6 +231,7 @@ stg_CONTINUATION_apply // explicit stack // Now we just set up the stack so that `apply_mask_frame` will apply `io` // when it returns and jump to it. Sp_adj(-2); + Sp(0) = apply_mask_frame; // Can't be omitted, see #27651 Sp(1) = stg_ap_v_info; R1 = io; jump %ENTRY_CODE(apply_mask_frame) [R1]; ===================================== rts/sm/Compact.c ===================================== @@ -573,6 +573,13 @@ update_fwd_large( bdescr *bd ) continue; } + case CONSTR: + case CONSTR_NOCAF: + { + thread_obj(info, p); + continue; + } + case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN_CLEAN: ===================================== testsuite/tests/rts/T27649.hs ===================================== @@ -0,0 +1,27 @@ +-- Test that the compacting GC can handle large CONSTR closures. +-- +-- The bytecode interpreter allocates data constructors with allocate(), +-- so a constructor with enough fields becomes a large object (BF_LARGE). +-- update_fwd_large in rts/sm/Compact.c must therefore handle CONSTR. +-- This test only exercises the interpreter (ghci way): compiled code +-- bump-allocates constructors in the nursery and never hits this path. +module Main where + +import System.Mem (performMajorGC) +import Control.Monad (forM, forM_) + +data Big = Big Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int + +{-# NOINLINE mkBig #-} +mkBig :: Int -> Big +mkBig seed = Big (seed + 0) (seed + 1) (seed + 2) (seed + 3) (seed + 4) (seed + 5) (seed + 6) (seed + 7) (seed + 8) (seed + 9) (seed + 10) (seed + 11) (seed + 12) (seed + 13) (seed + 14) (seed + 15) (seed + 16) (seed + 17) (seed + 18) (seed + 19) (seed + 20) (seed + 21) (seed + 22) (seed + 23) (seed + 24) (seed + 25) (seed + 26) (seed + 27) (seed + 28) (seed + 29) (seed + 30) (seed + 31) (seed + 32) (seed + 33) (seed + 34) (seed + 35) (seed + 36) (seed + 37) (seed + 38) (seed + 39) (seed + 40) (seed + 41) (seed + 42) (seed + 43) (seed + 44) (seed + 45) (seed + 46) (seed + 47) (seed + 48) (seed + 49) (seed + 50) (seed + 51) (seed + 52) (seed + 53) (seed + 54) (seed + 55) (seed + 56) (seed + 57) (seed + 58) (seed + 59) (seed + 60) (seed + 61) (seed + 62) (seed + 63) (seed + 64) (seed + 65) (seed + 66) (seed + 67) (seed + 68) (seed + 69) (seed + 70) (seed + 71) (seed + 72) (seed + 73) (seed + 74) (seed + 75) (seed + 76) (seed + 77) (seed + 78) (seed + 79) (seed + 80) (seed + 81) (seed + 82) (seed + 83) (seed + 84) (seed + 85) (seed + 86) (seed + 87) (seed + 88) (seed + 89) (seed + 90) (seed + 91) (seed + 92) (seed + 93) (seed + 94) (seed + 95) (seed + 96) (seed + 97) (seed + 98) (seed + 99) (seed + 100) (seed + 101) (seed + 102) (seed + 103) (seed + 104) (seed + 105) (seed + 106) (seed + 107) (seed + 108) (seed + 109) (seed + 110) (seed + 111) (seed + 112) (seed + 113) (seed + 114) (seed + 115) (seed + 116) (seed + 117) (seed + 118) (seed + 119) (seed + 120) (seed + 121) (seed + 122) (seed + 123) (seed + 124) (seed + 125) (seed + 126) (seed + 127) (seed + 128) (seed + 129) (seed + 130) (seed + 131) (seed + 132) (seed + 133) (seed + 134) (seed + 135) (seed + 136) (seed + 137) (seed + 138) (seed + 139) (seed + 140) (seed + 141) (seed + 142) (seed + 143) (seed + 144) (seed + 145) (seed + 146) (seed + 147) (seed + 148) (seed + 149) (seed + 150) (seed + 151) (seed + 152) (seed + 153) (seed + 154) (seed + 155) (seed + 156) (seed + 157) (seed + 158) (seed + 159) (seed + 160) (seed + 161) (seed + 162) (seed + 163) (seed + 164) (seed + 165) (seed + 166) (seed + 167) (seed + 168) (seed + 169) (seed + 170) (seed + 171) (seed + 172) (seed + 173) (seed + 174) (seed + 175) (seed + 176) (seed + 177) (seed + 178) (seed + 179) (seed + 180) (seed + 181) (seed + 182) (seed + 183) (seed + 184) (seed + 185) (seed + 186) (seed + 187) (seed + 188) (seed + 189) (seed + 190) (seed + 191) (seed + 192) (seed + 193) (seed + 194) (seed + 195) (seed + 196) (seed + 197) (seed + 198) (seed + 199) (seed + 200) (seed + 201) (seed + 202) (seed + 203) (seed + 204) (seed + 205) (seed + 206) (seed + 207) (seed + 208) (seed + 209) (seed + 210) (seed + 211) (seed + 212) (seed + 213) (seed + 214) (seed + 215) (seed + 216) (seed + 217) (seed + 218) (seed + 219) (seed + 220) (seed + 221) (seed + 222) (seed + 223) (seed + 224) (seed + 225) (seed + 226) (seed + 227) (seed + 228) (seed + 229) (seed + 230) (seed + 231) (seed + 232) (seed + 233) (seed + 234) (seed + 235) (seed + 236) (seed + 237) (seed + 238) (seed + 239) (seed + 240) (seed + 241) (seed + 242) (seed + 243) (seed + 244) (seed + 245) (seed + 246) (seed + 247) (seed + 248) (seed + 249) (seed + 250) (seed + 251) (seed + 252) (seed + 253) (seed + 254) (seed + 255) (seed + 256) (seed + 257) (seed + 258) (seed + 259) (seed + 260) (seed + 261) (seed + 262) (seed + 263) (seed + 264) (seed + 265) (seed + 266) (seed + 267) (seed + 268) (seed + 269) (seed + 270) (seed + 271) (seed + 272) (seed + 273) (seed + 274) (seed + 275) (seed + 276) (seed + 277) (seed + 278) (seed + 279) (seed + 280) (seed + 281) (seed + 282) (seed + 283) (seed + 284) (seed + 285) (seed + 286) (seed + 287) (seed + 288) (seed + 289) (seed + 290) (seed + 291) (seed + 292) (seed + 293) (seed + 294) (seed + 295) (seed + 296) (seed + 297) (seed + 298) (seed + 299) (seed + 300) (seed + 301) (seed + 302) (seed + 303) (seed + 304) (seed + 305) (seed + 306) (seed + 307) (seed + 308) (seed + 309) (seed + 310) (seed + 311) (seed + 312) (seed + 313) (seed + 314) (seed + 315) (seed + 316) (seed + 317) (seed + 318) (seed + 319) (seed + 320) (seed + 321) (seed + 322) (seed + 323) (seed + 324) (seed + 325) (seed + 326) (seed + 327) (seed + 328) (seed + 329) (seed + 330) (seed + 331) (seed + 332) (seed + 333) (seed + 334) (seed + 335) (seed + 336) (seed + 337) (seed + 338) (seed + 339) (seed + 340) (seed + 341) (seed + 342) (seed + 343) (seed + 344) (seed + 345) (seed + 346) (seed + 347) (seed + 348) (seed + 349) (seed + 350) (seed + 351) (seed + 352) (seed + 353) (seed + 354) (seed + 355) (seed + 356) (seed + 357) (seed + 358) (seed + 359) (seed + 360) (seed + 361) (seed + 362) (seed + 363) (seed + 364) (seed + 365) (seed + 366) (seed + 367) (seed + 368) (seed + 369) (seed + 370) (seed + 371) (seed + 372) (seed + 373) (seed + 374) (seed + 375) (seed + 376) (seed + 377) (seed + 378) (seed + 379) (seed + 380) (seed + 381) (seed + 382) (seed + 383) (seed + 384) (seed + 385) (seed + 386) (seed + 387) (seed + 388) (seed + 389) (seed + 390) (seed + 391) (seed + 392) (seed + 393) (seed + 394) (seed + 395) (seed + 396) (seed + 397) (seed + 398) (seed + 399) (seed + 400) (seed + 401) (seed + 402) (seed + 403) (seed + 404) (seed + 405) (seed + 406) (seed + 407) (seed + 408) (seed + 409) (seed + 410) (seed + 411) (seed + 412) (seed + 413) (seed + 414) (seed + 415) (seed + 416) (seed + 417) (seed + 418) (seed + 419) (seed + 420) (seed + 421) (seed + 422) (seed + 423) (seed + 424) (seed + 425) (seed + 426) (seed + 427) (seed + 428) (seed + 429) (seed + 430) (seed + 431) (seed + 432) (seed + 433) (seed + 434) (seed + 435) (seed + 436) (seed + 437) (seed + 438) (seed + 439) (seed + 440) (seed + 441) (seed + 442) (seed + 443) (seed + 444) (seed + 445) (seed + 446) (seed + 447) (seed + 448) (seed + 449) (seed + 450) (seed + 451) (seed + 452) (seed + 453) (seed + 454) (seed + 455) (seed + 456) (seed + 457) (seed + 458) (seed + 459) (seed + 460) (seed + 461) (seed + 462) (seed + 463) (seed + 464) (seed + 465) (seed + 466) (seed + 467) (seed + 468) (seed + 469) (seed + 470) (seed + 471) (seed + 472) (seed + 473) (seed + 474) (seed + 475) (seed + 476) (seed + 477) (seed + 478) (seed + 479) (seed + 480) (seed + 481) (seed + 482) (seed + 483) (seed + 484) (seed + 485) (seed + 486) (seed + 487) (seed + 488) (seed + 489) (seed + 490) (seed + 491) (seed + 492) (seed + 493) (seed + 494) (seed + 495) (seed + 496) (seed + 497) (seed + 498) (seed + 499) + +sumBig :: Big -> Int +sumBig (Big a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 a61 a62 a63 a64 a65 a66 a67 a68 a69 a70 a71 a72 a73 a74 a75 a76 a77 a78 a79 a80 a81 a82 a83 a84 a85 a86 a87 a88 a89 a90 a91 a92 a93 a94 a95 a96 a97 a98 a99 a100 a101 a102 a103 a104 a105 a106 a107 a108 a109 a110 a111 a112 a113 a114 a115 a116 a117 a118 a119 a120 a121 a122 a123 a124 a125 a126 a127 a128 a129 a130 a131 a132 a133 a134 a135 a136 a137 a138 a139 a140 a141 a142 a143 a144 a145 a146 a147 a148 a149 a150 a151 a152 a153 a154 a155 a156 a157 a158 a159 a160 a161 a162 a163 a164 a165 a166 a167 a168 a169 a170 a171 a172 a173 a174 a175 a176 a177 a178 a179 a180 a181 a182 a183 a184 a185 a186 a187 a188 a189 a190 a191 a192 a193 a194 a195 a196 a197 a198 a199 a200 a201 a202 a203 a204 a205 a206 a207 a208 a209 a210 a211 a212 a213 a214 a215 a216 a217 a218 a219 a220 a221 a222 a223 a224 a225 a226 a227 a228 a229 a230 a231 a232 a233 a234 a235 a236 a237 a238 a239 a240 a241 a242 a243 a244 a245 a246 a247 a248 a249 a250 a251 a252 a253 a254 a255 a256 a257 a258 a259 a260 a261 a262 a263 a264 a265 a266 a267 a268 a269 a270 a271 a272 a273 a274 a275 a276 a277 a278 a279 a280 a281 a282 a283 a284 a285 a286 a287 a288 a289 a290 a291 a292 a293 a294 a295 a296 a297 a298 a299 a300 a301 a302 a303 a304 a305 a306 a307 a308 a309 a310 a311 a312 a313 a314 a315 a316 a317 a318 a319 a320 a321 a322 a323 a324 a325 a326 a327 a328 a329 a330 a331 a332 a333 a334 a335 a336 a337 a338 a339 a340 a341 a342 a343 a344 a345 a346 a347 a348 a349 a350 a351 a352 a353 a354 a355 a356 a357 a358 a359 a360 a361 a362 a363 a364 a365 a366 a367 a368 a369 a370 a371 a372 a373 a374 a375 a376 a377 a378 a379 a380 a381 a382 a383 a384 a385 a386 a387 a388 a389 a390 a391 a392 a393 a394 a395 a396 a397 a398 a399 a400 a401 a402 a403 a404 a405 a406 a407 a408 a409 a410 a411 a412 a413 a414 a415 a416 a417 a418 a419 a420 a421 a422 a423 a424 a425 a426 a427 a428 a429 a430 a431 a432 a433 a434 a435 a436 a437 a438 a439 a440 a441 a442 a443 a444 a445 a446 a447 a448 a449 a450 a451 a452 a453 a454 a455 a456 a457 a458 a459 a460 a461 a462 a463 a464 a465 a466 a467 a468 a469 a470 a471 a472 a473 a474 a475 a476 a477 a478 a479 a480 a481 a482 a483 a484 a485 a486 a487 a488 a489 a490 a491 a492 a493 a494 a495 a496 a497 a498 a499) = a0 + a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 + a26 + a27 + a28 + a29 + a30 + a31 + a32 + a33 + a34 + a35 + a36 + a37 + a38 + a39 + a40 + a41 + a42 + a43 + a44 + a45 + a46 + a47 + a48 + a49 + a50 + a51 + a52 + a53 + a54 + a55 + a56 + a57 + a58 + a59 + a60 + a61 + a62 + a63 + a64 + a65 + a66 + a67 + a68 + a69 + a70 + a71 + a72 + a73 + a74 + a75 + a76 + a77 + a78 + a79 + a80 + a81 + a82 + a83 + a84 + a85 + a86 + a87 + a88 + a89 + a90 + a91 + a92 + a93 + a94 + a95 + a96 + a97 + a98 + a99 + a100 + a101 + a102 + a103 + a104 + a105 + a106 + a107 + a108 + a109 + a110 + a111 + a112 + a113 + a114 + a115 + a116 + a117 + a118 + a119 + a120 + a121 + a122 + a123 + a124 + a125 + a126 + a127 + a128 + a129 + a130 + a131 + a132 + a133 + a134 + a135 + a136 + a137 + a138 + a139 + a140 + a141 + a142 + a143 + a144 + a145 + a146 + a147 + a148 + a149 + a150 + a151 + a152 + a153 + a154 + a155 + a156 + a157 + a158 + a159 + a160 + a161 + a162 + a163 + a164 + a165 + a166 + a167 + a168 + a169 + a170 + a171 + a172 + a173 + a174 + a175 + a176 + a177 + a178 + a179 + a180 + a181 + a182 + a183 + a184 + a185 + a186 + a187 + a188 + a189 + a190 + a191 + a192 + a193 + a194 + a195 + a196 + a197 + a198 + a199 + a200 + a201 + a202 + a203 + a204 + a205 + a206 + a207 + a208 + a209 + a210 + a211 + a212 + a213 + a214 + a215 + a216 + a217 + a218 + a219 + a220 + a221 + a222 + a223 + a224 + a225 + a226 + a227 + a228 + a229 + a230 + a231 + a232 + a233 + a234 + a235 + a236 + a237 + a238 + a239 + a240 + a241 + a242 + a243 + a244 + a245 + a246 + a247 + a248 + a249 + a250 + a251 + a252 + a253 + a254 + a255 + a256 + a257 + a258 + a259 + a260 + a261 + a262 + a263 + a264 + a265 + a266 + a267 + a268 + a269 + a270 + a271 + a272 + a273 + a274 + a275 + a276 + a277 + a278 + a279 + a280 + a281 + a282 + a283 + a284 + a285 + a286 + a287 + a288 + a289 + a290 + a291 + a292 + a293 + a294 + a295 + a296 + a297 + a298 + a299 + a300 + a301 + a302 + a303 + a304 + a305 + a306 + a307 + a308 + a309 + a310 + a311 + a312 + a313 + a314 + a315 + a316 + a317 + a318 + a319 + a320 + a321 + a322 + a323 + a324 + a325 + a326 + a327 + a328 + a329 + a330 + a331 + a332 + a333 + a334 + a335 + a336 + a337 + a338 + a339 + a340 + a341 + a342 + a343 + a344 + a345 + a346 + a347 + a348 + a349 + a350 + a351 + a352 + a353 + a354 + a355 + a356 + a357 + a358 + a359 + a360 + a361 + a362 + a363 + a364 + a365 + a366 + a367 + a368 + a369 + a370 + a371 + a372 + a373 + a374 + a375 + a376 + a377 + a378 + a379 + a380 + a381 + a382 + a383 + a384 + a385 + a386 + a387 + a388 + a389 + a390 + a391 + a392 + a393 + a394 + a395 + a396 + a397 + a398 + a399 + a400 + a401 + a402 + a403 + a404 + a405 + a406 + a407 + a408 + a409 + a410 + a411 + a412 + a413 + a414 + a415 + a416 + a417 + a418 + a419 + a420 + a421 + a422 + a423 + a424 + a425 + a426 + a427 + a428 + a429 + a430 + a431 + a432 + a433 + a434 + a435 + a436 + a437 + a438 + a439 + a440 + a441 + a442 + a443 + a444 + a445 + a446 + a447 + a448 + a449 + a450 + a451 + a452 + a453 + a454 + a455 + a456 + a457 + a458 + a459 + a460 + a461 + a462 + a463 + a464 + a465 + a466 + a467 + a468 + a469 + a470 + a471 + a472 + a473 + a474 + a475 + a476 + a477 + a478 + a479 + a480 + a481 + a482 + a483 + a484 + a485 + a486 + a487 + a488 + a489 + a490 + a491 + a492 + a493 + a494 + a495 + a496 + a497 + a498 + a499 + +main :: IO () +main = do + bigs <- forM [1..100] (return . mkBig) + performMajorGC + forM_ [1..3] (const performMajorGC) + print (sum (map sumBig bigs)) ===================================== testsuite/tests/rts/T27649.stdout ===================================== @@ -0,0 +1 @@ +15000000 ===================================== testsuite/tests/rts/all.T ===================================== @@ -699,8 +699,20 @@ test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']) test('T27123', [when(have_profiling(), extra_ways(['prof']))], compile_and_run, ['-O']) +# T27434 and T27649 test the compacting GC on large closures (AP and +# CONSTR respectively) that only the bytecode interpreter allocates, so +# they must run in the ghci way. In the ghci way extra_run_opts only +# sets the interpreted program's argv (via :set args), so enable +# compaction with GHCRTS to make it reach the RTS of the GHCi process +# itself (#27615). test('T27434', - extra_ways(['compacting_gc']), + [only_ways(['ghci']), + cmd_prefix('GHCRTS=-c ')], + compile_and_run, ['']) + +test('T27649', + [only_ways(['ghci']), + cmd_prefix('GHCRTS=-c ')], compile_and_run, ['']) test('T19048', ===================================== testsuite/tests/rts/continuations/T27651.hs ===================================== @@ -0,0 +1,91 @@ +-- When capturing or resuming a continuation adjusts the async exception +-- masking state, the RTS trampolines through a mask/unmask frame, and the +-- stack must be well-formed at that point: with a blocked exception +-- pending, the eager raise in stg_unmaskAsyncExceptionszh_ret walks the +-- whole stack. +-- +-- Phase 1 exercises the capture side (stg_control0zh_ll): control0# runs +-- inside uninterruptibleMask_ while another thread has queued an +-- exception via throwTo, so the capture unmasks with the exception +-- pending. The frame evaluated between the unmask frame and the prompt +-- keeps raw Int# payload live so that a stale word on the stack cannot +-- masquerade as a valid frame by accident. +-- +-- Phase 2 exercises the resume side (stg_CONTINUATION_apply): the +-- continuation is captured while unmasked (inside mask/restore), so +-- resuming it unmasks, and it is applied from a thread that is masked +-- with an exception pending. +import Control.Concurrent +import Control.Exception +import Control.Monad + +import ContIO + +data Boom = Boom deriving Show +instance Exception Boom + +{-# NOINLINE useInts #-} +useInts :: Int -> Int -> Int -> Int -> Int -> Int +useInts a b c d e = a + b * c + d * e + +rounds :: Int +rounds = 150 + +phase1 :: Int -> IO () +phase1 i = do + mv <- newEmptyMVar + done <- newEmptyMVar + let !p = i * 7919 + 3 -- raw ints to live in the continuation frame + !q = i * 104729 + 7 + !u = i * 1299709 + 11 + !v = i * 15485863 + 13 + a <- forkIO $ + handle (\Boom -> void (tryPutMVar done (Left Boom))) $ do + tag <- newPromptTag + r <- prompt tag $ do + x <- uninterruptibleMask_ $ do + putMVar mv () + threadDelay 2000 -- let the thrower queue its exception + control0 tag (\_k -> pure (42 :: Int)) + -- continuation frame between the unmask frame and the + -- prompt frame, carrying raw Int# payload: + pure (useInts x p q u v) + void (tryPutMVar done (Right r)) + takeMVar mv + _ <- forkIO $ throwTo a Boom + void (takeMVar done) + +phase2 :: Int -> IO () +phase2 i = do + mv <- newEmptyMVar + done <- newEmptyMVar + kvar <- newEmptyMVar + let !p = i * 7919 + 3 + !q = i * 104729 + 7 + !u = i * 1299709 + 11 + !v = i * 15485863 + 13 + -- Capture a continuation whose resumption unmasks: the capture happens + -- inside restore, so its apply_mask_frame is the unmask frame. + _ <- forkIO $ do + tag <- newPromptTag + _ <- prompt tag $ mask $ \restore -> do + x <- restore (control0 tag (\k -> putMVar kvar k >> pure 0)) + pure (useInts x p q u v) + pure () + k <- takeMVar kvar + a <- forkIO $ + handle (\Boom -> void (tryPutMVar done (Left Boom))) $ do + r <- uninterruptibleMask_ $ do + putMVar mv () + threadDelay 2000 -- let the thrower queue its exception + k (pure 42) -- resuming unmasks with the exception pending + void (tryPutMVar done (Right r)) + takeMVar mv + _ <- forkIO $ throwTo a Boom + void (takeMVar done) + +main :: IO () +main = do + forM_ [1 .. rounds] phase1 + forM_ [1 .. rounds] phase2 + putStrLn "ok" ===================================== testsuite/tests/rts/continuations/T27651.stdout ===================================== @@ -0,0 +1 @@ +ok ===================================== testsuite/tests/rts/continuations/all.T ===================================== @@ -9,3 +9,4 @@ test('cont_nondet_handler', [extra_files(['ContIO.hs'])], multimod_compile_and_r test('cont_stack_overflow', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['cont_stack_overflow', '-with-rtsopts "-ki1k -kc2k -kb256"']) test('T23513', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['T23513', '']) +test('T27651', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['T27651', '']) ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -3,6 +3,12 @@ include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk +# T27629 runs a plugin that injects a Core binding +# that made the specialiser crash +T27629: + '$(TEST_HC)' $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -package ghc -c T27629Plugin.hs -v0 + '$(TEST_HC)' $(TEST_HC_OPTS) $(ghcPluginWayFlags) -c -O -fpolymorphic-specialisation -dcore-lint T27629.hs + # T18815 should not have a non-recursive join-point for 'go' # Previously we ended up with # join {go_sPI w_sQ3 = case w_sQ3 of { GHC.Types.I# ww1_sQ6 -> ===================================== testsuite/tests/simplCore/should_compile/T27629.hs ===================================== @@ -0,0 +1,29 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# OPTIONS_GHC -fplugin=T27629Plugin #-} + +-- The plugin rewrites 'poly' to the example of +-- Note [Weird special case for SpecDict]: +-- +-- poly = /\x. \t. split @T (mkD @x MkT) [t] +-- +-- where mkD :: forall a. T -> C T is a new top-level binding +-- (mkD = /\a. \_. $fCT), so the tyvar x is free in the dictionary +-- *expression* but not in its *type* (C T). +module T27629 (poly, split, T (..), C (..)) where + +import Data.Kind (Type) + +data T = MkT + +class C b where + meth :: b -> b + +instance C T where + meth x = x + +split :: C b => [b] -> [b] +split [] = [] +split (x : xs) = meth x : split xs + +poly :: forall (x :: Type). T -> [T] +poly t = [t] ===================================== testsuite/tests/simplCore/should_compile/T27629.stderr ===================================== @@ -0,0 +1 @@ +ReproPlugin: injected weird SpecDict call into poly ===================================== testsuite/tests/simplCore/should_compile/T27629Plugin.hs ===================================== @@ -0,0 +1,89 @@ +-- Injects the example of Note [Weird special case for SpecDict] in +-- GHC.Core.Opt.Specialise, which cannot be written in source Haskell: +-- a call whose dictionary argument mentions a type variable that is +-- free in the dictionary expression but not in its type. +-- +-- Runs before the main Core pipeline (in particular before the +-- Specialiser). It adds +-- +-- mkD :: forall a. T -> C T {-# NOINLINE mkD #-} +-- mkD = /\a. \_. $fCT +-- +-- and rewrites poly = /\x. \t. [t] +-- to poly = /\x. \t. split @T (mkD @x MkT) [t] +module T27629Plugin (plugin) where + +import GHC.Core.Make (mkCoreApps, mkListExpr) +import GHC.Core.Predicate (getClassPredTys_maybe) +import GHC.Plugins +import GHC.Types.InlinePragma (neverInlinePragma) + +plugin :: Plugin +plugin = + defaultPlugin + { installCoreToDos = \_ todos -> + return (CoreDoPluginPass "inject-weird-specdict" pass : todos) + , pluginRecompile = purePlugin + } + +pass :: ModGuts -> CoreM ModGuts +pass guts = do + let binds = mg_binds guts + + dfun = case [b | b <- bindersOfBinds binds, isDFunId b] of + (b : _) -> b + [] -> panic "ReproPlugin: no dfun binding in module" + + dictTy = idType dfun -- C T + tyT = case getClassPredTys_maybe dictTy of + Just (_cls, [t]) -> t + _ -> panic "ReproPlugin: dfun type is not C T" + + mkTCon = case tyConDataCons (tyConAppTyCon tyT) of + (dc : _) -> dataConWorkId dc + [] -> panic "ReproPlugin: T has no data constructors" + + findTopId nm = + case [b | b <- bindersOfBinds binds, occNameString (getOccName b) == nm] of + (b : _) -> b + [] -> panic ("ReproPlugin: no top-level binding " ++ nm) + + splitId = findTopId "split" + polyId = findTopId "poly" + + uMkD <- getUniqueM + uTv <- getUniqueM + uWild <- getUniqueM + + let aTv = mkTyVar (mkSystemName uTv (mkTyVarOcc "a")) liftedTypeKind + mkDTy = mkSpecForAllTys [aTv] (mkFunctionType ManyTy tyT dictTy) + mkDId = + setInlinePragma + (mkExportedVanillaId (mkSystemName uMkD (mkVarOcc "mkD")) mkDTy) + neverInlinePragma + wild = mkSysLocal (fsLit "eta") uWild ManyTy tyT + mkDBind = NonRec mkDId (mkLams [aTv, wild] (Var dfun)) + + rewritePoly rhs + | (bndrs, _body) <- collectBinders rhs + , (x : _) <- reverse (filter isTyVar bndrs) + , (t : _) <- filter isId bndrs + = mkLams bndrs $ + mkCoreApps + (Var splitId) + [ Type tyT + , mkCoreApps (Var mkDId) [Type (mkTyVarTy x), Var mkTCon] + , mkListExpr tyT [Var t] + ] + | otherwise = + pprPanic "ReproPlugin: unexpected shape of poly" (ppr rhs) + + go (b, rhs) + | b == polyId = (b, rewritePoly rhs) + | otherwise = (b, rhs) + + -- One top-level Rec, so bind order is irrelevant. + binds' = [Rec (map go (flattenBinds binds) ++ flattenBinds [mkDBind])] + + putMsgS "ReproPlugin: injected weird SpecDict call into poly" + return guts {mg_binds = binds'} ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -618,3 +618,5 @@ test('T27556', [only_ways('ghci'), extra_hc_opts('-O -fno-unoptimized-core-for-i test('T27749', multiline_grep_errmsg(r'ordering\n.*\n(\s+src<[^>]*>\n)+'), compile, ['-O -g3 -ddump-simpl -dsuppress-uniques']) + +test('T27629', only_ways(['optasm']), makefile_test, ['T27629']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7113ad52a62ac825310bcba0693d4c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7113ad52a62ac825310bcba0693d4c… 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