August 2026 - ghc-commits

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: testsuite: Don't crash on non-UTF-8 test output
by Marge Bot (＠marge-bot) 05 Aug '26

05 Aug '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1e38fe22 by Simon Jakobi at 2026-08-04T20:34:57-04:00 testsuite: Don't crash on non-UTF-8 test output read_stdout, read_stderr_for, read_comp_stderr and read_diff decoded strictly (the first three with UTF-8, read_diff with the locale encoding), so a test emitting invalid UTF-8 (binary output, or a crash truncating a multi-byte character) raised UnicodeDecodeError and was reported as a framework failure instead of its actual result. Decode with errors='replace', like read_no_crs and safe_print. Assisted-by: Claude Fable 5 - - - - - b257b75c by Simon Jakobi at 2026-08-04T20:34:57-04:00 testsuite: Colorize the test summary, also in CI The summary headings were plain, and SUMMARY was colored unconditionally, so the escapes also ended up in the file written by --summary-file. Color is now decided per output sink via term_color.colored_if; see the comments in term_color. CI logs are not a tty, but GitLab's log viewer renders ANSI colors, so add --force-colors and pass it in .gitlab/ci.sh. Assisted-by: Claude Opus 5 - - - - - 86527622 by Simon Jakobi at 2026-08-04T20:34:57-04:00 testsuite: Repeat unexpected failure output in the summary Finding out why a test failed meant scrolling back through a possibly very long log to the point where the test ran. The summary now repeats the captured output of unexpected failures, before the statistics, so the most interesting part is at the end of the log (#16720). Output mismatches report their diff instead of the mismatching stream (see Note [Redundant output in test results]). The repeated output is bounded per stream, and skipped altogether beyond MAX_SUMMARY_OUTPUT_TESTS failure blocks. Tests failing identically in several ways share one block. Test results now report a source-relative directory, stable regardless of where the run was started from. Assisted-by: Claude Fable 5 - - - - - f6970cb9 by Ben Gamari at 2026-08-04T20:34:57-04:00 base: Don't drop exception context in SomeException(toException) For reasons that are lost to time, the implementation of [CLC #200] that was merged inappropriately dropped `ExceptionContext` in the `toException` implementation given to `SomeException`. Fix this infelicity. [CLC #200]: https://github.com/haskell/core-libraries-committee/issues/200 - - - - - d745133d by Simon Jakobi at 2026-08-04T20:34:59-04:00 Cmm: print unreachable blocks under -dppr-debug (#27368) Unreachable blocks linger in a CmmGraph's block map for most of the Cmm pipeline, but pprCmmGraph only ever printed the blocks reachable from the entry, so dumps looked consistent while the graph was not. Issues like #27368 were hard to debug due to this. pprCmmGraph now appends the stored-but-unreachable blocks under a "// unreachable blocks:" heading when -dppr-debug is on. See Note [unreachable blocks] in GHC.Cmm.Pipeline. Assisted-by: Claude Opus 5 - - - - - 9b74e7f1 by Cheng Shao at 2026-08-04T20:35:00-04:00 compiler: always run cmm lint on parsed cmm when compiling .cmm input This patch makes ghc always run cmm lint on parsed cmm when compiling .cmm input. Hand-written cmm is extremely error-prone and they take just a small fraction of time when compiling ghc or user libraries anyway, hence it's beneficial to enforce a lint even if -dcmm-lint is not explicitly turned on. Closes #8372. Co-authored-by: Codex <codex(a)openai.com> - - - - - 9a957874 by Simon Peyton Jones at 2026-08-04T20:35:01-04:00 Fix three bugs related to required type args and INLINE pragmas * `GHC.Core.Opt.Arity.mkEtaForAllMCo` got the visibility flags back to front, leading to a Lint error (#27557) * The arity in an InlineSaturation is the VisArity not the Arity; the two can differ when we have "required" type arguments. This made the INLINE pragma argument counting go wrong in `makeCorePair` (#27590). * When a simple binding has a type signature, we take special path in `tcPolyCheck`, leading to an outer `AbsBinds` that has no dictionaries, even when the binding is in fact overloaded. That confused the inline-arity computation in `makeCorePair` (#27589). The latter two are fixed using the new function `GHC.HsToCore.Binds.findSatArity`. That actually simplifies the API of `makeCorePair`, which is nice. The first bug is fixed by swapping the visiblity flags in `GHC.Core.Opt.Arity.mkEtaForAllMCo` Getting the INLINE behaviour right led to some perf changes: * Runtime /halved/ on T7954 due to better specialisation * Compile time increased by 6% in T21839c because a bit more inlining happened, as it always should have done. Geometric mean effect on our compile time benchmarks is +0.1%. Metric Decrease: T7954 Metric Increase: T21839c - - - - - 5cb7a47e by Vladislav Zavialov at 2026-08-04T20:35:02-04:00 Test case for #20902 Starting with GHC 9.14.1 (the first major release to include 51e3ec83), and from point releases GHC 9.10.2 and GHC 9.12.3 (backports cc4470be68 and b30f25591e), all examples in this ticket are handled as expected. - - - - - c5d2270f by Alan Zimmerman at 2026-08-04T20:35:03-04:00 EPA: Remove LocatedP, last use in WarningTxt The last step of removing LocatedP, by moving the AnnPragma for WarningTxt into its TTG extension point instead. This also allows us to remove LocatedP and SrcSpanAnnP - - - - - 1a2bc8f4 by Vladislav Zavialov at 2026-08-04T20:35:04-04:00 Test cases for #18725 Starting with GHC 9.4 (the first release to include 268efcc9a4), the program in this ticket no longer panics. A standalone kind signature breaks the recursive loop, so the type constructor can be used in a kind within its own group. T18725a checks that this is accepted with the signature present, while T18725b confirms it is still rejected without it. - - - - - 56 changed files: - .gitlab/ci.sh - + changelog.d/T27368-ppr-unreachable-cmm-blocks.md - + changelog.d/T27455 - + changelog.d/T27557 - + changelog.d/T27589 - + changelog.d/always-lint-cmm-file - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Driver/Main/Compile.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Warnings.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/InlinePragma.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Unit/Module/Warnings.hs - docs/users_guide/debugging.rst - libraries/base/changelog.md - libraries/base/tests/perf/ElemFusionUnknownList_O1.stderr - libraries/base/tests/perf/ElemFusionUnknownList_O2.stderr - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs - testsuite/driver/runtests.py - testsuite/driver/term_color.py - testsuite/driver/testlib.py - testsuite/tests/cmm/should_compile/Makefile - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.cmm - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout - testsuite/tests/cmm/should_compile/all.T - testsuite/tests/ghc-e/should_fail/T18441fail7.stderr - testsuite/tests/ghc-e/should_run/ghc-e005.stderr - + testsuite/tests/saks/should_compile/T18725a.hs - testsuite/tests/saks/should_compile/all.T - + testsuite/tests/saks/should_fail/T18725b.hs - + testsuite/tests/saks/should_fail/T18725b.stderr - testsuite/tests/saks/should_fail/all.T - + testsuite/tests/simplCore/should_compile/T27589.hs - + testsuite/tests/simplCore/should_compile/T27589.stderr - + testsuite/tests/simplCore/should_compile/T27590.hs - + testsuite/tests/simplCore/should_compile/T27590.stderr - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/th/T20902.hs - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_compile/T27557.hs - testsuite/tests/typecheck/should_compile/all.T - utils/check-exact/ExactPrint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97145b38ff250042802d9d568343a4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97145b38ff250042802d9d568343a4… 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] 9 commits: testsuite: Don't crash on non-UTF-8 test output
by Marge Bot (＠marge-bot) 04 Aug '26

04 Aug '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f3fea6ad by Simon Jakobi at 2026-08-04T18:03:44-04:00 testsuite: Don't crash on non-UTF-8 test output read_stdout, read_stderr_for, read_comp_stderr and read_diff decoded strictly (the first three with UTF-8, read_diff with the locale encoding), so a test emitting invalid UTF-8 (binary output, or a crash truncating a multi-byte character) raised UnicodeDecodeError and was reported as a framework failure instead of its actual result. Decode with errors='replace', like read_no_crs and safe_print. Assisted-by: Claude Fable 5 - - - - - 76bec929 by Simon Jakobi at 2026-08-04T18:03:44-04:00 testsuite: Colorize the test summary, also in CI The summary headings were plain, and SUMMARY was colored unconditionally, so the escapes also ended up in the file written by --summary-file. Color is now decided per output sink via term_color.colored_if; see the comments in term_color. CI logs are not a tty, but GitLab's log viewer renders ANSI colors, so add --force-colors and pass it in .gitlab/ci.sh. Assisted-by: Claude Opus 5 - - - - - 1487fb91 by Simon Jakobi at 2026-08-04T18:03:44-04:00 testsuite: Repeat unexpected failure output in the summary Finding out why a test failed meant scrolling back through a possibly very long log to the point where the test ran. The summary now repeats the captured output of unexpected failures, before the statistics, so the most interesting part is at the end of the log (#16720). Output mismatches report their diff instead of the mismatching stream (see Note [Redundant output in test results]). The repeated output is bounded per stream, and skipped altogether beyond MAX_SUMMARY_OUTPUT_TESTS failure blocks. Tests failing identically in several ways share one block. Test results now report a source-relative directory, stable regardless of where the run was started from. Assisted-by: Claude Fable 5 - - - - - 11700394 by Simon Jakobi at 2026-08-04T18:03:46-04:00 Cmm: print unreachable blocks under -dppr-debug (#27368) Unreachable blocks linger in a CmmGraph's block map for most of the Cmm pipeline, but pprCmmGraph only ever printed the blocks reachable from the entry, so dumps looked consistent while the graph was not. Issues like #27368 were hard to debug due to this. pprCmmGraph now appends the stored-but-unreachable blocks under a "// unreachable blocks:" heading when -dppr-debug is on. See Note [unreachable blocks] in GHC.Cmm.Pipeline. Assisted-by: Claude Opus 5 - - - - - d56a44d5 by Cheng Shao at 2026-08-04T18:03:47-04:00 compiler: always run cmm lint on parsed cmm when compiling .cmm input This patch makes ghc always run cmm lint on parsed cmm when compiling .cmm input. Hand-written cmm is extremely error-prone and they take just a small fraction of time when compiling ghc or user libraries anyway, hence it's beneficial to enforce a lint even if -dcmm-lint is not explicitly turned on. Closes #8372. Co-authored-by: Codex <codex(a)openai.com> - - - - - 6589abb6 by Simon Peyton Jones at 2026-08-04T18:03:48-04:00 Fix three bugs related to required type args and INLINE pragmas * `GHC.Core.Opt.Arity.mkEtaForAllMCo` got the visibility flags back to front, leading to a Lint error (#27557) * The arity in an InlineSaturation is the VisArity not the Arity; the two can differ when we have "required" type arguments. This made the INLINE pragma argument counting go wrong in `makeCorePair` (#27590). * When a simple binding has a type signature, we take special path in `tcPolyCheck`, leading to an outer `AbsBinds` that has no dictionaries, even when the binding is in fact overloaded. That confused the inline-arity computation in `makeCorePair` (#27589). The latter two are fixed using the new function `GHC.HsToCore.Binds.findSatArity`. That actually simplifies the API of `makeCorePair`, which is nice. The first bug is fixed by swapping the visiblity flags in `GHC.Core.Opt.Arity.mkEtaForAllMCo` Getting the INLINE behaviour right led to some perf changes: * Runtime /halved/ on T7954 due to better specialisation * Compile time increased by 6% in T21839c because a bit more inlining happened, as it always should have done. Geometric mean effect on our compile time benchmarks is +0.1%. Metric Decrease: T7954 Metric Increase: T21839c - - - - - ceb7cf3d by Vladislav Zavialov at 2026-08-04T18:03:49-04:00 Test case for #20902 Starting with GHC 9.14.1 (the first major release to include 51e3ec83), and from point releases GHC 9.10.2 and GHC 9.12.3 (backports cc4470be68 and b30f25591e), all examples in this ticket are handled as expected. - - - - - b081be94 by Alan Zimmerman at 2026-08-04T18:03:50-04:00 EPA: Remove LocatedP, last use in WarningTxt The last step of removing LocatedP, by moving the AnnPragma for WarningTxt into its TTG extension point instead. This also allows us to remove LocatedP and SrcSpanAnnP - - - - - 97145b38 by Vladislav Zavialov at 2026-08-04T18:03:50-04:00 Test cases for #18725 Starting with GHC 9.4 (the first release to include 268efcc9a4), the program in this ticket no longer panics. A standalone kind signature breaks the recursive loop, so the type constructor can be used in a kind within its own group. T18725a checks that this is accepted with the signature present, while T18725b confirms it is still rejected without it. - - - - - 51 changed files: - .gitlab/ci.sh - + changelog.d/T27368-ppr-unreachable-cmm-blocks.md - + changelog.d/T27557 - + changelog.d/T27589 - + changelog.d/always-lint-cmm-file - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Driver/Main/Compile.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Warnings.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/InlinePragma.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Unit/Module/Warnings.hs - docs/users_guide/debugging.rst - libraries/base/tests/perf/ElemFusionUnknownList_O1.stderr - libraries/base/tests/perf/ElemFusionUnknownList_O2.stderr - testsuite/driver/runtests.py - testsuite/driver/term_color.py - testsuite/driver/testlib.py - testsuite/tests/cmm/should_compile/Makefile - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.cmm - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout - testsuite/tests/cmm/should_compile/all.T - + testsuite/tests/saks/should_compile/T18725a.hs - testsuite/tests/saks/should_compile/all.T - + testsuite/tests/saks/should_fail/T18725b.hs - + testsuite/tests/saks/should_fail/T18725b.stderr - testsuite/tests/saks/should_fail/all.T - + testsuite/tests/simplCore/should_compile/T27589.hs - + testsuite/tests/simplCore/should_compile/T27589.stderr - + testsuite/tests/simplCore/should_compile/T27590.hs - + testsuite/tests/simplCore/should_compile/T27590.stderr - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/th/T20902.hs - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_compile/T27557.hs - testsuite/tests/typecheck/should_compile/all.T - utils/check-exact/ExactPrint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e336513759538888b19deb5e7fc30c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e336513759538888b19deb5e7fc30c… 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/int-index/tcl-rdr-leak
by Vladislav Zavialov (＠int-index) 04 Aug '26

04 Aug '26

Vladislav Zavialov pushed new branch wip/int-index/tcl-rdr-leak at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/tcl-rdr-leak 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/hie-file-improvements] hie files: Take evidence for quantified constraints into account when saving...
by Hannes Siebenhandl (＠fendor) 04 Aug '26

04 Aug '26

Hannes Siebenhandl pushed to branch wip/hie-file-improvements at Glasgow Haskell Compiler / GHC Commits: 9d32d547 by Zubin Duggal at 2026-08-04T18:41:06+02:00 hie files: Take evidence for quantified constraints into account when saving evidence terms to the hie ast Fixes #25709 - - - - - 3 changed files: - + testsuite/tests/hiefile/should_run/T25709.hs - + testsuite/tests/hiefile/should_run/T25709.stdout - testsuite/tests/hiefile/should_run/all.T Changes: ===================================== testsuite/tests/hiefile/should_run/T25709.hs ===================================== @@ -0,0 +1,40 @@ +{-# LANGUAGE QuantifiedConstraints#-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +module Main where + +import TestUtils +import qualified Data.Map.Strict as M +import qualified Data.Set as S +import Data.Either +import Data.Maybe +import Data.Bifunctor (first) +import GHC.Plugins (moduleNameString, nameStableString, nameOccName, occNameString, isDerivedOccName) +import GHC.Iface.Ext.Types + + +import Data.Typeable + +data Some c where + Some :: c a => a -> Some c + +extractSome :: (Typeable a, forall x. c x => Typeable x) => Some c -> Maybe a +extractSome (Some a) = cast a + +f :: (forall x. Ord x => Eq [x]) => () +f = () +{-# NOINLINE f #-} + +g :: () +g = f + +useQC :: forall c a. (c a, forall x. c x => Show x) => a -> String +useQC x = show x + +points :: [(Int,Int)] +points = [(22,26),(29, 5), (32, 13)] + +main = do + (df, hf) <- readTestHie "T25709.hie" + let refmap = generateReferencesMap $ getAsts $ hie_asts hf + traverse (explainEv df hf refmap) points ===================================== testsuite/tests/hiefile/should_run/T25709.stdout ===================================== @@ -0,0 +1,110 @@ +========================== +At point (22,26), we found: +========================== +┌ +│ $dTypeable at T25709.hs:22:14-19, of type: Typeable a +│ is an evidence variable bound by a let, depending on: [$dTypeable] +│ with scope: LocalScope T25709.hs:22:14-29 +│ +│ Defined at <no location info> +└ +| +`- ┌ + │ $dTypeable at T25709.hs:22:1-29, of type: Typeable a + │ is an evidence variable bound by a HsWrapper + │ with scope: LocalScope T25709.hs:22:1-29 + │ bound at: T25709.hs:22:1-29 + │ Defined at <no location info> + └ + +┌ +│ $dTypeable at T25709.hs:22:14-19, of type: Typeable a +│ is an evidence variable bound by a let, depending on: [df, irred] +│ with scope: LocalScope T25709.hs:22:14-29 +│ +│ Defined at <no location info> +└ +| ++- ┌ +| │ df at T25709.hs:22:1-29, of type: forall x. c x => Typeable x +| │ is an evidence variable bound by a HsWrapper +| │ with scope: LocalScope T25709.hs:22:1-29 +| │ bound at: T25709.hs:22:1-29 +| │ Defined at <no location info> +| └ +| +`- ┌ + │ irred at T25709.hs:22:14-19, of type: c a + │ is an evidence variable bound by a let, depending on: [irred] + │ with scope: LocalScope T25709.hs:22:14-29 + │ + │ Defined at <no location info> + └ + | + `- ┌ + │ irred at T25709.hs:22:14-19, of type: c a + │ is an evidence variable bound by a pattern + │ with scope: LocalScope T25709.hs:22:14-29 + │ + │ Defined at <no location info> + └ + +========================== +At point (29,5), we found: +========================== +┌ +│ df at T25709.hs:1:1, of type: forall x. Ord x => Eq [x] +│ is an evidence variable bound by a let, depending on: [$p1Ord, +│ $fEqList] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| ++- ┌ +| │ $p1Ord at T25709.hs:1:1, of type: forall a. Ord a => Eq a +| │ is a usage of an external evidence variable +| │ Defined in `GHC.Internal.Classes' +| └ +| +`- ┌ + │ $fEqList at T25709.hs:1:1, of type: forall a. Eq a => Eq [a] + │ is a usage of an external evidence variable + │ Defined in `GHC.Internal.Classes' + └ + +========================== +At point (32,13), we found: +========================== +┌ +│ $dShow at T25709.hs:32:1-16, of type: Show a +│ is an evidence variable bound by a let, depending on: [df, irred] +│ with scope: LocalScope T25709.hs:32:1-16 +│ bound at: T25709.hs:32:1-16 +│ Defined at <no location info> +└ +| ++- ┌ +| │ df at T25709.hs:32:1-16, of type: forall x. c x => Show x +| │ is an evidence variable bound by a HsWrapper +| │ with scope: LocalScope T25709.hs:32:1-16 +| │ bound at: T25709.hs:32:1-16 +| │ Defined at <no location info> +| └ +| +`- ┌ + │ irred at T25709.hs:32:1-16, of type: c a + │ is an evidence variable bound by a let, depending on: [irred] + │ with scope: LocalScope T25709.hs:32:1-16 + │ bound at: T25709.hs:32:1-16 + │ Defined at <no location info> + └ + | + `- ┌ + │ irred at T25709.hs:32:1-16, of type: c a + │ is an evidence variable bound by a HsWrapper + │ with scope: LocalScope T25709.hs:32:1-16 + │ bound at: T25709.hs:32:1-16 + │ Defined at <no location info> + └ + ===================================== testsuite/tests/hiefile/should_run/all.T ===================================== @@ -8,4 +8,5 @@ test('HieVdq', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUti test('T23540', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('T23120', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('T24544', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) -test('HieGadtConSigs', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) \ No newline at end of file +test('HieGadtConSigs', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) +test('T25709', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d32d5479bcf272021b24068330201b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d32d5479bcf272021b24068330201b… 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/supersven/hadrian-cross-stage3] 9 commits: GHC Guide: Improve docs on response files
by Sven Tennie (＠supersven) 04 Aug '26

04 Aug '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: 3ec9e2b9 by Mike Pilgrem at 2026-07-31T08:21:33-04:00 GHC Guide: Improve docs on response files - - - - - e5b2a1f7 by sheaf at 2026-07-31T08:22:23-04:00 Disable Core Lint for TcPlugin_RewritePerf This is a compiler performance test, but the test source hard-coded -dcore-lint, defeating the measurement. ------------------------- Metric Decrease: TcPlugin_RewritePerf ------------------------- - - - - - 85b10c00 by Alan Zimmerman at 2026-07-31T22:09:47+01:00 EPA: Remove LocatedP from OverlapMode We have type LocatedP = GenLocated SrcSpanAnnP type SrcSpanAnnP = EpAnn AnnPragma As the first step in removing this in favour of LocatedA which only captures location, comments and trailing annotations, we remove it from OverlapMode We do this by moving the AnnPragma into the TTG extension point instead. - - - - - c9a34a00 by Viktor Dukhovni at 2026-08-02T04:34:17-04:00 Fix note typo - - - - - 4f2a21f7 by Andreas Klebinger at 2026-08-02T22:46:46-04:00 Apply oneShot Monad trick to STG LintM - - - - - 21e4b89d by Andreas Klebinger at 2026-08-02T22:46:46-04:00 stgLint: Use a single reader env for read only arguments. - - - - - d415f38a by Alan Zimmerman at 2026-08-02T22:47:27-04:00 EPA: Remove LocatedP from CType The next step of removing use of LocatedP by moving the AnnPragma for CType into its TTG extension point instead. - - - - - 5bbf4dc6 by Sven Tennie at 2026-08-04T18:36:36+02:00 hadrian: Add Stage3 cross-compiled target bindist (#26924) Add a `binary-dist-stage3` Hadrian target that packages target executables (produced by the stage2 compiler) into a separate '_build/bindist-stage3/' folder, distinct from the stage2 regular or cross-compiler bindist in '_build/bindist/'. This allows a single CI pipeline job to produce both a cross-compiler bindist (e.g. x86_64 -> RISC-V) and a target-architecture bindist (e.g. RISC-V -> RISC-V) that can be installed and run natively on the target. To avoid issues with stale files or race-conditions on them, generate the `configure` script per stage in `_build/<stage>/distrib` directories. - - - - - 29ffc836 by Sven Tennie at 2026-08-04T18:36:37+02:00 ci: Build Stage3 and Stage2 bindists for cross targets in one job (#26924) Building the stage3 target bindist already produces most of the stage2 cross-compiler bindist as a byproduct, so building them in separate jobs duplicates the build efforts for no benefit. Instead of a separate CROSS_STAGE=3 job, the stage3 job now also builds and publishes the stage2 bindist. The stage3 tarball is named and versioned as if it were built natively on the target (target triple prefix, non-cross opsys), so its artifact name stays what downstream consumers already expect and no changes are needed on their side. For now, this is only enabled for the RISC-V job. Others can easily follow. - - - - - 26 changed files: - .gitignore - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - + changelog.d/stage3-cross-bindists - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Decls/Overlap.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/ForeignCall.hs - distrib/configure.ac.in - docs/users_guide/using.rst - hadrian/src/BindistConfig.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - libraries/ghc-internal/src/GHC/Internal/Ix.hs - testsuite/tests/tcplugins/TcPlugin_RewritePerf.hs - testsuite/tests/tcplugins/TcPlugin_RewritePerf.stderr - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Types.hs Changes: ===================================== .gitignore ===================================== @@ -120,7 +120,6 @@ _darcs/ /compiler/GHC/CmmToLlvm/Version/Bounds.hs /compiler/ghc.cabal /compiler/ghc.cabal.old -/distrib/configure.ac /distrib/ghc.iss /docs/index.html /docs/man ===================================== .gitlab/ci.sh ===================================== @@ -62,9 +62,9 @@ Common Modes: Environment variables affecting the build: CROSS_TARGET Triple of cross-compilation target. - CROSS_STAGE The stage of the cross-compiler to build either - * 2: Build a normal cross-compiler bindist - * 3: Build a target executable bindist (with the stage2 cross-compiler) + FINAL_CROSS_STAGE The final stage of the cross-compiler to build either + * 2: Build a cross-compiler bindist + * 3: Build a target executable bindist (implies the cross-compiler bindist of 2) VERBOSE Set to non-empty for verbose build output RUNTEST_ARGS Arguments passed to runtest.py TEST_WAYS Testsuite ways to run @@ -573,10 +573,18 @@ function build_hadrian() { export XZ_OPT="${XZ_OPT:-} -T$cores" fi - case "${CROSS_STAGE:-2}" in + case "${FINAL_CROSS_STAGE:-2}" in 2) BINDIST_TARGET="binary-dist";; - 3) BINDIST_TARGET="binary-dist-stage3";; - *) fail "Unknown CROSS_STAGE, must be 2 or 3";; + # Stage2 cross-compiler bindists are (almost) a byproduct of Stage3 + # cross-compiled bindists. So, we bundle both of them when the Stage3 + # bindist is built. + 3) + BINDIST_TARGET="binary-dist binary-dist-stage3" + if [[ -z "${BIN_DIST_NAME_STAGE3:-}" ]]; then + fail "FINAL_CROSS_STAGE=3 requires BIN_DIST_NAME_STAGE3 to be set" + fi + ;; + *) fail "Unknown FINAL_CROSS_STAGE, must be 2 or 3";; esac if [[ -n "${REINSTALL_GHC:-}" ]]; then @@ -590,6 +598,9 @@ function build_hadrian() { *) run_hadrian test:all_deps $BINDIST_TARGET mv _build/bindist/ghc*.tar.xz "$BIN_DIST_NAME.tar.xz" + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then + mv _build/bindist-stage3/ghc*.tar.xz "$BIN_DIST_NAME_STAGE3.tar.xz" + fi ;; esac fi @@ -696,6 +707,26 @@ function test_hadrian() { # --- # > main = putStrLn "hello world" run diff -w expected actual + + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then + local stage3_dir + stage3_dir="$(echo _build/bindist-stage3/ghc-*/)" + local stage3_ghc="$stage3_dir/bin/ghc$exe" + + info "Smoke-testing stage3 compiler..." + file "$stage3_ghc" + run ${CROSS_EMULATOR} "$stage3_ghc" --info + + run ${CROSS_EMULATOR} "$stage3_ghc" -package ghc "$TOP/.gitlab/hello.hs" -o hello-stage3 + + if [[ "${CROSS_TARGET:-no_cross_target}" =~ "mingw" ]]; then + ${CROSS_EMULATOR:-} ./hello-stage3.exe > actual-stage3 + else + ${CROSS_EMULATOR:-} ./hello-stage3 > actual-stage3 + fi + + run diff -w expected actual-stage3 + fi elif [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian \ test \ ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -159,7 +159,7 @@ data BuildConfig , withNuma :: Bool , withZstd :: Bool , crossTarget :: Maybe String - , crossStage :: Maybe Int + , finalCrossStage :: Maybe FinalCrossStage , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String , fullyStatic :: Bool @@ -229,7 +229,7 @@ vanilla = BuildConfig , withNuma = False , withZstd = False , crossTarget = Nothing - , crossStage = Nothing + , finalCrossStage = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing , fullyStatic = False @@ -275,13 +275,26 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } +-- | The final stage for which binary distributions should be built +-- +-- `Stage2` builds a cross-compiler (build == host, host /= target). `Stage3` +-- implies `Stage2` and additionally builds a cross-compiled compiler (build /= +-- host, host == target). +data FinalCrossStage = Stage2 | Stage3 + deriving (Eq, Ord) + +crossStageToInt :: FinalCrossStage -> Int +crossStageToInt Stage2 = 2 +crossStageToInt Stage3 = 3 + crossConfig :: String -- ^ target triple -> CrossEmulator -- ^ emulator for testing -> Maybe String -- ^ Configure wrapper + -> FinalCrossStage -- ^ final stage to build -> BuildConfig -crossConfig triple emulator configure_wrapper = +crossConfig triple emulator configure_wrapper crossStage = vanilla { crossTarget = Just triple - , crossStage = Just 2 + , finalCrossStage = Just crossStage , crossEmulator = emulator , configureWrapper = configure_wrapper } @@ -348,21 +361,48 @@ opsysName Darwin = "darwin" opsysName FreeBSD14 = "freebsd14" opsysName Windows = "windows" +-- | Remove cross-specific prefix for Stage3 bindist names. +-- We need to pretend to have built the bindist on the target. +toStage3TargetOpsys :: Opsys -> Opsys +toStage3TargetOpsys (Linux Debian13Riscv) = Linux Debian13 +toStage3TargetOpsys (Linux Ubuntu2404LoongArch64) = Linux Ubuntu2404 +toStage3TargetOpsys opsys = opsys + archName :: Arch -> String archName Amd64 = "x86_64" archName AArch64 = "aarch64" archName I386 = "i386" +-- | First component of a cross target triple, used to name stage3 +-- (target-platform) bindists as if they had been built natively on the target. +targetArchName :: String -> String +targetArchName = takeWhile (/= '-') + binDistName :: Arch -> Opsys -> BuildConfig -> String -binDistName arch opsys bc = "ghc-" ++ testEnv arch opsys bc +binDistName arch = binDistNameWith (archName arch) + +binDistNameWith :: String -> Opsys -> BuildConfig -> String +binDistNameWith archN opsys bc = "ghc-" ++ testEnvWith archN opsys bc + +stage3BinDistName :: Opsys -> BuildConfig -> Maybe String +stage3BinDistName opsys bc + | Just Stage3 <- finalCrossStage bc + , Just triple <- crossTarget bc + = Just $ binDistNameWith (targetArchName triple) (toStage3TargetOpsys opsys) + (bc { crossTarget = Nothing }) + | otherwise + = Nothing -- | Test env should create a string which changes whenever the 'BuildConfig' changes. -- Either the change is reflected by modifying the flavourString or directly (as is -- the case for settings which affect environment variables) testEnv :: Arch -> Opsys -> BuildConfig -> String -testEnv arch opsys bc = +testEnv arch = testEnvWith (archName arch) + +testEnvWith :: String -> Opsys -> BuildConfig -> String +testEnvWith archN opsys bc = intercalate "-" $ concat - [ [ archName arch + [ [ archN , opsysName opsys ] , ["int_" ++ bignumString (bignumBackend bc) | bignumBackend bc /= Gmp] , ["unreg" | unregisterised bc ] @@ -883,13 +923,14 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } [ opsysVariables arch opsys , "TEST_ENV" =: testEnv arch opsys buildConfig , "BIN_DIST_NAME" =: binDistName arch opsys buildConfig + , maybe mempty ("BIN_DIST_NAME_STAGE3" =:) (stage3BinDistName opsys buildConfig) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig , "INSTALL_CONFIGURE_ARGS" =: "--enable-strict-ghc-toolchain-check" , maybe mempty ("CONFIGURE_WRAPPER" =:) (configureWrapper buildConfig) , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe mempty (("CROSS_STAGE" =:) . show) (crossStage buildConfig) + , maybe mempty (("FINAL_CROSS_STAGE" =:) . show . crossStageToInt) (finalCrossStage buildConfig) , case crossEmulator buildConfig of NoEmulator -- we need an emulator but it isn't set. Won't run the testsuite @@ -922,6 +963,8 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } trim :: String -> String trim = dropWhileEnd isSpace . dropWhile isSpace + stage3Artifacts = maybe [] (\n -> [n ++ ".tar.xz"]) (stage3BinDistName opsys buildConfig) + -- Keep in sync with the exclude list in `function clean()` in -- `.gitlab/ci.sh`! jobArtifacts = Artifacts @@ -930,6 +973,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" ,"junit.xml" ,"unexpected-test-output.tar.gz"] + ++ stage3Artifacts , artifactsWhen = ArtifactsAlways } @@ -1288,13 +1332,14 @@ alpine_aarch64 = [ cross_jobs :: [JobGroup Job] cross_jobs = [ -- x86 -> aarch64 - validateBuilds Amd64 (Linux Debian13) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) + validateBuilds Amd64 (Linux Debian13) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing Stage2) - -- x86_64 -> riscv - , addValidateRule RiscV (validateBuilds Amd64 (Linux Debian13Riscv) (crossConfig "riscv64-linux-gnu" (Emulator "qemu-riscv64 -L /usr/riscv64-linux-gnu") Nothing)) + -- Stage2: x86_64 (build/host) -> riscv64 (target) + -- Stage3: x86_64 (build) -> riscv64 (host/target) + , addValidateRule RiscV (validateBuilds Amd64 (Linux Debian13Riscv) (crossConfig "riscv64-linux-gnu" (Emulator "qemu-riscv64 -L /usr/riscv64-linux-gnu") Nothing Stage3)) -- x86_64 -> loongarch64 - , addValidateRule LoongArch64 (validateBuilds Amd64 (Linux Ubuntu2404LoongArch64) (crossConfig "loongarch64-linux-gnu" (Emulator "qemu-loongarch64 -L /usr/loongarch64-linux-gnu") Nothing)) + , addValidateRule LoongArch64 (validateBuilds Amd64 (Linux Ubuntu2404LoongArch64) (crossConfig "loongarch64-linux-gnu" (Emulator "qemu-loongarch64 -L /usr/loongarch64-linux-gnu") Nothing Stage2)) -- Javascript , addValidateRule JSBackend (validateBuilds Amd64 (Linux Debian11Js) javascriptConfig) @@ -1315,7 +1360,7 @@ cross_jobs = [ (validateBuilds AArch64 (Linux Debian12Wine) (winAarch64Config {llvmBootstrap = True})) ] where - javascriptConfig = (crossConfig "javascript-unknown-ghcjs" (NoEmulatorNeeded TimeoutIncrease) (Just "emconfigure")) + javascriptConfig = (crossConfig "javascript-unknown-ghcjs" (NoEmulatorNeeded TimeoutIncrease) (Just "emconfigure") Stage2) { bignumBackend = Native } makeWinArmJobs = modifyJobs @@ -1354,7 +1399,7 @@ cross_jobs = [ llvm_prefix = "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-" cflags = "-fuse-ld=" ++ llvm_prefix ++ "ld --rtlib=compiler-rt" - winAarch64Config = (crossConfig "aarch64-unknown-mingw32" (Emulator "/opt/wine-arm64ec-msys2-deb12/bin/wine") Nothing) + winAarch64Config = (crossConfig "aarch64-unknown-mingw32" (Emulator "/opt/wine-arm64ec-msys2-deb12/bin/wine") Nothing Stage2) { bignumBackend = Native } make_wasm_jobs cfg = @@ -1367,7 +1412,7 @@ cross_jobs = [ $ addValidateRule WasmBackend $ validateBuilds Amd64 (Linux AlpineWasm) cfg wasm_build_config = - (crossConfig "wasm32-wasi" (NoEmulatorNeeded NoTimeoutIncrease) Nothing) + (crossConfig "wasm32-wasi" (NoEmulatorNeeded NoTimeoutIncrease) Nothing Stage2) { hostFullyStatic = True , buildFlavour = Release -- TODO: This needs to be validate but wasm backend doesn't pass yet , textWithSIMDUTF = True ===================================== .gitlab/jobs.yaml ===================================== @@ -319,9 +319,9 @@ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONF_CC_OPTS_STAGE2": "-fuse-ld=/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld --rtlib=compiler-rt", "CROSS_EMULATOR": "/opt/wine-arm64ec-msys2-deb12/bin/wine", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-unknown-mingw32", "CXX": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-clang++", + "FINAL_CROSS_STAGE": "2", "HADRIAN_ARGS": "--docs=none", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LD": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld", @@ -403,9 +403,9 @@ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONF_CC_OPTS_STAGE2": "-fuse-ld=/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld --rtlib=compiler-rt", "CROSS_EMULATOR": "/opt/wine-arm64ec-msys2-deb12/bin/wine", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-unknown-mingw32", "CXX": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-clang++", + "FINAL_CROSS_STAGE": "2", "HADRIAN_ARGS": "--docs=none", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LD": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld", @@ -1127,9 +1127,9 @@ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONF_CC_OPTS_STAGE2": "-fuse-ld=/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld --rtlib=compiler-rt", "CROSS_EMULATOR": "/opt/wine-arm64ec-msys2-deb12/bin/wine", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-unknown-mingw32", "CXX": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-clang++", + "FINAL_CROSS_STAGE": "2", "HADRIAN_ARGS": "--docs=none", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LD": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld", @@ -1212,9 +1212,9 @@ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONF_CC_OPTS_STAGE2": "-fuse-ld=/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld --rtlib=compiler-rt", "CROSS_EMULATOR": "/opt/wine-arm64ec-msys2-deb12/bin/wine", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-unknown-mingw32", "CXX": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-clang++", + "FINAL_CROSS_STAGE": "2", "HADRIAN_ARGS": "--docs=none", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LD": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld", @@ -2010,8 +2010,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -2077,8 +2077,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-int_native-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -2144,8 +2144,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-unreg-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -2212,8 +2212,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_STAGE": "2", "CROSS_TARGET": "javascript-unknown-ghcjs", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate", @@ -2471,8 +2471,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-linux-gnu", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb13-cross_aarch64-linux-gnu-validate", @@ -2750,7 +2750,8 @@ "paths": [ "ghc-x86_64-linux-deb13-riscv-cross_riscv64-linux-gnu-validate.tar.xz", "junit.xml", - "unexpected-test-output.tar.gz" + "unexpected-test-output.tar.gz", + "ghc-riscv64-linux-deb13-validate.tar.xz" ], "reports": { "junit": "junit.xml" @@ -2792,11 +2793,12 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb13-riscv-cross_riscv64-linux-gnu-validate", + "BIN_DIST_NAME_STAGE3": "ghc-riscv64-linux-deb13-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-riscv64 -L /usr/riscv64-linux-gnu", - "CROSS_STAGE": "2", "CROSS_TARGET": "riscv64-linux-gnu", + "FINAL_CROSS_STAGE": "3", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb13-riscv-cross_riscv64-linux-gnu-validate", @@ -3699,8 +3701,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-loongarch64 -L /usr/loongarch64-linux-gnu", - "CROSS_STAGE": "2", "CROSS_TARGET": "loongarch64-linux-gnu", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-ubuntu24_04-loongarch-cross_loongarch64-linux-gnu-validate", @@ -5995,8 +5997,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -6062,8 +6064,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-int_native-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -6129,8 +6131,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-unreg-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -6196,8 +6198,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_STAGE": "2", "CROSS_TARGET": "javascript-unknown-ghcjs", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate", @@ -6451,8 +6453,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-linux-gnu", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb13-cross_aarch64-linux-gnu-validate", @@ -6726,7 +6728,8 @@ "paths": [ "ghc-x86_64-linux-deb13-riscv-cross_riscv64-linux-gnu-validate.tar.xz", "junit.xml", - "unexpected-test-output.tar.gz" + "unexpected-test-output.tar.gz", + "ghc-riscv64-linux-deb13-validate.tar.xz" ], "reports": { "junit": "junit.xml" @@ -6768,11 +6771,12 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb13-riscv-cross_riscv64-linux-gnu-validate", + "BIN_DIST_NAME_STAGE3": "ghc-riscv64-linux-deb13-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-riscv64 -L /usr/riscv64-linux-gnu", - "CROSS_STAGE": "2", "CROSS_TARGET": "riscv64-linux-gnu", + "FINAL_CROSS_STAGE": "3", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb13-riscv-cross_riscv64-linux-gnu-validate", @@ -7662,8 +7666,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-loongarch64 -L /usr/loongarch64-linux-gnu", - "CROSS_STAGE": "2", "CROSS_TARGET": "loongarch64-linux-gnu", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-ubuntu24_04-loongarch-cross_loongarch64-linux-gnu-validate", ===================================== changelog.d/stage3-cross-bindists ===================================== @@ -0,0 +1,6 @@ +section: packaging +synopsis: Fully cross-compiled binary distributions +mrs: !15417 +issues: #26924 +description: Hadrian can now build cross-compiled binary distributions that run + native on another target architecture (e.g. AArch64 -> RISC-V). ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1158,20 +1158,25 @@ ppDerivStrategy mb = Nothing -> empty Just (L _ ds) -> ppr ds -ppOverlapPragma :: Maybe (LocatedP (OverlapMode (GhcPass p))) -> SDoc +ppOverlapPragma :: forall p. IsPass p => Maybe (LocatedA (OverlapMode (GhcPass p))) -> SDoc ppOverlapPragma mb = case mb of Nothing -> empty - Just (L _ (NoOverlap s)) -> maybe_stext s "{-# NO_OVERLAP #-}" - Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}" - Just (L _ (Overlapping s)) -> maybe_stext s "{-# OVERLAPPING #-}" - Just (L _ (Overlaps s)) -> maybe_stext s "{-# OVERLAPS #-}" - Just (L _ (Incoherent s)) -> maybe_stext s "{-# INCOHERENT #-}" - Just (L _ (NonCanonical s)) -> maybe_stext s "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet + Just (L _ (NoOverlap s)) -> maybe_stext (stext s) "{-# NO_OVERLAP #-}" + Just (L _ (Overlappable s)) -> maybe_stext (stext s) "{-# OVERLAPPABLE #-}" + Just (L _ (Overlapping s)) -> maybe_stext (stext s) "{-# OVERLAPPING #-}" + Just (L _ (Overlaps s)) -> maybe_stext (stext s) "{-# OVERLAPS #-}" + Just (L _ (Incoherent s)) -> maybe_stext (stext s) "{-# INCOHERENT #-}" + Just (L _ (NonCanonical s)) -> maybe_stext (stext s) "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet where maybe_stext NoSourceText alt = text alt maybe_stext (SourceText src) _ = ftext src <+> text "#-}" + stext :: XOverlapMode (GhcPass p) -> SourceText + stext s = case (ghcPass @p, s) of + (GhcPs, (s,_)) -> s + (GhcRn, (s,_)) -> s + (GhcTc, s) -> s instance (OutputableBndrId p) => Outputable (InstDecl (GhcPass p)) where ppr (ClsInstD { cid_inst = decl }) = ppr decl @@ -1578,7 +1583,7 @@ type instance Anno (FunDep (GhcPass p)) = SrcSpanAnnA type instance Anno (FamilyResultSig (GhcPass p)) = EpAnnCO type instance Anno (FamilyDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (InjectivityAnn (GhcPass p)) = EpAnnCO -type instance Anno (CType (GhcPass p)) = SrcSpanAnnP +type instance Anno (CType (GhcPass p)) = SrcSpanAnnA type instance Anno (HsDerivingClause (GhcPass p)) = EpAnnCO type instance Anno (DerivClauseTys (GhcPass _)) = SrcSpanAnnA type instance Anno (StandaloneKindSig (GhcPass p)) = SrcSpanAnnA @@ -1593,7 +1598,7 @@ type instance Anno (ClsInstDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (InstDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (DocDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (DerivDecl (GhcPass p)) = SrcSpanAnnA -type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnP +type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnA type instance Anno (DerivStrategy (GhcPass p)) = EpAnnCO type instance Anno (DefaultDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (ForeignDecl (GhcPass p)) = SrcSpanAnnA ===================================== compiler/GHC/Hs/Decls/Overlap.hs ===================================== @@ -26,6 +26,8 @@ import GHC.Prelude import GHC.Hs.Extension +import GHC.Parser.Annotation ( AnnPragma ) + import Language.Haskell.Syntax.Decls.Overlap import Language.Haskell.Syntax.Extension @@ -65,7 +67,9 @@ instance NFData OverlapFlag where instance Outputable OverlapFlag where ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag) -type instance XOverlapMode (GhcPass _) = SourceText +type instance XOverlapMode GhcPs = (SourceText, AnnPragma) +type instance XOverlapMode GhcRn = (SourceText, AnnPragma) +type instance XOverlapMode GhcTc = SourceText type instance XXOverlapMode (GhcPass _) = DataConCantHappen ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1752,7 +1752,7 @@ instance ToHie (RScoped (LocatedAn NoEpAnns (DerivStrategy GhcRn))) where NewtypeStrategy _ -> [] ViaStrategy s -> [ toHie (TS (ResolvedScopes [sc]) s) ] -instance ToHie (LocatedP (OverlapMode GhcRn)) where +instance ToHie (LocatedA (OverlapMode GhcRn)) where toHie (L span _) = locOnly (locA span) instance ToHie (LocatedA (ConDecl GhcRn)) where ===================================== compiler/GHC/Parser.y ===================================== @@ -1471,15 +1471,15 @@ inst_decl :: { LInstDecl GhcPs } (fmap reverse $7) (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok $2) dcolon twhere oc cc NoEpTok)}} -overlap_pragma :: { Maybe (LocatedP (OverlapMode GhcPs)) } - : '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# OVERLAPPING' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# OVERLAPS' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# INCOHERENT' '#-}' {% fmap Just $ amsr (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } +overlap_pragma :: { Maybe (LocatedA (OverlapMode GhcPs)) } + : '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# OVERLAPPING' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# OVERLAPS' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# INCOHERENT' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } | {- empty -} { Nothing } deriv_strategy_no_via :: { LDerivStrategy GhcPs } @@ -1707,15 +1707,17 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs | type { sL1 $1 (Nothing, mkHsOuterImplicit, $1) } -capi_ctype :: { Maybe (LocatedP (CType GhcPs)) } +capi_ctype :: { Maybe (LocatedA (CType GhcPs)) } capi_ctype : '{-# CTYPE' STRING STRING '#-}' - {% fmap Just $ amsr (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $3) (Just (Header (getSTRINGs $2) (getSTRING $2))) - (getSTRING $3))) - (AnnPragma (glR $1) (epTok $4) noAnn (glR $2) (glR $3) noAnn noAnn) } + {% fmap Just $ amsA' (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $3) + (AnnPragma (glR $1) (epTok $4) noAnn (glR $2) (glR $3) noAnn noAnn) + (Just (Header (getSTRINGs $2) (getSTRING $2))) + (getSTRING $3)))} | '{-# CTYPE' STRING '#-}' - {% fmap Just $ amsr (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $2) Nothing (getSTRING $2))) - (AnnPragma (glR $1) (epTok $3) noAnn noAnn (glR $2) noAnn noAnn) } + {% fmap Just $ amsA' (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $2) + (AnnPragma (glR $1) (epTok $3) noAnn noAnn (glR $2) noAnn noAnn) + Nothing (getSTRING $2)))} | { Nothing } ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -229,7 +229,7 @@ mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layout annsIn mkTyData :: SrcSpan -> Bool -> NewOrData - -> Maybe (LocatedP (CType GhcPs)) + -> Maybe (LocatedA (CType GhcPs)) -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs) -> Maybe (LHsKind GhcPs) -> [LConDecl GhcPs] @@ -251,7 +251,7 @@ mkTyData loc' is_type_data new_or_data cType (L _ (mcxt, tycl_hdr)) tcdDataDefn = defn, tcdModifiers = [] })) } -mkDataDefn :: Maybe (LocatedP (CType GhcPs)) +mkDataDefn :: Maybe (LocatedA (CType GhcPs)) -> Maybe (LHsContext GhcPs) -> Maybe (LHsKind GhcPs) -> DataDefnCons (LConDecl GhcPs) @@ -326,7 +326,7 @@ mkTyFamInstEqn loc bndrs lhs rhs annEq mkDataFamInst :: SrcSpan -> NewOrData - -> Maybe (LocatedP (CType GhcPs)) + -> Maybe (LocatedA (CType GhcPs)) -> (Maybe ( LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs , LHsType GhcPs) -> Maybe (LHsKind GhcPs) ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -92,6 +92,7 @@ be ill-typed in Core. But it must still be well-kinded! -} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PatternSynonyms #-} module GHC.Stg.Lint ( lintStgTopBindings ) where @@ -123,6 +124,7 @@ import GHC.Unit.Module ( Module ) import GHC.Data.Bag ( Bag, emptyBag, isEmptyBag, snocBag, bagToList ) import Control.Monad +import GHC.Exts ( oneShot ) import GHC.Core.Multiplicity (scaledThing) import GHC.Settings (Platform) import GHC.Core.TyCon (primRepCompatible, primRepsCompatible) @@ -432,17 +434,40 @@ The Lint monad ************************************************************************ -} -newtype LintM a = LintM - { unLintM :: Module - -> LintFlags - -> DiagOpts -- Diagnostic options - -> StgPprOpts -- Pretty-printing options +data LintReaderEnv = LintReaderEnv + { le_mod :: !Module + , le_flags :: !LintFlags + , le_diag_opts :: !DiagOpts -- Diagnostic options + , le_ppr_opts :: !StgPprOpts -- Pretty-printing options + } + +newtype LintM a = LintM' + { unLintM :: LintReaderEnv -> [LintLocInfo] -- Locations -> IdSet -- Local vars in scope -> Bag SDoc -- Error messages so far -> (a, Bag SDoc) -- Result and error messages (if any) } - deriving (Functor) +instance Functor LintM where + fmap f (LintM m) = + LintM $ \env loc scope errs -> + case m env loc scope errs of + (a, errs') -> (f a, errs') + +-- See Note [The one-shot state monad trick] in GHC.Utils.Monad +{-# COMPLETE LintM #-} +pattern LintM :: (LintReaderEnv + -> [LintLocInfo] + -> IdSet + -> Bag SDoc + -> (a, Bag SDoc)) + -> LintM a +pattern LintM m <- LintM' m + where + LintM m = LintM' $ oneShot (\env -> oneShot + (\loc -> oneShot + (\scope -> oneShot + (\errs -> m env loc scope errs)))) data LintFlags = LintFlags { lf_unarised :: !Bool , lf_platform :: !Platform @@ -473,14 +498,16 @@ pp_binders bs initL :: Platform -> DiagOpts -> Module -> Bool -> StgPprOpts -> IdSet -> LintM a -> Maybe SDoc initL platform diag_opts this_mod unarised opts locals (LintM m) = do - let (_, errs) = m this_mod (LintFlags unarised platform) diag_opts opts [] locals emptyBag + let !flags = LintFlags unarised platform + !env = LintReaderEnv this_mod flags diag_opts opts + (_, errs) = m env [] locals emptyBag if isEmptyBag errs then Nothing else Just (vcat (punctuate blankLine (bagToList errs))) instance Applicative LintM where - pure a = LintM $ \_mod _lf _df _opts _loc _scope errs -> (a, errs) + pure a = LintM $ \_env _loc _scope errs -> (a, errs) (<*>) = ap (*>) = thenL_ @@ -489,14 +516,14 @@ instance Monad LintM where (>>) = (*>) thenL :: LintM a -> (a -> LintM b) -> LintM b -thenL m k = LintM $ \mod lf diag_opts opts loc scope errs - -> case unLintM m mod lf diag_opts opts loc scope errs of - (r, errs') -> unLintM (k r) mod lf diag_opts opts loc scope errs' +thenL m k = LintM $ \env loc scope errs + -> case unLintM m env loc scope errs of + (r, errs') -> unLintM (k r) env loc scope errs' thenL_ :: LintM a -> LintM b -> LintM b -thenL_ m k = LintM $ \mod lf diag_opts opts loc scope errs - -> case unLintM m mod lf diag_opts opts loc scope errs of - (_, errs') -> unLintM k mod lf diag_opts opts loc scope errs' +thenL_ m k = LintM $ \env loc scope errs + -> case unLintM m env loc scope errs of + (_, errs') -> unLintM k env loc scope errs' checkL :: Bool -> SDoc -> LintM () checkL True _ = return () @@ -525,7 +552,8 @@ checkPostUnariseId id id_ty = idType id addErrL :: SDoc -> LintM () -addErrL msg = LintM $ \_mod _lf df _opts loc _scope errs -> ((), addErr df errs msg loc) +addErrL msg = LintM $ \LintReaderEnv{le_diag_opts = df} loc _scope errs + -> ((), addErr df errs msg loc) addErr :: DiagOpts -> Bag SDoc -> SDoc -> [LintLocInfo] -> Bag SDoc addErr diag_opts errs_so_far msg locs @@ -537,23 +565,23 @@ addErr diag_opts errs_so_far msg locs mk_msg [] = msg addLoc :: LintLocInfo -> LintM a -> LintM a -addLoc extra_loc m = LintM $ \mod lf diag_opts opts loc scope errs - -> unLintM m mod lf diag_opts opts (extra_loc:loc) scope errs +addLoc extra_loc m = LintM $ \env loc scope errs + -> unLintM m env (extra_loc:loc) scope errs addInScopeVars :: [Id] -> LintM a -> LintM a -addInScopeVars ids m = LintM $ \mod lf diag_opts opts loc scope errs +addInScopeVars ids m = LintM $ \env loc scope errs -> let new_set = mkVarSet ids - in unLintM m mod lf diag_opts opts loc (scope `unionVarSet` new_set) errs + in unLintM m env loc (scope `unionVarSet` new_set) errs getLintFlags :: LintM LintFlags -getLintFlags = LintM $ \_mod lf _df _opts _loc _scope errs -> (lf, errs) +getLintFlags = LintM $ \LintReaderEnv{le_flags = lf} _loc _scope errs -> (lf, errs) getStgPprOpts :: LintM StgPprOpts -getStgPprOpts = LintM $ \_mod _lf _df opts _loc _scope errs -> (opts, errs) +getStgPprOpts = LintM $ \LintReaderEnv{le_ppr_opts = opts} _loc _scope errs -> (opts, errs) checkInScope :: Id -> LintM () -checkInScope id = LintM $ \mod _lf diag_opts _opts loc scope errs +checkInScope id = LintM $ \LintReaderEnv{le_mod = mod, le_diag_opts = diag_opts} loc scope errs -> if nameIsLocalOrFrom mod (idName id) && not (id `elemVarSet` scope) then ((), addErr diag_opts errs (hsep [ppr id, dcolon, ppr (idType id), text "is out of scope"]) loc) ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -11,7 +11,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | Handles @deriving@ clauses on @data@ declarations. -module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..) ) where +module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..), tcOverlapMode ) where import GHC.Prelude @@ -776,12 +776,12 @@ deriveStandalone (L loc (DerivDecl (warn, _) deriv_ty mb_lderiv_strat overlap_mo tcOverlapMode :: OverlapMode GhcRn -> OverlapMode GhcTc tcOverlapMode = \case - NoOverlap s -> NoOverlap s - Overlappable s -> Overlappable s - Overlapping s -> Overlapping s - Overlaps s -> Overlaps s - Incoherent s -> Incoherent s - NonCanonical s -> NonCanonical s + NoOverlap s -> NoOverlap (fst s) + Overlappable s -> Overlappable (fst s) + Overlapping s -> Overlapping (fst s) + Overlaps s -> Overlaps (fst s) + Incoherent s -> Incoherent (fst s) + NonCanonical s -> NonCanonical (fst s) -- Typecheck the type in a standalone deriving declaration. -- ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -558,7 +558,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty -- Dfun location is that of instance *header* ; let warn = fmap unLoc lwarn - ; ispec <- newClsInst (fmap unLoc overlap_mode) dfun_name + ; ispec <- newClsInst (fmap (tcOverlapMode . unLoc) overlap_mode) dfun_name tyvars theta clas inst_tys warn ; let inst_binds = InstBindings ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -72,7 +72,6 @@ import GHC.Rename.Utils( mkRnSyntaxExpr ) import GHC.Types.Id.Make( mkDictFunId ) import GHC.Types.Arity ( Arity, VisArity ) import GHC.Types.Basic ( TypeOrKind(..) ) -import GHC.Types.SourceText import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var.Env import GHC.Types.Id @@ -912,7 +911,7 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity ************************************************************************ -} -getOverlapFlag :: Maybe (OverlapMode (GhcPass p)) -- User pragma if any +getOverlapFlag :: Maybe (OverlapMode GhcTc) -- User pragma if any -> TcM OverlapFlag -- Construct the OverlapFlag from the global module flags, -- but if the overlap_mode argument is (Just m), @@ -936,9 +935,9 @@ getOverlapFlag overlap_mode_prag overlap_mode | Just m <- overlap_mode_prag = m - | incoherent_ok = Incoherent NoSourceText - | overlap_ok = Overlaps NoSourceText - | otherwise = NoOverlap NoSourceText + | incoherent_ok = Incoherent noAnn + | overlap_ok = Overlaps noAnn + | otherwise = NoOverlap noAnn -- final_overlap_mode: the `-fspecialise-incoherents` flag controls the -- meaning of the `Incoherent` overlap mode: as either an Incoherent overlap @@ -964,7 +963,7 @@ tcGetInsts :: TcM [ClsInst] -- Gets the local class instances. tcGetInsts = fmap tcg_insts getGblEnv -newClsInst :: Maybe (OverlapMode (GhcPass p)) -- User pragma +newClsInst :: Maybe (OverlapMode GhcTc) -- User pragma -> Name -> [TyVar] -> ThetaType -> Class -> [Type] -> Maybe (WarningTxt GhcRn) -> TcM ClsInst newClsInst overlap_mode dfun_name tvs theta clas tys warn ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -356,10 +356,10 @@ cvtDec (InstanceD o ctxt ty decs) where overlap pragma = case pragma of - TH.Overlaps -> Hs.Overlaps (SourceText $ fsLit "{-# OVERLAPS") - TH.Overlappable -> Hs.Overlappable (SourceText $ fsLit "{-# OVERLAPPABLE") - TH.Overlapping -> Hs.Overlapping (SourceText $ fsLit "{-# OVERLAPPING") - TH.Incoherent -> Hs.Incoherent (SourceText $ fsLit "{-# INCOHERENT") + TH.Overlaps -> Hs.Overlaps (SourceText $ fsLit "{-# OVERLAPS", noAnn) + TH.Overlappable -> Hs.Overlappable (SourceText $ fsLit "{-# OVERLAPPABLE", noAnn) + TH.Overlapping -> Hs.Overlapping (SourceText $ fsLit "{-# OVERLAPPING", noAnn) + TH.Incoherent -> Hs.Incoherent (SourceText $ fsLit "{-# INCOHERENT", noAnn) ===================================== compiler/GHC/Types/ForeignCall.hs ===================================== @@ -109,6 +109,7 @@ import Data.Data (Data) import Data.Functor ((<&>)) import Control.DeepSeq (NFData(..)) +import GHC.Parser.Annotation (AnnPragma, noAnn) {- ************************************************************************ @@ -213,11 +214,11 @@ instance Outputable CCallSpec where defaultCType :: String -> CType (GhcPass p) defaultCType = - CType (CTypeGhc NoSourceText NoSourceText) Nothing . packHText + CType (CTypeGhc NoSourceText NoSourceText noAnn) Nothing . packHText -mkCType :: SourceText -> SourceText -> Maybe (Header (GhcPass p)) -> HText -> CType (GhcPass p) -mkCType x y m = - CType (CTypeGhc x y) m +mkCType :: SourceText -> SourceText -> AnnPragma -> Maybe (Header (GhcPass p)) -> HText -> CType (GhcPass p) +mkCType x y ann m = + CType (CTypeGhc x y ann) m typeCheckCType :: CType GhcRn -> CType GhcTc typeCheckCType (CType x y z) = CType x (typeCheckHeader <$> y) z @@ -302,6 +303,7 @@ data StaticTargetGhc = StaticTargetGhc data CTypeGhc = CTypeGhc { cTypeSourceText :: SourceText , cTypeOtherText :: SourceText + , cTypeAnn :: AnnPragma } deriving (Data, Eq) @@ -349,6 +351,7 @@ instance Binary CTypeGhc where return $ CTypeGhc { cTypeSourceText = str1 , cTypeOtherText = str2 + , cTypeAnn = noAnn } instance NFData StaticTargetGhc where ===================================== distrib/configure.ac.in ===================================== @@ -9,7 +9,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [@ProjectVersion@], [ dnl See /configure.ac for rationale. AC_PREREQ([2.69]) -AC_CONFIG_MACRO_DIRS([../m4]) +AC_CONFIG_MACRO_DIRS([m4]) dnl-------------------------------------------------------------------- dnl * Deal with arguments telling us gmp is somewhere odd ===================================== docs/users_guide/using.rst ===================================== @@ -58,9 +58,10 @@ Windows. Options overview ---------------- -GHC's behaviour is controlled by options, which for historical reasons -are also sometimes referred to as command-line flags or arguments. -Options can be specified in three ways: +GHC's behaviour is controlled by options. Options can be specified in four ways: +(1) directly on the command line; (2) via files (response files); (3) in source +files, using a pragma; and (4) when using GHCi, from within GHCi. + Command-line arguments ~~~~~~~~~~~~~~~~~~~~~~ @@ -76,7 +77,8 @@ An invocation of GHC takes the following form: ghc [argument...] -Command-line arguments are either options or file names. +Command-line arguments are either options, file names or response file arguments +(see further below). Command-line options begin with ``-``. They may *not* be grouped: ``-vO`` is different from ``-v -O``. Options need not precede filenames: @@ -111,16 +113,47 @@ to the files ``Foo.hs`` and ``Bar.hs``. Command-line arguments in response files ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In addition to passing arguments via the command-line, arguments can be passed -via GNU-style response files. For instance, +GHC's use of response files is similar to that of GCC. A response file argument +is ``@`` followed immediately by the absolute or relative path identifying the +response file. + +.. note:: + + In PowerShell, ``@`` is used to identify a splatting variable. Consequently, + GHC response file arguments must be enclosed in quotation marks on the + command line to avoid parsing errors. + +A response file argument is equivalent to the command-line arguments in the +response file in the order that they appear in the file. A response file can +include a response file argument. + +In a response file: + +* any unescaped whitespace is assumed to separate command-line arguments and is + otherwise ignored; +* a backslash character (``\``) always escapes the following character; and +* matching pairs of unescaped single quote (``'``) or double quote (``"``) + characters escape blocks of characters. + +For example, .. code-block:: bash - $ cat response-file + $ cat response-file1 -O1 + @response-file2 + + $ cat response-file2 Hello.hs -o Hello - $ ghc @response-file + + $ ghc @response-file1 + +is equivalent to, + +.. code-block:: bash + + $ ghc -O1 Hello.hs -o Hello .. _source-file-options: ===================================== hadrian/src/BindistConfig.hs ===================================== @@ -24,6 +24,10 @@ crossBindist = BindistConfig { library_stage = Stage2, executable_stage = Stage1 targetBindist :: BindistConfig targetBindist = BindistConfig { library_stage = Stage2, executable_stage = Stage2 } +-- | Folder relative to build root ("bindist" or "bindist-stage3") +bindistFolder :: BindistConfig -> FilePath +bindistFolder conf | executable_stage conf == Stage2 = "bindist-stage3" +bindistFolder _conf = "bindist" -- | The implicit bindist config, if we don't know any better. implicitBindistConfig :: Action BindistConfig ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -6,7 +6,6 @@ import Context import Data.Either import qualified Data.Set as Set import Expression -import Hadrian.Oracles.Path (fixUnixPathsOnWindows) import Oracles.Flavour import Oracles.Setting import Packages @@ -14,66 +13,89 @@ import Rules.Generate (generateSettings) import Settings import qualified System.Directory.Extra as IO import Settings.Program (programContext) -import Target -import Utilities import BindistConfig {- Note [Binary distributions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Hadrian produces binary distributions under: +Hadrian produces binary distributions that run on the build host architecture +(build == host, target == host || target /= host) under: <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>.tar.xz -It is generated by creating an archive from: - <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/ +For stage3 (build /= host, host == target) bindists, a separate parent folder +is used: + <build root>/bindist-stage3/ghc-<X>.<Y>.<Z>-<arch>-<os>.tar.xz -It does so by following the steps below. +While regular bindists are usual same-arch compilers or cross-compilers, stage3 +bindists are cross-compiled compilers. -- make sure we have a complete stage 2 compiler + haddock +Bindists are generated by creating an archive from: + <build root>/<bindist|bindist-stage3>/ghc-<X>.<Y>.<Z>-<arch>-<os>/ + +Stage2 cross-compilers are a by-product of creating stage3 cross-compiled +compilers. The additional build dir (bindist-stage3) lets us keep both, such +that we can build them in one go on CI. +Configuration files (e.g. configure script and default.host.target) differ in +this case and keeping both targets separated also saves us some headache +dealing with stale files. + +This table introduces variables to simplify the following step descriptions: + +| compiler kind | <bindist-dir> | <executable-stage-dir> | <library-stage-dir> | +|------------------|----------------|------------------------|---------------------| +| native | bindist | stage1/ | stage1/ | +| cross-compiler | bindist | stage1/ | stage2/ | +| cross-compiled | bindist-stage3 | stage2/ | stage2/ | + +These are the steps to build a bindist: + +- make sure we have a complete compiler + libraries + haddock for the stage(s) + to bundle - copy the specific binaries which should be in the bindist to the bin folder and add the version suffix: - <build root>/stage1/bin/xxxx + <build root>/<executable-stage-dir>/bin/xxxx to - <build root/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/bin/xxxx-<VER> + <build root>/<bindist-dir>/ghc-<X>.<Y>.<Z>-<arch>-<os>/bin/[<target>-]xxxx-<VER> + where the optional <target>- prefix is the cross triple for cross-compilers. - create symlink (or bash) wrapper from unversioned to versioned executable: - <build root/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/bin/xxxx + <build root>/<bindist-dir>/ghc-<X>.<Y>.<Z>-<arch>-<os>/bin/[<target>-]xxxx points to: - <build root/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/bin/xxxx-<VER> + <build root>/<bindist-dir>/ghc-<X>.<Y>.<Z>-<arch>-<os>/bin/[<target>-]xxxx-<VER> - copy the lib directories of the compiler we built: - <build root>/stage1/lib + <build root>/<library-stage-dir>/lib to - <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/lib + <build root>/<bindist-dir>/ghc-<X>.<Y>.<Z>-<arch>-<os>/lib - copy the generated docs (user guide, haddocks, etc): - <build root>/docs/ + <build root>/doc/ to - <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/docs/ + <build root>/<bindist-dir>/ghc-<X>.<Y>.<Z>-<arch>-<os>/doc/ -- use autoreconf to generate a `configure` script from - aclocal.m4 and distrib/configure.ac, that we move to: - <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/configure +- use autoreconf to generate a staged `configure` script in + <build root>/<executable-stage>/distrib + that we move to: + <build root>/<bindist-dir>/ghc-<X>.<Y>.<Z>-<arch>-<os>/configure - write a (fixed) Makefile capable of supporting 'make install' to: - <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/Makefile + <build root>/<bindist-dir>/ghc-<X>.<Y>.<Z>-<arch>-<os>/Makefile - write some (fixed) supporting bash code for the wrapper scripts to: - <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/wrappers/<program> + <build root>/<bindist-dir>/ghc-<X>.<Y>.<Z>-<arch>-<os>/wrappers/<program> where <program> is the name of the executable that the bash file will help wrapping. -- copy supporting configure/make related files - (see @bindistInstallFiles@) to: - <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/<file> +- copy supporting configure/make related files (see @bindistInstallFiles@) to: + <build root>/<bindist-dir>/ghc-<X>.<Y>.<Z>-<arch>-<os>/<file> - create a .tar.xz archive of the directory: - <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/ + <build root>/<bindist-dir>/ghc-<X>.<Y>.<Z>-<arch>-<os>/ at - <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>.tar.xz + <build root>/<bindist-dir>/ghc-<X>.<Y>.<Z>-<arch>-<os>.tar.xz Note [Wrapper scripts and binary distributions] @@ -160,12 +182,12 @@ buildBinDistDir root conf@BindistConfig{..} = do distDir <- Context.distDir (vanillaContext library_stage rts) let ghcBuildDir = root -/- stageString library_stage - bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty + bindistFilesDir = root -/- bindistFolder conf -/- ghcVersionPretty ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform rtsIncludeDir = distDir -/- "include" - -- We create the bindist directory at <root>/bindist/ghc-X.Y.Z-platform/ - -- and populate it with Stage2 build results + -- We create the bindist directory at <root>/<bindistFolder>/ghc-X.Y.Z-platform/ + -- and populate it with build results createDirectory bindistFilesDir createDirectory (bindistFilesDir -/- "bin") createDirectory (bindistFilesDir -/- "lib") @@ -231,9 +253,9 @@ buildBinDistDir root conf@BindistConfig{..} = do -- relocatable. The package DB is always at "package.conf.d" relative to -- the lib dir, matching the known bindist layout. let bindistSettings = bindistFilesDir -/- "lib" -/- "settings" - bindistContext = vanillaContext library_stage compiler + bindistContext = vanillaContext executable_stage compiler bindistSettingsContent <- interpretInContext bindistContext $ - generateSettings bindistSettings False "package.conf.d" + generateSettings bindistSettings False "package.conf.d" library_stage writeFileAtomic bindistSettings bindistSettingsContent copyDirectory rtsIncludeDir bindistFilesDir @@ -245,10 +267,14 @@ buildBinDistDir root conf@BindistConfig{..} = do -- -- N.B. the ghc-pkg executable may be prefixed with a target triple -- (c.f. #20267). - - -- Not going to work for cross - ghcPkgName <- programName (vanillaContext Stage1 ghcPkg) - cmd_ (bindistFilesDir -/- "bin" -/- ghcPkgName) ["recache", "--package-db", bindistFilesDir -/- "lib" -/- "package.conf.d" ] + -- Recache using the stage1 ghc-pkg executable. This is the unprefixed + -- host ghc-pkg for native bindists and the target-triple-prefixed cross + -- ghc-pkg for cross bindists; both run on the build host and can handle + -- the target package database. The stage3 bindist's package DB is also + -- built by the stage1 cross compiler, so stage1 ghc-pkg is correct there + -- too. + ghcPkgPath <- programPath =<< programContext Stage1 ghcPkg + cmd_ ghcPkgPath ["recache", "--package-db", bindistFilesDir -/- "lib" -/- "package.conf.d" ] need ["docs"] @@ -344,8 +370,7 @@ bindistRules = do buildBinDistDir root cfg phony "binary-dist-dir-cross" $ buildBinDistDir root crossBindist - -- MP: Not working yet - -- phony "binary-dist-dir-stage3" $ buildBinDistDir root targetBindist + phony "binary-dist-dir-stage3" $ buildBinDistDir root targetBindist let buildBinDist compressor = do win_host <- isWinHost @@ -377,54 +402,27 @@ bindistRules = do phony (name <> "-dist-xz") $ mk_bindist Xz phony "binary-dist-cross" $ buildBinDistX "binary-dist-dir-cross" "bindist" Xz - phony "binary-dist-stage3" $ buildBinDistX "binary-dist-dir-stage3" "bindist" Xz - - -- Prepare binary distribution configure script - -- (generated under <ghc root>/distrib/configure by 'autoreconf') - root -/- "bindist" -/- "ghc-*" -/- "configure" %> \configurePath -> do - need ["distrib" -/- "configure.ac"] - ghcRoot <- topDirectory - copyFile (ghcRoot -/- "aclocal.m4") (ghcRoot -/- "distrib" -/- "aclocal.m4") - copyDirectory (ghcRoot -/- "m4") (ghcRoot -/- "distrib") - - -- Note [Autoreconf unix paths from ACLOCAL_PATH] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- On Windows, autoreconf fails when the ACLOCAL_PATH env variable contains Windows- - -- style paths. This happens because MSYS2 automatically converts env variables to - -- Windows-style paths. To fix this, we convert ACLOCAL_PATH back to Unix style. - -- This is done both in the boot Python script and here when building a bindist. - win_host <- isWinHost - env <- if not win_host - then pure [] - else do - aclocalPathMay <- getEnv "ACLOCAL_PATH" - case aclocalPathMay of - Nothing -> pure [] - Just aclocalPath -> do - unixAclocalPath <- fixUnixPathsOnWindows aclocalPath - pure [AddEnv "ACLOCAL_PATH" unixAclocalPath] - - buildWithCmdOptions env $ - target (vanillaContext Stage1 ghc) (Autoreconf $ ghcRoot -/- "distrib") [] [] - -- We clean after ourselves, moving the configure script we generated in - -- our bindist dir - removeFile (ghcRoot -/- "distrib" -/- "aclocal.m4") - removeDirectory (ghcRoot -/- "distrib" -/- "m4") - - moveFile (ghcRoot -/- "distrib" -/- "configure") configurePath - - -- Generate the Makefile that enables the "make install" part - root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> do - top <- topDirectory - copyFile (top -/- "hadrian" -/- "bindist" -/- "Makefile") makefilePath - - -- Copy various configure-related files needed for a working - -- './configure [...] && make install' workflow - -- (see the list of files needed in the 'binary-dist' rule above, before - -- creating the archive). - forM_ bindistInstallFiles $ \file -> - root -/- "bindist" -/- "ghc-*" -/- file %> \dest -> do - copyFile (fixup file) dest + phony "binary-dist-stage3" $ buildBinDistX "binary-dist-dir-stage3" "bindist-stage3" Xz + + forM_ [normalBindist, targetBindist] $ \bindistCfg -> do + let bindistFolderName = bindistFolder bindistCfg + root -/- bindistFolderName -/- "ghc-*" -/- "configure" %> \configurePath -> do + let distribConfigure = root -/- stageString (executable_stage bindistCfg) -/- "distrib" -/- "configure" + need [distribConfigure] + copyFile distribConfigure configurePath + + -- Generate the Makefile that enables the "make install" part + root -/- bindistFolderName -/- "ghc-*" -/- "Makefile" %> \makefilePath -> do + top <- topDirectory + copyFile (top -/- "hadrian" -/- "bindist" -/- "Makefile") makefilePath + + -- Copy various configure-related files needed for a working + -- './configure [...] && make install' workflow + -- (see the list of files needed in the 'binary-dist' rule above, before + -- creating the archive). + forM_ bindistInstallFiles $ \file -> + root -/- bindistFolderName -/- "ghc-*" -/- file %> \dest -> do + copyFile (fixup file) dest where fixup f | f `elem` ["INSTALL", "README"] = "distrib" -/- f @@ -504,7 +502,7 @@ pkgToWrappers stage pkg = do -- These are the packages which we want to expose to the user and hence -- there are wrappers installed in the bindist. | pkg `elem` [hpcBin, haddock, hp2ps, hsc2hs, ghc, ghcPkg] - -> (:[]) <$> (programName =<< programContext Stage1 pkg) + -> (:[]) <$> (programName =<< programContext stage pkg) | otherwise -> pure [] wrapper :: Stage -> FilePath -> Action String @@ -557,7 +555,7 @@ ghciScriptWrapper stage = do -- | Create a wrapper script calls the executable given as first argument createVersionWrapper :: Stage -> Package -> String -> FilePath -> Action () createVersionWrapper executable_stage pkg versioned_exe install_path = do - ghcPath <- builderPath (Ghc CompileCWithGhc (succStage executable_stage)) + ghcPath <- builderPath (Ghc CompileCWithGhc executable_stage) top <- topDirectory let version_wrapper_dir = top -/- "hadrian" -/- "bindist" -/- "cwrappers" wrapper_files = [ version_wrapper_dir -/- file | file <- ["version-wrapper.c", "getLocation.c", "cwrapper.c"]] ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -9,6 +9,7 @@ import qualified Data.Set as Set import Base import qualified Context import Expression +import Hadrian.Oracles.Path (fixUnixPathsOnWindows) import Hadrian.Oracles.TextFile (lookupStageBuildConfig) import Oracles.Flag hiding (arSupportsAtFile, arSupportsDashL) import Oracles.ModuleFiles @@ -251,32 +252,51 @@ generateRules = do (root -/- "ghc-stage2") <~+ ghcWrapper Stage2 (root -/- "ghc-stage3") <~+ ghcWrapper Stage3 - forM_ allStages $ \stage -> do - let prefix = root -/- stageString stage -/- "lib" - -- For the finalStage, we generate settings for that stage. For - -- others we look at the next stage. Why? Because cross-compilers - -- require libs from the successor stage, otherwise they are - -- compiled for the host and not the target. - stage' = if stage /= finalStage then succStage stage else stage - go gen file = generate file (semiEmptyTarget stage') gen + forM_ allStages $ \buildStage -> do + let -- Two stages are in play per rule iteration: + -- + -- * @buildStage@ — loop variable; the settings file is written + -- into @_build/<buildStage>/lib/settings@ and + -- describes the compiler at @compilerStage@. + -- * @compilerStage@ — the stage whose @bin/@ holds the compiler + -- the settings file describes; also the + -- ambient 'Expr' stage passed to + -- 'generateSettings' (via 'semiEmptyTarget'), + -- so it is the value of @executableStage@ + -- inside that function. + -- + -- For a cross-compiler the libs it links against live in the + -- /successor/ stage's lib dir; @libraryStage@ (computed in the + -- rule body below) is that successor. @compilerStage@ normally + -- equals @buildStage@, but at @finalStage@ there is no successor + -- to hold its libs, so @compilerStage@ drops to the predecessor + -- (the final stage's lib dir merely hosts the predecessor + -- cross-compiler's target-arch libs). + compilerStage = if buildStage == finalStage + then predStage buildStage + else buildStage + prefix = root -/- stageString buildStage -/- "lib" + go gen file = generate file (semiEmptyTarget compilerStage) gen (prefix -/- "settings") %> \out -> do - let get_pkg_db stg = packageDbPath (PackageDbLoc stg Final) - -- For cross, LibDir points to stage' lib dir, so pkgDb must also - -- be relative to stage' lib dir. - isCross <- crossStage stage - let libStage = case stage of + -- Stage0 has no library or package DB of its own (the + -- bootstrapping compiler uses Stage1's); for any other stage the + -- package DB lives where the LibDir redirect points (this stage's + -- own lib dir, or the successor's when @buildStage@ is a cross + -- stage). + isCross <- crossStage buildStage + let libraryStage = case buildStage of Stage0 {} -> Stage1 - _ -> if isCross then stage' else stage - pkgDb <- get_pkg_db libStage + _ -> if isCross then succStage buildStage else buildStage + pkgDb <- packageDbPath (PackageDbLoc libraryStage Final) -- addTrailingPathSeparator needed: makeRelativeNoSysLink uses -- splitPath where "lib" and "lib/" are distinct components. let libTopDir = addTrailingPathSeparator $ - if isCross - then root -/- stageString stage' -/- "lib" - else prefix + if isStage0 buildStage + then prefix + else root -/- stageString libraryStage -/- "lib" relPkgDb = makeRelativeNoSysLink libTopDir pkgDb - go (generateSettings out True relPkgDb) out - (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr (targetStage (succStage stage))) out + go (generateSettings out True relPkgDb libraryStage) out + (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr (targetStage (succStage buildStage))) out where file <~+ gen = file %> \out -> generate out emptyTarget gen >> makeExecutable out @@ -410,6 +430,7 @@ templateRules = do bindistRules :: Rules () bindistRules = do + root <- buildRootRules templateRule ("mk" -/- "project.mk") $ mconcat [ interpolateSetting "ProjectName" ProjectName , interpolateSetting "ProjectVersion" ProjectVersion @@ -421,43 +442,126 @@ bindistRules = do , interpolateVar "HostOS_CPP" $ fmap cppify $ interp $ queryHost queryOS - , interpolateVar "TargetPlatform" $ getTarget targetPlatformTriple - , interpolateVar "TargetPlatform_CPP" $ cppify <$> getTarget targetPlatformTriple - , interpolateVar "TargetArch_CPP" $ cppify <$> getTarget queryArch - , interpolateVar "TargetOS_CPP" $ cppify <$> getTarget queryOS - , interpolateVar "LLVMTarget" $ getTarget tgtLlvmTarget - ] - templateRule ("distrib" -/- "configure.ac") $ mconcat - [ interpolateSetting "ConfiguredEmsdkVersion" EmsdkVersion - , interpolateVar "CrossCompilePrefix" $ do - crossCompiling <- interp $ getFlag CrossCompiling - tpf <- setting TargetPlatformFull - pure $ if crossCompiling then tpf <> "-" else "" - , interpolateVar "LeadingUnderscore" $ yesNo <$> getTarget tgtSymbolsHaveLeadingUnderscore - , interpolateSetting "LlvmMaxVersion" LlvmMaxVersion - , interpolateSetting "LlvmMinVersion" LlvmMinVersion - , interpolateVar "LlvmTarget" $ getTarget tgtLlvmTarget - , interpolateSetting "ProjectVersion" ProjectVersion - , interpolateVar "EnableDistroToolchain" $ interp (staged (lookupStageBuildConfig "settings-use-distro-mingw")) - , interpolateVar "TablesNextToCode" $ yesNo <$> getTarget tgtTablesNextToCode - , interpolateVar "TargetHasLibm" $ yesNo <$> getTarget tgtHasLibm - , interpolateVar "TargetPlatform" $ getTarget targetPlatformTriple - , interpolateVar "BuildPlatform" $ interp $ queryBuild targetPlatformTriple - , interpolateVar "HostPlatform" $ interp $ queryHost targetPlatformTriple - , interpolateVar "TargetWordBigEndian" $ getTarget isBigEndian - , interpolateVar "TargetWordSize" $ getTarget wordSize - , interpolateVar "Unregisterised" $ yesNo <$> getTarget tgtUnregisterised - , interpolateVar "UseLibdw" $ fmap yesNo $ interp $ staged (fmap (isJust . tgtRTSWithLibdw) . targetStage) - , interpolateVar "UseLibffiForAdjustors" $ yesNo <$> getTarget tgtUseLibffiForAdjustors - , interpolateVar "BaseUnitId" $ pkgUnitId Stage1 base - , interpolateVar "GhcWithSMP" $ yesNo <$> targetSupportsSMP Stage2 - , interpolateVar "TargetPlatformFull" (setting TargetPlatformFull) - , interpolateVar "BuildPlatformFull" (setting BuildPlatformFull) - , interpolateVar "HostPlatformFull" (setting HostPlatformFull) + -- Stage2 always targets the final architecture. Thus, we can use a + -- constant stage here. + , interpolateVar "TargetPlatform" $ getTarget Stage2 targetPlatformTriple + , interpolateVar "TargetPlatform_CPP" $ cppify <$> getTarget Stage2 targetPlatformTriple + , interpolateVar "TargetArch_CPP" $ cppify <$> getTarget Stage2 queryArch + , interpolateVar "TargetOS_CPP" $ cppify <$> getTarget Stage2 queryOS + , interpolateVar "LLVMTarget" $ getTarget Stage2 tgtLlvmTarget ] + forM_ [Stage1, Stage2] $ \stage -> + let crossStageInterps = Interpolations $ do + isCrossStage <- crossStage stage + targetPlatform <- setting TargetPlatformFull + -- For cross-compiled compilers we need to pretend that they were + -- build on the target. For regular commpilers we can assume that: + -- build == host == target + buildPlatform <- + if isCrossStage + then + interp $ queryBuild targetPlatformTriple + else getTarget stage targetPlatformTriple + hostPlatform <- + if isCrossStage + then + interp $ queryHost targetPlatformTriple + else getTarget stage targetPlatformTriple + baseUnitId <- pkgUnitId (if isCrossStage then succStage stage else stage) base + buildPlatformFull <- if isCrossStage then setting BuildPlatformFull else setting TargetPlatformFull + hostPlatformFull <- if isCrossStage then setting HostPlatformFull else setting TargetPlatformFull + pure + [ ("CrossCompilePrefix", if isCrossStage then targetPlatform <> "-" else "") + , ("TargetPlatformFull", targetPlatform) + , ("BuildPlatform", buildPlatform) + , ("HostPlatform", hostPlatform) + , ("BaseUnitId", baseUnitId) + , ("BuildPlatformFull", buildPlatformFull) + , ("HostPlatformFull", hostPlatformFull) + ] + in templateRuleFrom + ("distrib" -/- "configure.ac" <.> "in") + (root -/- stageString stage -/- "distrib" -/- "configure.ac") + $ mconcat + [ interpolateSetting "ConfiguredEmsdkVersion" EmsdkVersion + , interpolateVar "LeadingUnderscore" $ yesNo <$> getLibTarget stage tgtSymbolsHaveLeadingUnderscore + , interpolateSetting "LlvmMaxVersion" LlvmMaxVersion + , interpolateSetting "LlvmMinVersion" LlvmMinVersion + , interpolateVar "LlvmTarget" $ getLibTarget stage tgtLlvmTarget + , interpolateSetting "ProjectVersion" ProjectVersion + , interpolateVar "EnableDistroToolchain" $ interp (staged (lookupStageBuildConfig "settings-use-distro-mingw")) + , interpolateVar "TablesNextToCode" $ yesNo <$> getLibTarget stage tgtTablesNextToCode + , interpolateVar "TargetHasLibm" $ yesNo <$> getLibTarget stage tgtHasLibm + , interpolateVar "TargetPlatform" $ getLibTarget stage targetPlatformTriple + , interpolateVar "TargetWordBigEndian" $ getLibTarget stage isBigEndian + , interpolateVar "TargetWordSize" $ getLibTarget stage wordSize + , interpolateVar "Unregisterised" $ yesNo <$> getLibTarget stage tgtUnregisterised + , interpolateVar "UseLibdw" $ yesNo <$> getLibTarget stage (isJust . tgtRTSWithLibdw) + , interpolateVar "UseLibffiForAdjustors" $ yesNo <$> getLibTarget stage tgtUseLibffiForAdjustors + , interpolateVar "GhcWithSMP" $ yesNo <$> libStageSupportsSMP stage + , crossStageInterps + ] + + -- We can build two kinds of bindists: Regular Stage2 (including + -- cross-compilers) and fully cross-compiled Stage3. To avoid + -- race-conditions, stale files, etc. build the `configure` scripts as part + -- of the stage's _build files. This requires copying several files such that + -- they are available to the autoconf run. + forM_ [Stage1, Stage2] $ \stage -> do + let distribDir = root -/- stageString stage -/- "distrib" + + distribDir -/- "aclocal.m4" %> \out -> do + top <- topDirectory + copyFile (top -/- "aclocal.m4") out + + forM_ ["config.sub", "config.guess", "install-sh"] $ \f -> + distribDir -/- f %> \out -> do + top <- topDirectory + copyFile (top -/- f) out + + distribDir -/- "m4/*.m4" %> \out -> do + top <- topDirectory + copyFile (top -/- "m4" -/- takeFileName out) out + + distribDir -/- "configure" %> \_ -> do + top <- topDirectory + m4Files <- getDirectoryFiles (top -/- "m4") ["*.m4"] + need $ [ distribDir -/- "configure.ac" + , distribDir -/- "config.sub" + , distribDir -/- "config.guess" + , distribDir -/- "install-sh" + , distribDir -/- "aclocal.m4" + ] + ++ [ distribDir -/- "m4" -/- takeFileName f | f <- m4Files ] + + -- Note [Autoreconf unix paths from ACLOCAL_PATH] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + -- On Windows, autoreconf fails when the ACLOCAL_PATH env variable + -- contains Windows-style paths. MSYS2 auto-converts env vars to + -- Windows-style, so we convert ACLOCAL_PATH back to Unix style here. + win_host <- isWinHost + env <- if not win_host + then pure [] + else do + aclocalPathMay <- getEnv "ACLOCAL_PATH" + case aclocalPathMay of + Nothing -> pure [] + Just aclocalPath -> do + unixAclocalPath <- fixUnixPathsOnWindows aclocalPath + pure [AddEnv "ACLOCAL_PATH" unixAclocalPath] + + buildWithCmdOptions env $ + target (vanillaContext stage ghc) (Autoreconf distribDir) [] [] where interp = interpretInContext (semiEmptyTarget Stage2) - getTarget = interp . queryTarget Stage2 + getTarget stage = interp . queryTarget stage + getLibTarget executableStage f = do + isCross <- crossStage executableStage + getTarget (if isCross then succStage executableStage else executableStage) f + -- | 'targetSupportsSMP' lifted to the library stage (see 'getLibTarget'). + libStageSupportsSMP stage = do + isCross <- crossStage stage + targetSupportsSMP (if isCross then succStage stage else stage) -- | Given a 'String' replace characters '.' and '-' by underscores ('_') so that -- the resulting 'String' is a valid C preprocessor identifier. @@ -479,42 +583,40 @@ ghcWrapper stage = do -- | Generate settings file, optionally including @LibDir@. -- +-- Describes the compiler whose stage is the ambient 'Expr' context +-- (available here as @executableStage@ via 'getStage'). The @libraryStage@ +-- argument is the stage whose lib dir holds the libraries the described +-- compiler links against — used both for the @base@ unit-id lookup and for +-- the @LibDir@ entry. It usually equals @executableStage@ but differs when +-- the compiler links against libraries from a different stage (cross +-- compilers, or the Stage0 bootstrap compiler using Stage1's libraries). +-- -- @rel_pkg_db@: package DB path relative to the lib dir (e.g. -- "package.conf.d"). Callers supply the correct relative path. For bindists --- the layout is known statically; for in-tree builds callers compute it. For --- bindists, we omit @LibDir@ so it defaults to @topDir@ at runtime. -generateSettings :: FilePath -> Bool -> FilePath -> Expr String -generateSettings settingsFile includeLibDir rel_pkg_db = do +-- the layout is known statically; for in-tree builds callers compute it. +-- For bindists, we omit @LibDir@ so it defaults to @topDir@ at runtime. +generateSettings :: FilePath -> Bool -> FilePath -> Stage -> Expr String +generateSettings settingsFile includeLibDir rel_pkg_db libraryStage = do ctx <- getContext - stage <- getStage + executableStage <- getStage + + base_unit_id <- expr $ pkgUnitId libraryStage base - -- The unit-id of the base package which is always linked against (#25382) - base_unit_id <- expr $ do - case stage of - Stage0 {} -> error "Unable to generate settings for stage0" - Stage1 -> pkgUnitId Stage1 base - Stage2 -> pkgUnitId Stage1 base - Stage3 -> pkgUnitId Stage2 base - - -- For cross compilers, LibDir points to the succeeding stage's lib dir - -- (which contains the target architecture's libraries). For non-cross, - -- it points to the preceding stage's lib dir as usual. - let compilerStage = predStage stage -- the GHC that builds packages in this stage - isCrossLibDir <- expr $ crossStage compilerStage - let stage_dir_stage = if isCrossLibDir then stage else compilerStage - - -- addTrailingPathSeparator is needed because makeRelativeNoSysLink uses - -- splitPath internally, where "lib" and "lib/" are distinct components. - lib_topDir :: FilePath <- expr $ addTrailingPathSeparator <$> stageLibPath stage_dir_stage + lib_topDir :: FilePath <- expr $ addTrailingPathSeparator <$> stageLibPath libraryStage let rel_lib_topDir = makeRelativeNoSysLink (dropFileName settingsFile) lib_topDir settings <- traverse sequence $ - [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit, Context.stage = compilerStage }))) - , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter compilerStage) - -- Hard-coded as Cabal queries these to determine way support and we - -- need to always advertise all ways when bootstrapping. - -- The settings file is generated at install time when installing a bindist. - , ("RTS ways", unwords . map show . Set.toList <$> getRtsWays) + [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) + , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter executableStage) + -- Advertise the RTS ways that will actually ship with the compiler + -- described by this settings file, i.e. the ways the @libraryStage@ + -- RTS is built with. Cabal queries this to decide which library ways + -- the compiler supports (see + -- 'Distribution.Simple.Compiler.waySupported'); under-advertising + -- causes Cabal to silently drop flags like + -- @--enable-profiling-shared@. + -- The settings file is regenerated at install time when installing a bindist. + , ("RTS ways", unwords . map show . Set.toList <$> expr (interpretInContext (vanillaContext libraryStage rts) getRtsWays)) , ("Relative Global Package DB", pure rel_pkg_db) , ("base unit-id", pure base_unit_id) ] ===================================== libraries/ghc-internal/src/GHC/Internal/Ix.hs ===================================== @@ -142,7 +142,7 @@ For 1-d, 2-d, and 3-d arrays of Int we have specialised instances to avoid this. Note [Out-of-bounds error messages] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The default method for 'index' generates hoplelessIndexError, because +The default method for 'index' generates 'hopelessIndexError', because Ix doesn't have Show as a superclass. For particular base types we can do better, so we override the default method for index. ===================================== testsuite/tests/tcplugins/TcPlugin_RewritePerf.hs ===================================== @@ -2,7 +2,6 @@ -- Testing performance of type-checking rewriting plugins. -- Test based on T9872b. -{-# OPTIONS_GHC -dcore-lint #-} {-# OPTIONS_GHC -freduction-depth=400 #-} {-# OPTIONS_GHC -fplugin RewritePerfPlugin #-} ===================================== testsuite/tests/tcplugins/TcPlugin_RewritePerf.stderr ===================================== @@ -1,8 +1,7 @@ [1 of 4] Compiling RewritePerfDefs ( RewritePerfDefs.hs, RewritePerfDefs.o ) [2 of 4] Compiling RewritePerfPlugin ( RewritePerfPlugin.hs, RewritePerfPlugin.o ) [3 of 4] Compiling Main ( TcPlugin_RewritePerf.hs, TcPlugin_RewritePerf.o ) - -TcPlugin_RewritePerf.hs:25:8: error: [GHC-39999] +TcPlugin_RewritePerf.hs:24:8: error: [GHC-39999] • No instance for ‘Show (Proxy [['Cube G B W R B G, 'Cube W G B W R R, 'Cube R W R B G R, @@ -25,3 +24,4 @@ TcPlugin_RewritePerf.hs:25:8: error: [GHC-39999] • In the expression: print (Proxy :: Proxy (Solutions Cubes)) In an equation for ‘main’: main = print (Proxy :: Proxy (Solutions Cubes)) + ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2246,40 +2246,40 @@ instance ExactPrint (TyFamInstDecl GhcPs) where -- --------------------------------------------------------------------- -instance Typeable p => ExactPrint (LocatedP (OverlapMode (GhcPass p))) where - getAnnotationEntry = entryFromLocatedA - setAnnotationAnchor = setAnchorAn +instance ExactPrint (OverlapMode GhcPs) where + getAnnotationEntry _ = NoEntryVal + setAnnotationAnchor a _ _ _ = a -- NOTE: NoOverlap is only used in the typechecker - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (NoOverlap src)) = do + exact (NoOverlap (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# NO_OVERLAP" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (NoOverlap src)) + return (NoOverlap (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlappable src)) = do + exact (Overlappable (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPPABLE" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlappable src)) + return (Overlappable (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlapping src)) = do + exact (Overlapping (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPPING" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlapping src)) + return (Overlapping (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlaps src)) = do + exact (Overlaps (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPS" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlaps src)) + return (Overlaps (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Incoherent src)) = do + exact (Incoherent (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# INCOHERENT" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src)) + return (Incoherent (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (NonCanonical src)) = do + exact (NonCanonical (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# INCOHERENT" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src)) + return (Incoherent (src, AnnPragma o' c' s l1 l2 t m)) -- --------------------------------------------------------------------- @@ -4401,13 +4401,14 @@ instance ExactPrint t => ExactPrint (HsModifierOf t GhcPs) where -- --------------------------------------------------------------------- -instance Typeable p => ExactPrint (LocatedP (CType (GhcPass p))) where - getAnnotationEntry = entryFromLocatedA - setAnnotationAnchor = setAnchorAn +instance Typeable p => ExactPrint (CType (GhcPass p)) where + getAnnotationEntry _ = NoEntryVal + setAnnotationAnchor a _ _ _ = a - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (CType ext mh ct)) = do + exact (CType ext mh ct) = do let stp = cTypeSourceText ext stct = cTypeOtherText ext + AnnPragma o c s l1 l2 t m = cTypeAnn ext o' <- markAnnOpen'' o stp "{-# CTYPE" l1' <- case mh of Nothing -> return l1 @@ -4415,7 +4416,7 @@ instance Typeable p => ExactPrint (LocatedP (CType (GhcPass p))) where printStringAtAA l1 (toSourceTextWithSuffix srcH "" "") l2' <- printStringAtAA l2 (toSourceTextWithSuffix stct (unpackHText ct) "") c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1' l2' t m) cs) (CType ext mh ct)) + return (CType (ext { cTypeAnn = AnnPragma o' c' s l1' l2' t m }) mh ct) -- --------------------------------------------------------------------- ===================================== utils/haddock/haddock-api/src/Haddock/Types.hs ===================================== @@ -836,8 +836,8 @@ type instance Anno (FamilyResultSig DocNameI) = EpAnn NoEpAnns type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA type instance Anno (HsSigType DocNameI) = SrcSpanAnnA type instance Anno (BooleanFormula DocNameI) = SrcSpanAnnBF -type instance Anno (OverlapMode DocNameI) = EpAnn AnnPragma -type instance Anno (CType DocNameI) = EpAnn AnnPragma +type instance Anno (OverlapMode DocNameI) = SrcSpanAnnA +type instance Anno (CType DocNameI) = SrcSpanAnnA type instance Anno (Header DocNameI) = EpAnn AnnPragma type instance Anno (HsModifierOf (LocatedA (HsType DocNameI)) DocNameI) = SrcSpanAnnA type instance Anno (HsContextDetails DocNameI a) = SrcSpanAnnA View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d51bb84c5fd95b440ae173c05f1a6e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d51bb84c5fd95b440ae173c05f1a6e… 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/sjakobi/T27368-ppr] Cmm: print unreachable blocks under -dppr-debug (#27368)
by Simon Jakobi (＠sjakobi) 04 Aug '26

04 Aug '26

Simon Jakobi pushed to branch wip/sjakobi/T27368-ppr at Glasgow Haskell Compiler / GHC Commits: 8022a6e5 by Simon Jakobi at 2026-08-04T17:22:29+02:00 Cmm: print unreachable blocks under -dppr-debug (#27368) Unreachable blocks linger in a CmmGraph's block map for most of the Cmm pipeline, but pprCmmGraph only ever printed the blocks reachable from the entry, so dumps looked consistent while the graph was not. Issues like #27368 were hard to debug due to this. pprCmmGraph now appends the stored-but-unreachable blocks under a "// unreachable blocks:" heading when -dppr-debug is on. See Note [unreachable blocks] in GHC.Cmm.Pipeline. Assisted-by: Claude Opus 5 - - - - - 8 changed files: - + changelog.d/T27368-ppr-unreachable-cmm-blocks.md - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/Pipeline.hs - docs/users_guide/debugging.rst - testsuite/tests/cmm/should_compile/Makefile - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.cmm - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout - testsuite/tests/cmm/should_compile/all.T Changes: ===================================== changelog.d/T27368-ppr-unreachable-cmm-blocks.md ===================================== @@ -0,0 +1,10 @@ +section: cmm +issues: #27368 +mrs: !16417 +synopsis: + Cmm dumps now show unreachable blocks under ``-dppr-debug`` +description: + Unreachable blocks stay in a Cmm graph's block map for most of the Cmm + pipeline, but ``-ddump-cmm-*`` only ever printed the blocks reachable from + the graph's entry. Adding ``-dppr-debug`` now appends the stored but + unreachable blocks, which makes bugs like #27368 visible in the dumps. ===================================== compiler/GHC/Cmm.hs ===================================== @@ -151,15 +151,28 @@ instance OutputableP Platform CmmGraph where toBlockMap :: CmmGraph -> LabelMap CmmBlock toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body +-- | Print the blocks reachable from the entry, in reverse postorder. +-- +-- Under @-dppr-debug@ the unreachable blocks stored in the graph are appended +-- too. See Note [unreachable blocks] in "GHC.Cmm.Pipeline". pprCmmGraph :: Platform -> CmmGraph -> SDoc pprCmmGraph platform g = text "{" <> text "offset" - $$ nest 2 (vcat $ map (pdoc platform) blocks) + $$ nest 2 (ppr_blocks blocks $$ unreachable) $$ text "}" - where blocks = revPostorder g - -- revPostorder has the side-effect of discarding unreachable code, - -- so pretty-printed Cmm will omit any unreachable blocks. This can - -- sometimes be confusing. + where + ppr_blocks :: [CmmBlock] -> SDoc + ppr_blocks = vcat . map (pdoc platform) + + blocks = revPostorder g + + unreachable = getPprDebug $ \debug -> + if not debug || mapNull dead_blocks + then empty + else text "// unreachable blocks:" + $$ nest 2 (ppr_blocks (mapElems dead_blocks)) + + dead_blocks = foldl' (\bs b -> mapDelete (entryLabel b) bs) (toBlockMap g) blocks revPostorder :: CmmGraph -> [CmmBlock] revPostorder g = {-# SCC "revPostorder" #-} ===================================== compiler/GHC/Cmm/Pipeline.hs ===================================== @@ -357,6 +357,7 @@ containing junk code. These aren't necessarily a problem, but removing them is good because it might save time in the native code generator later. +To make unreachable blocks visible in -ddump-cmm-* output, add -dppr-debug. -} dumpGraph :: Logger -> Platform -> Bool -> DumpFlag -> String -> CmmGraph -> IO () ===================================== docs/users_guide/debugging.rst ===================================== @@ -564,6 +564,11 @@ C-\- representation These flags dump various phases of GHC's C-\- pipeline. +Dumps of Cmm graphs print the blocks reachable from the entry, in reverse +post-order. To also show unreachable blocks, which can linger in the graph, +add :ghc-flag:`-dppr-debug`. These blocks are then listed under a +``// unreachable blocks:`` heading. + .. ghc-flag:: -ddump-cmm-verbose-by-proc :shortdesc: Show output from main C-\- pipeline passes (grouped by proc) :type: dynamic @@ -574,9 +579,6 @@ These flags dump various phases of GHC's C-\- pipeline. the chosen backend. Currently only the NCG backends runs additional passes ( :ghc-flag:`-ddump-opt-cmm` ). - Cmm dumps don't include unreachable blocks since we print - blocks in reverse post-order. - .. ghc-flag:: -ddump-cmm-verbose :shortdesc: Write output from main C-\- pipeline passes to files :type: dynamic ===================================== testsuite/tests/cmm/should_compile/Makefile ===================================== @@ -16,3 +16,16 @@ T16930: T23610: '$(TEST_HC)' $(TEST_HC_OPTS) T23610.cmm -S + +# The three seds below, in order: +# 1. Keep only the "Parsed Cmm" dump, since that is the one stage where the +# unreachable block still exists. +# 2. Rewrite goto targets: their label uniques survive -dsuppress-uniques +# (#21310). +# 3. Drop the "// CmmAssign"-style node annotations, which pprNode emits +# only on DEBUG compilers. +T27368-ppr-debug: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -no-hs-main -ddump-cmm-verbose-by-proc -dppr-debug -dsuppress-uniques -dsuppress-ticks T27368-ppr-debug.cmm 2>&1 \ + | sed -n '/^==* Parsed Cmm/,/^ \}\]/p' \ + | sed 's/goto c[0-9A-Za-z]*/goto _lbl_/g' \ + | sed 's| *// Cmm[A-Za-z]*$$||' ===================================== testsuite/tests/cmm/should_compile/T27368-ppr-debug.cmm ===================================== @@ -0,0 +1,19 @@ +#include "Cmm.h" + +// The block "dead" is stored in the graph but no block branches to it, so it +// only shows up in Cmm dumps under -dppr-debug. +testUnreachable (W_ x) +{ + if (x > 0) { + goto live; + } + return (x); + +dead: + x = x + 42; + return (x); + +live: + x = x - 1; + return (x); +} ===================================== testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout ===================================== @@ -0,0 +1,27 @@ +==================== Parsed Cmm ==================== +[testUnreachable() { // [R1] + { info_tbls: [] + stack_info: arg_space: 8 + } + {offset + _lbl_: + __locVar_::I64 = R1; + if (__locVar_::I64 > 0) goto _lbl_; else goto _lbl_; + _lbl_: + goto _lbl_; + _lbl_: + __locVar_::I64 = __locVar_::I64 - 1; + R1 = __locVar_::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + _lbl_: + goto _lbl_; + _lbl_: + R1 = __locVar_::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + // unreachable blocks: + _lbl_: + __locVar_::I64 = __locVar_::I64 + 42; + R1 = __locVar_::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + } + }] ===================================== testsuite/tests/cmm/should_compile/all.T ===================================== @@ -13,6 +13,9 @@ test('T20725', normal, compile, ['-package ghc']) test('T23610', normal, makefile_test, ['T23610']) test('T24224', [cmm_src, grep_errmsg(r'(F64.*);', [1]), only_ways(['normal'])], compile, ['-no-hs-main -ddump-cmm -dsuppress-all -dsuppress-uniques']) test('T24474', cmm_src, compile, ['-optc-g3']) +# -dppr-debug makes stored-but-unreachable blocks visible in Cmm dumps (#27368). +# Skipped on wordsize(32) targets, where the dump would say I32/P32. +test('T27368-ppr-debug', [when(wordsize(32), skip)], makefile_test, ['T27368-ppr-debug']) test('T24474-cmm-gets-c-opts', cmm_src, compile, ['-optc-DFOO']) test('T24474-cmm-opt-order', cmm_src, compile, ['-optc-DFOO ' '-optCmmP-UFOO ' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8022a6e52a9a50129c7ecb8f061e304… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8022a6e52a9a50129c7ecb8f061e304… 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/int-index/t18725] 6 commits: EPA: Remove LocatedP from OverlapMode
by Vladislav Zavialov (＠int-index) 04 Aug '26

04 Aug '26

Vladislav Zavialov pushed to branch wip/int-index/t18725 at Glasgow Haskell Compiler / GHC Commits: 85b10c00 by Alan Zimmerman at 2026-07-31T22:09:47+01:00 EPA: Remove LocatedP from OverlapMode We have type LocatedP = GenLocated SrcSpanAnnP type SrcSpanAnnP = EpAnn AnnPragma As the first step in removing this in favour of LocatedA which only captures location, comments and trailing annotations, we remove it from OverlapMode We do this by moving the AnnPragma into the TTG extension point instead. - - - - - c9a34a00 by Viktor Dukhovni at 2026-08-02T04:34:17-04:00 Fix note typo - - - - - 4f2a21f7 by Andreas Klebinger at 2026-08-02T22:46:46-04:00 Apply oneShot Monad trick to STG LintM - - - - - 21e4b89d by Andreas Klebinger at 2026-08-02T22:46:46-04:00 stgLint: Use a single reader env for read only arguments. - - - - - d415f38a by Alan Zimmerman at 2026-08-02T22:47:27-04:00 EPA: Remove LocatedP from CType The next step of removing use of LocatedP by moving the AnnPragma for CType into its TTG extension point instead. - - - - - f938dae0 by Vladislav Zavialov at 2026-08-04T15:22:30+00:00 Test cases for #18725 Starting with GHC 9.4 (the first release to include 268efcc9a4), the program in this ticket no longer panics. A standalone kind signature breaks the recursive loop, so the type constructor can be used in a kind within its own group. T18725a checks that this is accepted with the signature present, while T18725b confirms it is still rejected without it. - - - - - 19 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Decls/Overlap.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/ForeignCall.hs - libraries/ghc-internal/src/GHC/Internal/Ix.hs - + testsuite/tests/saks/should_compile/T18725a.hs - testsuite/tests/saks/should_compile/all.T - + testsuite/tests/saks/should_fail/T18725b.hs - + testsuite/tests/saks/should_fail/T18725b.stderr - testsuite/tests/saks/should_fail/all.T - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Types.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1158,20 +1158,25 @@ ppDerivStrategy mb = Nothing -> empty Just (L _ ds) -> ppr ds -ppOverlapPragma :: Maybe (LocatedP (OverlapMode (GhcPass p))) -> SDoc +ppOverlapPragma :: forall p. IsPass p => Maybe (LocatedA (OverlapMode (GhcPass p))) -> SDoc ppOverlapPragma mb = case mb of Nothing -> empty - Just (L _ (NoOverlap s)) -> maybe_stext s "{-# NO_OVERLAP #-}" - Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}" - Just (L _ (Overlapping s)) -> maybe_stext s "{-# OVERLAPPING #-}" - Just (L _ (Overlaps s)) -> maybe_stext s "{-# OVERLAPS #-}" - Just (L _ (Incoherent s)) -> maybe_stext s "{-# INCOHERENT #-}" - Just (L _ (NonCanonical s)) -> maybe_stext s "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet + Just (L _ (NoOverlap s)) -> maybe_stext (stext s) "{-# NO_OVERLAP #-}" + Just (L _ (Overlappable s)) -> maybe_stext (stext s) "{-# OVERLAPPABLE #-}" + Just (L _ (Overlapping s)) -> maybe_stext (stext s) "{-# OVERLAPPING #-}" + Just (L _ (Overlaps s)) -> maybe_stext (stext s) "{-# OVERLAPS #-}" + Just (L _ (Incoherent s)) -> maybe_stext (stext s) "{-# INCOHERENT #-}" + Just (L _ (NonCanonical s)) -> maybe_stext (stext s) "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet where maybe_stext NoSourceText alt = text alt maybe_stext (SourceText src) _ = ftext src <+> text "#-}" + stext :: XOverlapMode (GhcPass p) -> SourceText + stext s = case (ghcPass @p, s) of + (GhcPs, (s,_)) -> s + (GhcRn, (s,_)) -> s + (GhcTc, s) -> s instance (OutputableBndrId p) => Outputable (InstDecl (GhcPass p)) where ppr (ClsInstD { cid_inst = decl }) = ppr decl @@ -1578,7 +1583,7 @@ type instance Anno (FunDep (GhcPass p)) = SrcSpanAnnA type instance Anno (FamilyResultSig (GhcPass p)) = EpAnnCO type instance Anno (FamilyDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (InjectivityAnn (GhcPass p)) = EpAnnCO -type instance Anno (CType (GhcPass p)) = SrcSpanAnnP +type instance Anno (CType (GhcPass p)) = SrcSpanAnnA type instance Anno (HsDerivingClause (GhcPass p)) = EpAnnCO type instance Anno (DerivClauseTys (GhcPass _)) = SrcSpanAnnA type instance Anno (StandaloneKindSig (GhcPass p)) = SrcSpanAnnA @@ -1593,7 +1598,7 @@ type instance Anno (ClsInstDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (InstDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (DocDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (DerivDecl (GhcPass p)) = SrcSpanAnnA -type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnP +type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnA type instance Anno (DerivStrategy (GhcPass p)) = EpAnnCO type instance Anno (DefaultDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (ForeignDecl (GhcPass p)) = SrcSpanAnnA ===================================== compiler/GHC/Hs/Decls/Overlap.hs ===================================== @@ -26,6 +26,8 @@ import GHC.Prelude import GHC.Hs.Extension +import GHC.Parser.Annotation ( AnnPragma ) + import Language.Haskell.Syntax.Decls.Overlap import Language.Haskell.Syntax.Extension @@ -65,7 +67,9 @@ instance NFData OverlapFlag where instance Outputable OverlapFlag where ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag) -type instance XOverlapMode (GhcPass _) = SourceText +type instance XOverlapMode GhcPs = (SourceText, AnnPragma) +type instance XOverlapMode GhcRn = (SourceText, AnnPragma) +type instance XOverlapMode GhcTc = SourceText type instance XXOverlapMode (GhcPass _) = DataConCantHappen ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1752,7 +1752,7 @@ instance ToHie (RScoped (LocatedAn NoEpAnns (DerivStrategy GhcRn))) where NewtypeStrategy _ -> [] ViaStrategy s -> [ toHie (TS (ResolvedScopes [sc]) s) ] -instance ToHie (LocatedP (OverlapMode GhcRn)) where +instance ToHie (LocatedA (OverlapMode GhcRn)) where toHie (L span _) = locOnly (locA span) instance ToHie (LocatedA (ConDecl GhcRn)) where ===================================== compiler/GHC/Parser.y ===================================== @@ -1471,15 +1471,15 @@ inst_decl :: { LInstDecl GhcPs } (fmap reverse $7) (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok $2) dcolon twhere oc cc NoEpTok)}} -overlap_pragma :: { Maybe (LocatedP (OverlapMode GhcPs)) } - : '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# OVERLAPPING' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# OVERLAPS' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# INCOHERENT' '#-}' {% fmap Just $ amsr (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } +overlap_pragma :: { Maybe (LocatedA (OverlapMode GhcPs)) } + : '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# OVERLAPPING' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# OVERLAPS' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# INCOHERENT' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } | {- empty -} { Nothing } deriv_strategy_no_via :: { LDerivStrategy GhcPs } @@ -1707,15 +1707,17 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs | type { sL1 $1 (Nothing, mkHsOuterImplicit, $1) } -capi_ctype :: { Maybe (LocatedP (CType GhcPs)) } +capi_ctype :: { Maybe (LocatedA (CType GhcPs)) } capi_ctype : '{-# CTYPE' STRING STRING '#-}' - {% fmap Just $ amsr (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $3) (Just (Header (getSTRINGs $2) (getSTRING $2))) - (getSTRING $3))) - (AnnPragma (glR $1) (epTok $4) noAnn (glR $2) (glR $3) noAnn noAnn) } + {% fmap Just $ amsA' (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $3) + (AnnPragma (glR $1) (epTok $4) noAnn (glR $2) (glR $3) noAnn noAnn) + (Just (Header (getSTRINGs $2) (getSTRING $2))) + (getSTRING $3)))} | '{-# CTYPE' STRING '#-}' - {% fmap Just $ amsr (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $2) Nothing (getSTRING $2))) - (AnnPragma (glR $1) (epTok $3) noAnn noAnn (glR $2) noAnn noAnn) } + {% fmap Just $ amsA' (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $2) + (AnnPragma (glR $1) (epTok $3) noAnn noAnn (glR $2) noAnn noAnn) + Nothing (getSTRING $2)))} | { Nothing } ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -229,7 +229,7 @@ mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layout annsIn mkTyData :: SrcSpan -> Bool -> NewOrData - -> Maybe (LocatedP (CType GhcPs)) + -> Maybe (LocatedA (CType GhcPs)) -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs) -> Maybe (LHsKind GhcPs) -> [LConDecl GhcPs] @@ -251,7 +251,7 @@ mkTyData loc' is_type_data new_or_data cType (L _ (mcxt, tycl_hdr)) tcdDataDefn = defn, tcdModifiers = [] })) } -mkDataDefn :: Maybe (LocatedP (CType GhcPs)) +mkDataDefn :: Maybe (LocatedA (CType GhcPs)) -> Maybe (LHsContext GhcPs) -> Maybe (LHsKind GhcPs) -> DataDefnCons (LConDecl GhcPs) @@ -326,7 +326,7 @@ mkTyFamInstEqn loc bndrs lhs rhs annEq mkDataFamInst :: SrcSpan -> NewOrData - -> Maybe (LocatedP (CType GhcPs)) + -> Maybe (LocatedA (CType GhcPs)) -> (Maybe ( LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs , LHsType GhcPs) -> Maybe (LHsKind GhcPs) ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -92,6 +92,7 @@ be ill-typed in Core. But it must still be well-kinded! -} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PatternSynonyms #-} module GHC.Stg.Lint ( lintStgTopBindings ) where @@ -123,6 +124,7 @@ import GHC.Unit.Module ( Module ) import GHC.Data.Bag ( Bag, emptyBag, isEmptyBag, snocBag, bagToList ) import Control.Monad +import GHC.Exts ( oneShot ) import GHC.Core.Multiplicity (scaledThing) import GHC.Settings (Platform) import GHC.Core.TyCon (primRepCompatible, primRepsCompatible) @@ -432,17 +434,40 @@ The Lint monad ************************************************************************ -} -newtype LintM a = LintM - { unLintM :: Module - -> LintFlags - -> DiagOpts -- Diagnostic options - -> StgPprOpts -- Pretty-printing options +data LintReaderEnv = LintReaderEnv + { le_mod :: !Module + , le_flags :: !LintFlags + , le_diag_opts :: !DiagOpts -- Diagnostic options + , le_ppr_opts :: !StgPprOpts -- Pretty-printing options + } + +newtype LintM a = LintM' + { unLintM :: LintReaderEnv -> [LintLocInfo] -- Locations -> IdSet -- Local vars in scope -> Bag SDoc -- Error messages so far -> (a, Bag SDoc) -- Result and error messages (if any) } - deriving (Functor) +instance Functor LintM where + fmap f (LintM m) = + LintM $ \env loc scope errs -> + case m env loc scope errs of + (a, errs') -> (f a, errs') + +-- See Note [The one-shot state monad trick] in GHC.Utils.Monad +{-# COMPLETE LintM #-} +pattern LintM :: (LintReaderEnv + -> [LintLocInfo] + -> IdSet + -> Bag SDoc + -> (a, Bag SDoc)) + -> LintM a +pattern LintM m <- LintM' m + where + LintM m = LintM' $ oneShot (\env -> oneShot + (\loc -> oneShot + (\scope -> oneShot + (\errs -> m env loc scope errs)))) data LintFlags = LintFlags { lf_unarised :: !Bool , lf_platform :: !Platform @@ -473,14 +498,16 @@ pp_binders bs initL :: Platform -> DiagOpts -> Module -> Bool -> StgPprOpts -> IdSet -> LintM a -> Maybe SDoc initL platform diag_opts this_mod unarised opts locals (LintM m) = do - let (_, errs) = m this_mod (LintFlags unarised platform) diag_opts opts [] locals emptyBag + let !flags = LintFlags unarised platform + !env = LintReaderEnv this_mod flags diag_opts opts + (_, errs) = m env [] locals emptyBag if isEmptyBag errs then Nothing else Just (vcat (punctuate blankLine (bagToList errs))) instance Applicative LintM where - pure a = LintM $ \_mod _lf _df _opts _loc _scope errs -> (a, errs) + pure a = LintM $ \_env _loc _scope errs -> (a, errs) (<*>) = ap (*>) = thenL_ @@ -489,14 +516,14 @@ instance Monad LintM where (>>) = (*>) thenL :: LintM a -> (a -> LintM b) -> LintM b -thenL m k = LintM $ \mod lf diag_opts opts loc scope errs - -> case unLintM m mod lf diag_opts opts loc scope errs of - (r, errs') -> unLintM (k r) mod lf diag_opts opts loc scope errs' +thenL m k = LintM $ \env loc scope errs + -> case unLintM m env loc scope errs of + (r, errs') -> unLintM (k r) env loc scope errs' thenL_ :: LintM a -> LintM b -> LintM b -thenL_ m k = LintM $ \mod lf diag_opts opts loc scope errs - -> case unLintM m mod lf diag_opts opts loc scope errs of - (_, errs') -> unLintM k mod lf diag_opts opts loc scope errs' +thenL_ m k = LintM $ \env loc scope errs + -> case unLintM m env loc scope errs of + (_, errs') -> unLintM k env loc scope errs' checkL :: Bool -> SDoc -> LintM () checkL True _ = return () @@ -525,7 +552,8 @@ checkPostUnariseId id id_ty = idType id addErrL :: SDoc -> LintM () -addErrL msg = LintM $ \_mod _lf df _opts loc _scope errs -> ((), addErr df errs msg loc) +addErrL msg = LintM $ \LintReaderEnv{le_diag_opts = df} loc _scope errs + -> ((), addErr df errs msg loc) addErr :: DiagOpts -> Bag SDoc -> SDoc -> [LintLocInfo] -> Bag SDoc addErr diag_opts errs_so_far msg locs @@ -537,23 +565,23 @@ addErr diag_opts errs_so_far msg locs mk_msg [] = msg addLoc :: LintLocInfo -> LintM a -> LintM a -addLoc extra_loc m = LintM $ \mod lf diag_opts opts loc scope errs - -> unLintM m mod lf diag_opts opts (extra_loc:loc) scope errs +addLoc extra_loc m = LintM $ \env loc scope errs + -> unLintM m env (extra_loc:loc) scope errs addInScopeVars :: [Id] -> LintM a -> LintM a -addInScopeVars ids m = LintM $ \mod lf diag_opts opts loc scope errs +addInScopeVars ids m = LintM $ \env loc scope errs -> let new_set = mkVarSet ids - in unLintM m mod lf diag_opts opts loc (scope `unionVarSet` new_set) errs + in unLintM m env loc (scope `unionVarSet` new_set) errs getLintFlags :: LintM LintFlags -getLintFlags = LintM $ \_mod lf _df _opts _loc _scope errs -> (lf, errs) +getLintFlags = LintM $ \LintReaderEnv{le_flags = lf} _loc _scope errs -> (lf, errs) getStgPprOpts :: LintM StgPprOpts -getStgPprOpts = LintM $ \_mod _lf _df opts _loc _scope errs -> (opts, errs) +getStgPprOpts = LintM $ \LintReaderEnv{le_ppr_opts = opts} _loc _scope errs -> (opts, errs) checkInScope :: Id -> LintM () -checkInScope id = LintM $ \mod _lf diag_opts _opts loc scope errs +checkInScope id = LintM $ \LintReaderEnv{le_mod = mod, le_diag_opts = diag_opts} loc scope errs -> if nameIsLocalOrFrom mod (idName id) && not (id `elemVarSet` scope) then ((), addErr diag_opts errs (hsep [ppr id, dcolon, ppr (idType id), text "is out of scope"]) loc) ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -11,7 +11,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | Handles @deriving@ clauses on @data@ declarations. -module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..) ) where +module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..), tcOverlapMode ) where import GHC.Prelude @@ -776,12 +776,12 @@ deriveStandalone (L loc (DerivDecl (warn, _) deriv_ty mb_lderiv_strat overlap_mo tcOverlapMode :: OverlapMode GhcRn -> OverlapMode GhcTc tcOverlapMode = \case - NoOverlap s -> NoOverlap s - Overlappable s -> Overlappable s - Overlapping s -> Overlapping s - Overlaps s -> Overlaps s - Incoherent s -> Incoherent s - NonCanonical s -> NonCanonical s + NoOverlap s -> NoOverlap (fst s) + Overlappable s -> Overlappable (fst s) + Overlapping s -> Overlapping (fst s) + Overlaps s -> Overlaps (fst s) + Incoherent s -> Incoherent (fst s) + NonCanonical s -> NonCanonical (fst s) -- Typecheck the type in a standalone deriving declaration. -- ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -558,7 +558,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty -- Dfun location is that of instance *header* ; let warn = fmap unLoc lwarn - ; ispec <- newClsInst (fmap unLoc overlap_mode) dfun_name + ; ispec <- newClsInst (fmap (tcOverlapMode . unLoc) overlap_mode) dfun_name tyvars theta clas inst_tys warn ; let inst_binds = InstBindings ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -72,7 +72,6 @@ import GHC.Rename.Utils( mkRnSyntaxExpr ) import GHC.Types.Id.Make( mkDictFunId ) import GHC.Types.Arity ( Arity, VisArity ) import GHC.Types.Basic ( TypeOrKind(..) ) -import GHC.Types.SourceText import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var.Env import GHC.Types.Id @@ -912,7 +911,7 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity ************************************************************************ -} -getOverlapFlag :: Maybe (OverlapMode (GhcPass p)) -- User pragma if any +getOverlapFlag :: Maybe (OverlapMode GhcTc) -- User pragma if any -> TcM OverlapFlag -- Construct the OverlapFlag from the global module flags, -- but if the overlap_mode argument is (Just m), @@ -936,9 +935,9 @@ getOverlapFlag overlap_mode_prag overlap_mode | Just m <- overlap_mode_prag = m - | incoherent_ok = Incoherent NoSourceText - | overlap_ok = Overlaps NoSourceText - | otherwise = NoOverlap NoSourceText + | incoherent_ok = Incoherent noAnn + | overlap_ok = Overlaps noAnn + | otherwise = NoOverlap noAnn -- final_overlap_mode: the `-fspecialise-incoherents` flag controls the -- meaning of the `Incoherent` overlap mode: as either an Incoherent overlap @@ -964,7 +963,7 @@ tcGetInsts :: TcM [ClsInst] -- Gets the local class instances. tcGetInsts = fmap tcg_insts getGblEnv -newClsInst :: Maybe (OverlapMode (GhcPass p)) -- User pragma +newClsInst :: Maybe (OverlapMode GhcTc) -- User pragma -> Name -> [TyVar] -> ThetaType -> Class -> [Type] -> Maybe (WarningTxt GhcRn) -> TcM ClsInst newClsInst overlap_mode dfun_name tvs theta clas tys warn ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -356,10 +356,10 @@ cvtDec (InstanceD o ctxt ty decs) where overlap pragma = case pragma of - TH.Overlaps -> Hs.Overlaps (SourceText $ fsLit "{-# OVERLAPS") - TH.Overlappable -> Hs.Overlappable (SourceText $ fsLit "{-# OVERLAPPABLE") - TH.Overlapping -> Hs.Overlapping (SourceText $ fsLit "{-# OVERLAPPING") - TH.Incoherent -> Hs.Incoherent (SourceText $ fsLit "{-# INCOHERENT") + TH.Overlaps -> Hs.Overlaps (SourceText $ fsLit "{-# OVERLAPS", noAnn) + TH.Overlappable -> Hs.Overlappable (SourceText $ fsLit "{-# OVERLAPPABLE", noAnn) + TH.Overlapping -> Hs.Overlapping (SourceText $ fsLit "{-# OVERLAPPING", noAnn) + TH.Incoherent -> Hs.Incoherent (SourceText $ fsLit "{-# INCOHERENT", noAnn) ===================================== compiler/GHC/Types/ForeignCall.hs ===================================== @@ -109,6 +109,7 @@ import Data.Data (Data) import Data.Functor ((<&>)) import Control.DeepSeq (NFData(..)) +import GHC.Parser.Annotation (AnnPragma, noAnn) {- ************************************************************************ @@ -213,11 +214,11 @@ instance Outputable CCallSpec where defaultCType :: String -> CType (GhcPass p) defaultCType = - CType (CTypeGhc NoSourceText NoSourceText) Nothing . packHText + CType (CTypeGhc NoSourceText NoSourceText noAnn) Nothing . packHText -mkCType :: SourceText -> SourceText -> Maybe (Header (GhcPass p)) -> HText -> CType (GhcPass p) -mkCType x y m = - CType (CTypeGhc x y) m +mkCType :: SourceText -> SourceText -> AnnPragma -> Maybe (Header (GhcPass p)) -> HText -> CType (GhcPass p) +mkCType x y ann m = + CType (CTypeGhc x y ann) m typeCheckCType :: CType GhcRn -> CType GhcTc typeCheckCType (CType x y z) = CType x (typeCheckHeader <$> y) z @@ -302,6 +303,7 @@ data StaticTargetGhc = StaticTargetGhc data CTypeGhc = CTypeGhc { cTypeSourceText :: SourceText , cTypeOtherText :: SourceText + , cTypeAnn :: AnnPragma } deriving (Data, Eq) @@ -349,6 +351,7 @@ instance Binary CTypeGhc where return $ CTypeGhc { cTypeSourceText = str1 , cTypeOtherText = str2 + , cTypeAnn = noAnn } instance NFData StaticTargetGhc where ===================================== libraries/ghc-internal/src/GHC/Internal/Ix.hs ===================================== @@ -142,7 +142,7 @@ For 1-d, 2-d, and 3-d arrays of Int we have specialised instances to avoid this. Note [Out-of-bounds error messages] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The default method for 'index' generates hoplelessIndexError, because +The default method for 'index' generates 'hopelessIndexError', because Ix doesn't have Show as a superclass. For particular base types we can do better, so we override the default method for index. ===================================== testsuite/tests/saks/should_compile/T18725a.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE ExplicitForAll, KindSignatures, StandaloneKindSignatures, + DataKinds, GADTs #-} + +module T18725a where + +import Data.Kind (Type) + +type U :: Type +data U where P :: forall u. E u -> U +data E (u :: U) ===================================== testsuite/tests/saks/should_compile/all.T ===================================== @@ -35,6 +35,7 @@ test('T16726', normal, compile, ['']) test('T16731', normal, compile, ['']) test('T16721', normal, ghci_script, ['T16721.script']) test('T16756a', normal, compile, ['']) +test('T18725a', normal, compile, ['']) test('saks027', req_th, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('saks028', req_th, compile, ['']) ===================================== testsuite/tests/saks/should_fail/T18725b.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE ExplicitForAll, KindSignatures, StandaloneKindSignatures, + DataKinds, GADTs #-} + +module T18725b where + +-- type U :: Type -- Rejected without the sig +data U where P :: forall u. E u -> U +data E (u :: U) ===================================== testsuite/tests/saks/should_fail/T18725b.stderr ===================================== @@ -0,0 +1,6 @@ +T18725b.hs:8:14: error: [GHC-85413] + • Type constructor ‘U’ cannot be used here + (it is defined and used in the same recursive group) + • In the kind ‘U’ + In the data type declaration for ‘E’ + ===================================== testsuite/tests/saks/should_fail/all.T ===================================== @@ -38,3 +38,5 @@ test('T18863d', normal, compile_fail, ['']) test('T20916', normal, compile_fail, ['']) test('saks018-fail', normal, compile_fail, ['']) test('saks021-fail', normal, compile_fail, ['']) +test('T18725b', normal, compile_fail, ['']) + ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2246,40 +2246,40 @@ instance ExactPrint (TyFamInstDecl GhcPs) where -- --------------------------------------------------------------------- -instance Typeable p => ExactPrint (LocatedP (OverlapMode (GhcPass p))) where - getAnnotationEntry = entryFromLocatedA - setAnnotationAnchor = setAnchorAn +instance ExactPrint (OverlapMode GhcPs) where + getAnnotationEntry _ = NoEntryVal + setAnnotationAnchor a _ _ _ = a -- NOTE: NoOverlap is only used in the typechecker - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (NoOverlap src)) = do + exact (NoOverlap (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# NO_OVERLAP" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (NoOverlap src)) + return (NoOverlap (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlappable src)) = do + exact (Overlappable (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPPABLE" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlappable src)) + return (Overlappable (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlapping src)) = do + exact (Overlapping (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPPING" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlapping src)) + return (Overlapping (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlaps src)) = do + exact (Overlaps (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPS" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlaps src)) + return (Overlaps (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Incoherent src)) = do + exact (Incoherent (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# INCOHERENT" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src)) + return (Incoherent (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (NonCanonical src)) = do + exact (NonCanonical (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# INCOHERENT" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src)) + return (Incoherent (src, AnnPragma o' c' s l1 l2 t m)) -- --------------------------------------------------------------------- @@ -4401,13 +4401,14 @@ instance ExactPrint t => ExactPrint (HsModifierOf t GhcPs) where -- --------------------------------------------------------------------- -instance Typeable p => ExactPrint (LocatedP (CType (GhcPass p))) where - getAnnotationEntry = entryFromLocatedA - setAnnotationAnchor = setAnchorAn +instance Typeable p => ExactPrint (CType (GhcPass p)) where + getAnnotationEntry _ = NoEntryVal + setAnnotationAnchor a _ _ _ = a - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (CType ext mh ct)) = do + exact (CType ext mh ct) = do let stp = cTypeSourceText ext stct = cTypeOtherText ext + AnnPragma o c s l1 l2 t m = cTypeAnn ext o' <- markAnnOpen'' o stp "{-# CTYPE" l1' <- case mh of Nothing -> return l1 @@ -4415,7 +4416,7 @@ instance Typeable p => ExactPrint (LocatedP (CType (GhcPass p))) where printStringAtAA l1 (toSourceTextWithSuffix srcH "" "") l2' <- printStringAtAA l2 (toSourceTextWithSuffix stct (unpackHText ct) "") c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1' l2' t m) cs) (CType ext mh ct)) + return (CType (ext { cTypeAnn = AnnPragma o' c' s l1' l2' t m }) mh ct) -- --------------------------------------------------------------------- ===================================== utils/haddock/haddock-api/src/Haddock/Types.hs ===================================== @@ -836,8 +836,8 @@ type instance Anno (FamilyResultSig DocNameI) = EpAnn NoEpAnns type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA type instance Anno (HsSigType DocNameI) = SrcSpanAnnA type instance Anno (BooleanFormula DocNameI) = SrcSpanAnnBF -type instance Anno (OverlapMode DocNameI) = EpAnn AnnPragma -type instance Anno (CType DocNameI) = EpAnn AnnPragma +type instance Anno (OverlapMode DocNameI) = SrcSpanAnnA +type instance Anno (CType DocNameI) = SrcSpanAnnA type instance Anno (Header DocNameI) = EpAnn AnnPragma type instance Anno (HsModifierOf (LocatedA (HsType DocNameI)) DocNameI) = SrcSpanAnnA type instance Anno (HsContextDetails DocNameI a) = SrcSpanAnnA View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/066783c056890adbe39a59d63c2ecd… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/066783c056890adbe39a59d63c2ecd… 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/hie-file-improvements] 2 commits: hie files: Dump the type table when dumping with -ddump-hie
by Hannes Siebenhandl (＠fendor) 04 Aug '26

04 Aug '26

Hannes Siebenhandl pushed to branch wip/hie-file-improvements at Glasgow Haskell Compiler / GHC Commits: 15e3773c by Zubin Duggal at 2026-08-04T17:16:30+02:00 hie files: Dump the type table when dumping with -ddump-hie - - - - - 7cd2eaf4 by Zubin Duggal at 2026-08-04T17:16:36+02:00 hie files: Take evidence for quantified constraints into account when saving evidence terms to the hie ast Fixes #25709 - - - - - 5 changed files: - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Iface/Ext/Types.hs - + testsuite/tests/hiefile/should_run/T25709.hs - + testsuite/tests/hiefile/should_run/T25709.stdout - testsuite/tests/hiefile/should_run/all.T Changes: ===================================== compiler/GHC/Driver/Main/Passes.hs ===================================== @@ -92,7 +92,7 @@ import GHC.Iface.Make import GHC.Iface.Recomp import GHC.Iface.Tidy import GHC.Iface.Ext.Ast ( mkHieFile ) -import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module ) +import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module, hie_types ) import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result) import GHC.Iface.Ext.Debug ( diffFile, validateScopes ) @@ -167,7 +167,7 @@ import GHC.Data.StringBuffer import GHC.Data.Maybe import qualified GHC.Data.Strict as Strict - +import qualified Data.Array as A import Data.List ( nub, isPrefixOf, partition ) import qualified Data.List.NonEmpty as NE import Control.Monad @@ -332,7 +332,10 @@ extract_renamed_stuff mod_summary tc_result = do hieFile <- mkHieFile mod_summary tc_result (fromJust rn_info) let out_file = ml_hie_file $ ms_location mod_summary liftIO $ writeHieFile out_file hieFile - liftIO $ putDumpFileMaybe logger Opt_D_dump_hie "HIE AST" FormatHaskell (ppr $ hie_asts hieFile) + let hie_doc = + ppr (hie_asts hieFile) + $+$ ppr (A.assocs $ hie_types hieFile) + liftIO $ putDumpFileMaybe logger Opt_D_dump_hie "HIE AST" FormatHaskell hie_doc -- Validate HIE files when (gopt Opt_ValidateHie dflags) $ do ===================================== compiler/GHC/Iface/Ext/Types.hs ===================================== @@ -159,6 +159,18 @@ data HieType a | HCoercionTy deriving (Functor, Foldable, Traversable, Eq) +instance Outputable a => Outputable (HieType a) where + ppr (HTyVarTy name) = ppr name + ppr (HAppTy fun arg) = parens $ ppr fun <+> ppr arg + ppr (HTyConApp tc args) = parens $ ppr tc <+> ppr args + ppr (HForAllTy ((name, ty), flag) body) = + text "forall" <+> ppr flag <+> ppr name O.<> text ":" <+> ppr ty O.<> text "." <+> ppr body + ppr (HFunTy mult arg res) = parens $ ppr arg <+> arrow <+> ppr res <+> ppr mult + ppr (HQualTy ctxt ty) = parens $ ppr ctxt <+> text "=>" <+> ppr ty + ppr (HLitTy lit) = ppr lit + ppr (HCastTy ty) = text "cast" <+> ppr ty + ppr HCoercionTy = text "<coercion>" + type HieTypeFlat = HieType TypeIndex -- | Roughly isomorphic to the original core 'Type'. @@ -222,6 +234,10 @@ instance Binary (HieArgs TypeIndex) where put_ bh (HieArgs xs) = put_ bh xs get bh = HieArgs <$> get bh +instance Outputable a => Outputable (HieArgs a) where + ppr (HieArgs args) = braces $ hsep $ punctuate comma $ map pprArg args + where pprArg (vis, ty) = (if vis then id else parens) (ppr ty) + -- A HiePath is just a lexical FastString. We use a lexical FastString to avoid -- non-determinism when printing or storing HieASTs which are sorted by their ===================================== testsuite/tests/hiefile/should_run/T25709.hs ===================================== @@ -0,0 +1,29 @@ +{-# LANGUAGE QuantifiedConstraints#-} +{-# LANGUAGE UndecidableInstances #-} +module Main where + +import TestUtils +import qualified Data.Map.Strict as M +import qualified Data.Set as S +import Data.Either +import Data.Maybe +import Data.Bifunctor (first) +import GHC.Plugins (moduleNameString, nameStableString, nameOccName, occNameString, isDerivedOccName) +import GHC.Iface.Ext.Types + + +import Data.Typeable + +data Some c where + Some :: c a => a -> Some c + +extractSome :: (Typeable a, forall x. c x => Typeable x) => Some c -> Maybe a +extractSome (Some a) = cast a + +points :: [(Int,Int)] +points = [(21,26)] + +main = do + (df, hf) <- readTestHie "T25709.hie" + let refmap = generateReferencesMap $ getAsts $ hie_asts hf + traverse (explainEv df hf refmap) points ===================================== testsuite/tests/hiefile/should_run/T25709.stdout ===================================== @@ -0,0 +1,51 @@ +========================== +At point (21,26), we found: +========================== +┌ +│ $dTypeable at T25709.hs:21:14-19, of type: Typeable a +│ is an evidence variable bound by a let, depending on: [$dTypeable] +│ with scope: LocalScope T25709.hs:21:14-29 +│ +│ Defined at <no location info> +└ +| +`- ┌ + │ $dTypeable at T25709.hs:21:1-29, of type: Typeable a + │ is an evidence variable bound by a HsWrapper + │ with scope: LocalScope T25709.hs:21:1-29 + │ bound at: T25709.hs:21:1-29 + │ Defined at <no location info> + └ + +┌ +│ $dTypeable at T25709.hs:21:14-19, of type: Typeable a +│ is an evidence variable bound by a let, depending on: [df, irred] +│ with scope: LocalScope T25709.hs:21:14-29 +│ +│ Defined at <no location info> +└ +| ++- ┌ +| │ df at T25709.hs:21:1-29, of type: forall x. c x => Typeable x +| │ is an evidence variable bound by a HsWrapper +| │ with scope: LocalScope T25709.hs:21:1-29 +| │ bound at: T25709.hs:21:1-29 +| │ Defined at <no location info> +| └ +| +`- ┌ + │ irred at T25709.hs:21:14-19, of type: c a + │ is an evidence variable bound by a let, depending on: [irred] + │ with scope: LocalScope T25709.hs:21:14-29 + │ + │ Defined at <no location info> + └ + | + `- ┌ + │ irred at T25709.hs:21:14-19, of type: c a + │ is an evidence variable bound by a pattern + │ with scope: LocalScope T25709.hs:21:14-29 + │ + │ Defined at <no location info> + └ + ===================================== testsuite/tests/hiefile/should_run/all.T ===================================== @@ -8,4 +8,5 @@ test('HieVdq', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUti test('T23540', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('T23120', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('T24544', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) -test('HieGadtConSigs', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) \ No newline at end of file +test('HieGadtConSigs', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) +test('T25709', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b207050f82c537b52be2ef91109d9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b207050f82c537b52be2ef91109d9… 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/hie-file-improvements] 2 commits: hie files: Also dump the type table when dumping with -ddump-hie
by Hannes Siebenhandl (＠fendor) 04 Aug '26

04 Aug '26

Hannes Siebenhandl pushed to branch wip/hie-file-improvements at Glasgow Haskell Compiler / GHC Commits: f0a925b1 by Zubin Duggal at 2026-08-04T17:06:50+02:00 hie files: Also dump the type table when dumping with -ddump-hie - - - - - 7b207050 by Zubin Duggal at 2026-08-04T17:06:50+02:00 hie files: Take evidence for quantified constraints into account when saving evidence terms to the hie ast Fixes #25709 - - - - - 5 changed files: - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Iface/Ext/Types.hs - + testsuite/tests/hiefile/should_run/T25709.hs - + testsuite/tests/hiefile/should_run/T25709.stdout - testsuite/tests/hiefile/should_run/all.T Changes: ===================================== compiler/GHC/Driver/Main/Passes.hs ===================================== @@ -92,7 +92,7 @@ import GHC.Iface.Make import GHC.Iface.Recomp import GHC.Iface.Tidy import GHC.Iface.Ext.Ast ( mkHieFile ) -import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module ) +import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module, hie_types ) import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result) import GHC.Iface.Ext.Debug ( diffFile, validateScopes ) @@ -167,7 +167,7 @@ import GHC.Data.StringBuffer import GHC.Data.Maybe import qualified GHC.Data.Strict as Strict - +import qualified Data.Array as A import Data.List ( nub, isPrefixOf, partition ) import qualified Data.List.NonEmpty as NE import Control.Monad @@ -332,7 +332,10 @@ extract_renamed_stuff mod_summary tc_result = do hieFile <- mkHieFile mod_summary tc_result (fromJust rn_info) let out_file = ml_hie_file $ ms_location mod_summary liftIO $ writeHieFile out_file hieFile - liftIO $ putDumpFileMaybe logger Opt_D_dump_hie "HIE AST" FormatHaskell (ppr $ hie_asts hieFile) + let hie_doc = + ppr (hie_asts hieFile) + $+$ ppr (A.assocs $ hie_types hieFile) + liftIO $ putDumpFileMaybe logger Opt_D_dump_hie "HIE AST" FormatHaskell hie_doc -- Validate HIE files when (gopt Opt_ValidateHie dflags) $ do ===================================== compiler/GHC/Iface/Ext/Types.hs ===================================== @@ -159,6 +159,18 @@ data HieType a | HCoercionTy deriving (Functor, Foldable, Traversable, Eq) +instance Outputable a => Outputable (HieType a) where + ppr (HTyVarTy name) = ppr name + ppr (HAppTy fun arg) = parens $ ppr fun <+> ppr arg + ppr (HTyConApp tc args) = parens $ ppr tc <+> ppr args + ppr (HForAllTy ((name, ty), flag) body) = + text "forall" <+> ppr flag <+> ppr name O.<> text ":" <+> ppr ty O.<> text "." <+> ppr body + ppr (HFunTy mult arg res) = parens $ ppr arg <+> arrow <+> ppr res <+> ppr mult + ppr (HQualTy ctxt ty) = parens $ ppr ctxt <+> text "=>" <+> ppr ty + ppr (HLitTy lit) = ppr lit + ppr (HCastTy ty) = text "cast" <+> ppr ty + ppr HCoercionTy = text "<coercion>" + type HieTypeFlat = HieType TypeIndex -- | Roughly isomorphic to the original core 'Type'. @@ -222,6 +234,10 @@ instance Binary (HieArgs TypeIndex) where put_ bh (HieArgs xs) = put_ bh xs get bh = HieArgs <$> get bh +instance Outputable a => Outputable (HieArgs a) where + ppr (HieArgs args) = braces $ hsep $ punctuate comma $ map pprArg args + where pprArg (vis, ty) = (if vis then id else parens) (ppr ty) + -- A HiePath is just a lexical FastString. We use a lexical FastString to avoid -- non-determinism when printing or storing HieASTs which are sorted by their ===================================== testsuite/tests/hiefile/should_run/T25709.hs ===================================== @@ -0,0 +1,29 @@ +{-# LANGUAGE QuantifiedConstraints#-} +{-# LANGUAGE UndecidableInstances #-} +module Main where + +import TestUtils +import qualified Data.Map.Strict as M +import qualified Data.Set as S +import Data.Either +import Data.Maybe +import Data.Bifunctor (first) +import GHC.Plugins (moduleNameString, nameStableString, nameOccName, occNameString, isDerivedOccName) +import GHC.Iface.Ext.Types + + +import Data.Typeable + +data Some c where + Some :: c a => a -> Some c + +extractSome :: (Typeable a, forall x. c x => Typeable x) => Some c -> Maybe a +extractSome (Some a) = cast a + +points :: [(Int,Int)] +points = [(21,26)] + +main = do + (df, hf) <- readTestHie "T25709.hie" + let refmap = generateReferencesMap $ getAsts $ hie_asts hf + traverse (explainEv df hf refmap) points ===================================== testsuite/tests/hiefile/should_run/T25709.stdout ===================================== @@ -0,0 +1,51 @@ +========================== +At point (21,26), we found: +========================== +┌ +│ $dTypeable at T25709.hs:21:14-19, of type: Typeable a +│ is an evidence variable bound by a let, depending on: [$dTypeable] +│ with scope: LocalScope T25709.hs:21:14-29 +│ +│ Defined at <no location info> +└ +| +`- ┌ + │ $dTypeable at T25709.hs:21:1-29, of type: Typeable a + │ is an evidence variable bound by a HsWrapper + │ with scope: LocalScope T25709.hs:21:1-29 + │ bound at: T25709.hs:21:1-29 + │ Defined at <no location info> + └ + +┌ +│ $dTypeable at T25709.hs:21:14-19, of type: Typeable a +│ is an evidence variable bound by a let, depending on: [df, irred] +│ with scope: LocalScope T25709.hs:21:14-29 +│ +│ Defined at <no location info> +└ +| ++- ┌ +| │ df at T25709.hs:21:1-29, of type: forall x. c x => Typeable x +| │ is an evidence variable bound by a HsWrapper +| │ with scope: LocalScope T25709.hs:21:1-29 +| │ bound at: T25709.hs:21:1-29 +| │ Defined at <no location info> +| └ +| +`- ┌ + │ irred at T25709.hs:21:14-19, of type: c a + │ is an evidence variable bound by a let, depending on: [irred] + │ with scope: LocalScope T25709.hs:21:14-29 + │ + │ Defined at <no location info> + └ + | + `- ┌ + │ irred at T25709.hs:21:14-19, of type: c a + │ is an evidence variable bound by a pattern + │ with scope: LocalScope T25709.hs:21:14-29 + │ + │ Defined at <no location info> + └ + ===================================== testsuite/tests/hiefile/should_run/all.T ===================================== @@ -8,4 +8,5 @@ test('HieVdq', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUti test('T23540', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('T23120', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('T24544', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) -test('HieGadtConSigs', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) \ No newline at end of file +test('HieGadtConSigs', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) +test('T25709', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c420ccbc60daec1ee69c071c74071f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c420ccbc60daec1ee69c071c74071f… 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/sjakobi/udfm-placement] 21 commits: Introduce global unit database cache
by Simon Jakobi (＠sjakobi) 04 Aug '26

04 Aug '26

Simon Jakobi pushed to branch wip/sjakobi/udfm-placement at Glasgow Haskell Compiler / GHC Commits: 5d0ab71a by fendor at 2026-07-27T17:31:05-04:00 Introduce global unit database cache As a first step for better sharing of `UnitInfo` across `UnitEnv`, we introduce a new datatype called `ExternalUnitDatabases`. It primarily serves as an in-memory representation of *all* `UnitDatabase`s across `UnitEnv`. This means, if multiple `HomeUnitEnv`s depend on the same database, one way or another, we make sure that we don't parse from disk every time. Instead, we store the in-memory representation in `ExternalUnitDatabases`. `ExternalUnitDatabaseCache` is the equivalent of `ExternalUnitState` in the `UnitEnv`. It is a mutable variable wrapping `ExternalUnitDatabases`. The mutable `ExternalUnitDatabaseCache` is used in `initUnits` to make sure we don't parse the same unit database multiple times. Almost by accident, we change the semantics of `initUnits` to honour modifications to `packageDBFlags`. The inability to change `packageDBFlags` while also reusing the already parsed `UnitDatabase`s was reported in #26423 as a bug. Hence, we think this behaviour change is warranted and acceptable, especially since it comes with a breaking change to the `initUnits` API. Add regression test for #26423 Closes #26423 - - - - - 6cce494a by fendor at 2026-07-27T17:31:05-04:00 Introduce UnitIndex for global external unit caching `UnitInfo`s have been observed to cause a lot of memory usage in #27500. Especially with multiple home units, as the same (external) units are processed from scratch, even though most of the time we end up with exactly the same `UnitInfo`. We introduce a `UnitEnv` global cache that allows us to store external unit information that is used across all `HomeUnitEnv`s. The most important change in this commit is the introduction of the `UnitIndex`. It stores a global mapping of `UnitId` -> `UnitInfo`, and `initUnits` always uses the cached `UnitInfo` entry to populate each `HomeUnitEnv`'s `UnitState`. This allows us to ensure the following property: > Each `UnitInfo` should be alive exactly once in GHC. All `UnitState`s should reference 'UnitInfo's stored in the 'UnitIndex'. This ensured by calling 'initUnits' with the 'UnitIndex'. In addition, the `ExternalUnitDatabases` may also hold a reference to each on-disk representation of `UnitInfo`. This means, we impose an hard upper bound on the number of `UnitInfo`s alive in the GHC session: > The number of alive `UnitInfo`s closure objects must be the > sum of all loaded unit database times two. We add performance regression tests that make sure the number of live `UnitInfo` cannot exceed this threshold. Closes #27500 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiComponentModulesRecomp100 mhu-perf LinkableUsage02 ------------------------- These metrics increases are especially notable, as we are not even sharing anything big but merely the global package database with 50 entries. It shows how careful sharing of `UnitInfo` can improve memory usage. We expect this to be much more notable when the whole cabal package database is shared across multiple home units. `LinkableUsage02` metric decreases on unreg and i386 platform, only. --- Technical details To share the `UnitInfo`s correctly, it is important that we extract the `WireMap` into the `UnitIndex`. At the moment of writing, `WireMap` must be globally the same for all `HomeUnitEnv`s. This is important, as we could otherwise not cache the "fully-resolved" `UnitInfo`, as we don't change the `UnitId` or `unitAbiHash` when resolving wired-in units. Thus, there could be ambiguities, when the `WireMap` is not the same for all `UnitState`s across the `UnitEnv`. We consider a `UnitInfo` fully-resolved, if wired-in units have been updated, the `UnitInfo` has been validated and variables in the unit config, such as `${pkgroot}` have been resolved. Updating the wired-in units requires the `WireMap` to be globally the same. - - - - - f8e3bee9 by Zubin Duggal at 2026-07-27T17:31:49-04:00 testsuite: skip runtime stats tests on debugged compilers Debugged flavours build the boot libraries without optimisation, so the runtime numbers do not match the baselines. - - - - - 1e326770 by Zubin Duggal at 2026-07-27T17:31:50-04:00 testsuite: mark #20706 tests fragile rather than broken Whether the static linux linker issues manifest depends on the host toolchain. - - - - - c0b13cbe by Zubin Duggal at 2026-07-27T17:31:50-04:00 testsuite: exclude libnuma from mostly-static It needs static system libraries (libnuma.a) that many platforms do not ship. Fixes #26914 - - - - - bee1913d by Alan Zimmerman at 2026-07-28T16:42:29-04:00 EPA: ClsInstDecl with decls as [LHsDecl GhcPs] in GhcPs Similar to 4fdfe75731e01dad7d7fa474c2703d0d3965afb1, this commit changes the as-parsed representation of class instance declarations to [LHsDecl GhcPs], and only separates them by type from the renamer onward. This also allows us to remove all the AnnSortKey machinery for exact printing, as it is now no longer needed. - - - - - 72c55eee by Cheng Shao at 2026-07-28T16:43:11-04:00 hadrian: implement and use writeFileAtomic to fix race condition This patch implements `writeFileAtomic` in hadrian and change all invocations of shake non-atomic `writeFile'` to use `writeFileAtomic`, to avoid multiple hadrian concurrent invocations overwriting the same in-tree generated file not in the build root directory. Fixes #27536. Additional notes: - `writeFileChanged`/`writeFileChangedBS` cannot be made atomic since it involves reading the file's older version, so their uses are left alone. It doesn't affect #27536 given their outputs are contained in the build root directory. - It's possible to shrink this patch by only making writes outside the build root directory atomic. But I think it's not worth the effort for fine grained distinction here, and atomic writes within the build root directory should also improve robustness of a hadrian build. - In the longer term we do want to make a ghc build only generate files within the build root directory, though that's a lot of work and outside the scope of this particular bugfix. Co-authored-by: Codex <codex(a)openai.com> - - - - - 46d4f963 by Sylvain Henry at 2026-07-29T06:38:40-04:00 RTS: correctly mark slop bytes when shrinking large arrays (#19048) Correctly mark slop bytes even when profiling is off so that heap census doesn't traverse garbage-collected closures. - - - - - 4762a8bf by Simon Jakobi at 2026-07-29T06:39:23-04:00 Add -XLazyFieldAnnotations (GHC proposal 752) Unbundle the prefix `~` lazy field annotation syntax from StrictData. The new LazyFieldAnnotations extension controls whether `~` is accepted on constructor fields. StrictData (and Strict, transitively) imply the new extension. See https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0752-l…. Closes #24455. Assisted-by: Claude Opus 4.8 - - - - - 0b6dcc84 by Simon Jakobi at 2026-07-29T06:40:04-04:00 testsuite: Relax T24471 residency tolerance T24471 peak residency fluctuates enough on i386 to cause spurious failures. Use the standard residency tolerance while retaining the existing allocation threshold. See https://gitlab.haskell.org/ghc/ghc/-/work_items/24471#note_682303. Assisted-by: gpt-5.6-sol via Codex CLI - - - - - 90e95b34 by Cheng Shao at 2026-07-29T06:40:45-04:00 compiler: fix missing top-level procedure labels in cmm dumps This patch fixes missing top-level procedure labels in some intermediate Cmm pass dumps. Fixes #27553. Co-authored-by: Codex <codex(a)openai.com> - - - - - 360a5946 by sheaf at 2026-07-29T06:41:35-04:00 Add some type-family-heavy performance tests FamAppCachePerf stress-tests the performance of lookups in the type family application cache. T27336 is a minimisation extracted from the reported reproducer. SimplCastPerf is a measure of coercion growth due to the simplifier calling mkTransCo without re-optimising the result. - - - - - 3ec9e2b9 by Mike Pilgrem at 2026-07-31T08:21:33-04:00 GHC Guide: Improve docs on response files - - - - - e5b2a1f7 by sheaf at 2026-07-31T08:22:23-04:00 Disable Core Lint for TcPlugin_RewritePerf This is a compiler performance test, but the test source hard-coded -dcore-lint, defeating the measurement. ------------------------- Metric Decrease: TcPlugin_RewritePerf ------------------------- - - - - - 85b10c00 by Alan Zimmerman at 2026-07-31T22:09:47+01:00 EPA: Remove LocatedP from OverlapMode We have type LocatedP = GenLocated SrcSpanAnnP type SrcSpanAnnP = EpAnn AnnPragma As the first step in removing this in favour of LocatedA which only captures location, comments and trailing annotations, we remove it from OverlapMode We do this by moving the AnnPragma into the TTG extension point instead. - - - - - c9a34a00 by Viktor Dukhovni at 2026-08-02T04:34:17-04:00 Fix note typo - - - - - 4f2a21f7 by Andreas Klebinger at 2026-08-02T22:46:46-04:00 Apply oneShot Monad trick to STG LintM - - - - - 21e4b89d by Andreas Klebinger at 2026-08-02T22:46:46-04:00 stgLint: Use a single reader env for read only arguments. - - - - - d415f38a by Alan Zimmerman at 2026-08-02T22:47:27-04:00 EPA: Remove LocatedP from CType The next step of removing use of LocatedP by moving the AnnPragma for CType into its TTG extension point instead. - - - - - e6b94f45 by Simon Jakobi at 2026-08-04T16:57:12+02:00 Word64Map: add compareSize compareSize m c compares the size of a map to an Int, but unlike compare (size m) c it stops traversing the map once the outcome is determined. Based on https://github.com/haskell/containers/pull/1139 Assisted-by: Claude Opus 5 - - - - - a39e93e5 by Simon Jakobi at 2026-08-04T16:58:46+02:00 Use a pigeonhole sort for deterministic UniqDFM iteration Deterministic UniqDFM iteration used a list mergesort, allocating O(n log n) cons cells and contributing significantly to compiler allocations (#27459). Use a pigeonhole sort where appropriate, while retaining the mergesort fallback. See Note [Sorting a UDFM] and Note [Cost of deterministic iteration]. ------------------------- Metric Decrease: InstanceMatching InstanceMatching1 ManyAlternatives T12707 T13379 T13719 T24471 T5321FD T5321Fun T783 ------------------------- Assisted-by: gpt-5.6-sol via Codex CLI - - - - - 153 changed files: - + changelog.d/T26423 - + changelog.d/fix-cmm-dump-labels - + changelog.d/fix-heap-census-large-arrays-19048 - + changelog.d/lazy-field-annotations - + changelog.d/unit-index - compiler/GHC.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Map/Lazy.hs - compiler/GHC/Data/Word64Map/Strict.hs - compiler/GHC/Data/Word64Map/Strict/Internal.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main/Hsc.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Decls/Overlap.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Stats.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Unit/Env.hs - + compiler/GHC/Unit/External/Database.hs - + compiler/GHC/Unit/External/Index.hs - + compiler/GHC/Unit/External/ModuleOrigin.hs - + compiler/GHC/Unit/External/Providers.hs - + compiler/GHC/Unit/External/Query.hs - + compiler/GHC/Unit/External/Substitution.hs - + compiler/GHC/Unit/External/Validate.hs - + compiler/GHC/Unit/External/Visibility.hs - + compiler/GHC/Unit/External/Wired.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/Info.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/State.hs-boot - compiler/GHC/Unit/Types.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/ghc.cabal.in - docs/users_guide/exts/strict.rst - docs/users_guide/using.rst - ghc/GHCi/UI.hs - hadrian/src/Hadrian/Builder/Ar.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Nofib.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Rules/SourceDist.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - libraries/ghc-internal/src/GHC/Internal/Ix.hs - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - rts/Apply.cmm - rts/ZeroSlop.c → rts/MarkSlop.c - rts/PrimOps.cmm - rts/Printer.c - rts/ProfHeap.c - rts/RtsFlags.c - rts/ThreadPaused.c - rts/include/Cmm.h - rts/include/rts/storage/ClosureMacros.h - rts/rts.cabal - rts/sm/NonMovingMark.c - rts/sm/Sanity.c - rts/sm/Storage.c - testsuite/driver/testlib.py - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.hs - + testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.stdout - testsuite/tests/deSugar/should_run/all.T - + testsuite/tests/driver/T26423/Hello.hs - + testsuite/tests/driver/T26423/Makefile - + testsuite/tests/driver/T26423/T26423.hs - + testsuite/tests/driver/T26423/T26423.stderr - + testsuite/tests/driver/T26423/T26423.stdout - + testsuite/tests/driver/T26423/all.T - + testsuite/tests/driver/T26423/test/Test.hs - + testsuite/tests/driver/T26423/test/test.pkg - testsuite/tests/driver/T4437.hs - + testsuite/tests/driver/TUnitInfo/Foo.hs - + testsuite/tests/driver/TUnitInfo/Makefile - + testsuite/tests/driver/TUnitInfo/all.T - + testsuite/tests/driver/TUnitInfo/genMhu.sh - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space-mhu.stdout - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space-single.stdout - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.hs - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.stdout - testsuite/tests/driver/all.T - testsuite/tests/driver/mostly-static/Makefile - testsuite/tests/ghci/T13786/all.T - testsuite/tests/ghci/linking/all.T - testsuite/tests/ghci/linking/dyn/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/interface-stability/template-haskell-exports.stdout - testsuite/tests/package/T20010/all.T - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - + testsuite/tests/perf/compiler/FamAppCachePerf.hs - + testsuite/tests/perf/compiler/SimplCastPerf.hs - + testsuite/tests/perf/compiler/T27336.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/plugins/all.T - testsuite/tests/printer/Test24533.stdout - + testsuite/tests/rts/T19048.hs - + testsuite/tests/rts/T19048.stdout - testsuite/tests/rts/all.T - testsuite/tests/rts/linker/all.T - testsuite/tests/tcplugins/TcPlugin_RewritePerf.hs - testsuite/tests/tcplugins/TcPlugin_RewritePerf.stderr - + testsuite/tests/typecheck/should_compile/LazyFieldAnnotations.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.stderr - + testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.hs - + testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.stderr - testsuite/tests/typecheck/should_fail/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b74f794f0009e657938b42bf3b50e7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b74f794f0009e657938b42bf3b50e7… 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